Skip to content

Instantly share code, notes, and snippets.

@cmoore
Created May 17, 2010 23:34
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save cmoore/404381 to your computer and use it in GitHub Desktop.
Save cmoore/404381 to your computer and use it in GitHub Desktop.
galleryDispatch ai@(\x -> head (pElements x) -> "u") =
case requestMethod (a_env ai) of
POST -> do
dbg "galleryDispatch: POST on /upload."
let env = a_env ai
case ((,) <$> lookup "Content-Type" (http env)
<*> lookup "Content-Length" (http env)) of
Nothing -> do
dbg "Ack!"
redirect' "/profile"
Just (ty,_len) -> do
dbg $ "TY: " ++ (show ty)
let bound = replace "boundary=" "" $ head $ drop 1 $ split " " ty
dbg $ "Boundary: " ++ (show bound)
-- For testing, I'm just going to send one image
let (_,[(x,fi)]) = Web.parseMultipart bound $ hackInput env
dbg $ "X: " ++ (show $ BS.unpack x)
let filename = BS.unpack $ Web.fileName fi
dbg $ "Filename: " ++ (show filename)
_ <- withBinaryFile ("public/images/test/" ++ filename) WriteMode $ \h ->
BS.hPut h (Web.fileContent fi)
sendRaw "success"
_ -> do
dbg $ "galleryDispatch: upload that isn't a POST."
redirect' "/gallery"
@cmoore
Copy link
Author

cmoore commented May 17, 2010

cmoore@cathedral:~/hg/iplayedthat/public/images/test$ ls -lb t.jpg /home/cmoore/Dropbox/t.jpg

-rw-r--r-- 1 cmoore cmoore 119389 2010-05-11 15:19 /home/cmoore/Dropbox/t.jpg <- original

-rw-r--r-- 1 cmoore cmoore 33939 2010-05-17 16:31 t.jpg

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment