[Haskell-cafe] HTTP and file upload

[Adam Smyczek]

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 at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe