Thanks for the snippet.
Sorry, but my question was somehow mis-formulated. I was looking for
a client-side implementation
how to upload a file to any server using Haskell (mainly using the
Browser module from HTTP package).
Going through the Browser.hs source code a little, I and came up with
the following implementation
and your hpaste helped me to test it.
The following code is just a small wrapper around the Browser module
that adds support for
multipart/form-data content type. It's more or less a prototype but
works fine for me.
Looking forward to suggestions how to improve it.
Be gentle, it's beginner code :)
Adam
------------------------------------------------------------------------
-----
-- |
-- Wrapper around Network.Browser module with
-- support for multipart/form-data content type
--
------------------------------------------------------------------------
-----
module ReviewBoard.Browser (
formToRequest,
FormVar(..),
Form(..)
) where
import qualified Network.Browser as HB
import Network.HTTP
import Network.URI
import Data.Char
import Control.Monad.Writer
import System.Random
-- | Form to request for typed form variables
--
formToRequest :: Form -> HB.BrowserAction Request
formToRequest (Form m u vs)
-- Use multipart/form-data content type when
-- the form contains at least one FileUpload variable
| or (map isFileUpload vs) = do
bnd <- HB.ioAction mkBoundary
(_, enc) <- HB.ioAction $ runWriterT $
multipartUrlEncodeVars bnd vs
let body = concat enc
return Request
{ rqMethod=POST
, rqHeaders=
[ Header HdrContentType $ "multipart/form-data;
boundary=" ++ bnd,
Header HdrContentLength (show . length $ body) ]
, rqBody= body
, rqURI=u }
-- Otherwise fall back to Network.Browser
| otherwise = return $ HB.formToRequest (HB.Form m u $ map
toHVar vs)
where
-- Convert typed variables to Network.Browser variables
toHVar (TextField n v) = (n, v)
toHVar (FileUpload n f) = (n, f)
toHVar (Checkbox n v) = (n, map toLower $ show v)
-- Is file upload
isFileUpload (FileUpload _ _) = True
isFileUpload _ = False
-- Create random boundary string
mkBoundary = do
rand <- randomRIO (100000000000 :: Integer, 999999999999)
return $ "--------------------" ++ show rand
-- | Encode variables, add boundary header and footer
--
multipartUrlEncodeVars :: String -> [FormVar] -> RqsWriter ()
multipartUrlEncodeVars bnd vs = do
mapM (\v -> tell ["--", bnd, "\r\n"] >> encodeVar v) vs
tell ["--", bnd, "--", "\r\n"]
-- | Encode variable based on type
--
encodeVar :: FormVar -> RqsWriter ()
encodeVar (TextField n v) = defaultEncVar n v
encodeVar (Checkbox n True) = defaultEncVar n "true"
encodeVar (Checkbox n False) = defaultEncVar n "false"
encodeVar (FileUpload n f) = do
fc <- liftIO $ readFile f
tell [ "Content-Disposition: form-data; name=\"", n, "\";
filename=\"", f, "\"\r\n"
, "Content-Type: text/plain\r\n" -- TODO: add support for
different types
, "\r\n" , fc , "\r\n"]
-- | Default encode method for name/value as string
--
defaultEncVar :: String -> String -> RqsWriter ()
defaultEncVar n v = tell [ "Content-Disposition: form-data; name=\"",
n, "\"\r\n"
, "\r\n" , v , "\r\n"]
--
------------------------------------------------------------------------
---
-- Types
-- | Request writer
--
type RqsWriter a = WriterT [String] IO a
-- | Typed form vars
--
data FormVar
= TextField String String
| FileUpload String FilePath
| Checkbox String Bool
deriving Show
-- | And the typed form
--
data Form = Form RequestMethod URI [FormVar]
On Apr 15, 2008, at 1:38 AM, Adrian Neumann wrote:
Yes
http://hpaste.org/6990
Am 14.04.2008 um 19:07 schrieb Adam Smyczek:
Is form based file upload supported in HTTP module (HTTP-3001.0.4)?
Adam
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
