Created
May 17, 2010 23:34
-
-
Save cmoore/404381 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
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