gistfile1.hsc

{- No, it's not live.  Just testing. :) -}

{-# LANGUAGE ViewPatterns #-}
galleryDispatch ai@(\x -> head (pElements x) -> "u") =
  case requestMethod (a_env ai) of
    POST -> do
      let env = a_env ai -- Hack's Env
      case ((,) <$> lookup "Content-Type" (http env)
                <*> lookup "Content-Length" (http env)) of
        Nothing -> do
              dbg "Ack!"
              redirect' "/profile"
        Just (ty,_len) -> do
              let bound = head $ drop 1 $ split " " ty
              dbg $ "Boundary: " ++ bound
              let (_,[(_,fi)]) = Web.parseMultipart bound $ RQ.body env
              let content = Web.fileContent fi
              dbg $ "fi length: " ++ (show $ BS.length content)
              _ <- BS.writeFile ("public/images/test/" ++ (BS.unpack $ Web.fileName fi)) $ Web.fileContent fi
              sendRaw "success"
    _ -> do
      dbg $ "galleryDispatch: upload that isn't a POST."
      redirect' "/gallery"