module ReviewBoard.Browser (
Form(..),
FormVar,
formToRequest,
textField,
checkBox,
fileUpload,
toMap,
toFormVar,
) where
import qualified Network.Browser as NB
import Network.HTTP
import Network.URI
import System.Random
formToRequest :: Form -> NB.BrowserAction Request
formToRequest (Form m u vs)
| containFileUpload vs = do
bnd <- NB.ioAction mkBoundary
body <- NB.ioAction $ encMultipartVars bnd vs
return Request
{ rqMethod = POST
, rqHeaders =
[ Header HdrContentType $ "multipart/form-data; boundary=" ++ bnd,
Header HdrContentLength (show . length $ body) ]
, rqBody = body
, rqURI = u }
| otherwise = return $ NB.formToRequest (NB.Form m u $ toMap vs)
where
containFileUpload = or. map (isFU . fvValue)
isFU (FileUpload _ _) = True
isFU _ = False
mkBoundary = do
rand <- randomRIO (100000000000 :: Integer, 999999999999)
return $ "--------------------" ++ show rand
encMultipartVars :: String -> [FormVar] -> IO String
encMultipartVars bnd vs = do
vars <- mapM (encVar bnd) vs
return $ concat [concat vars, "--", bnd, "--", crlf]
encVar :: String -> FormVar -> IO String
encVar bnd fv = do
vs <- encContent . fvValue $ fv
return $ concat [ "--", bnd, crlf
, concatMap show $ encHeader (fvName fv) (fvValue fv), crlf
, vs, crlf ]
encHeader :: String -> FormVarValue -> [Header]
encHeader n (FileUpload f t) =
[ Header hdrContentDisposition ("form-data; name=\"" ++ n ++ "\"; filename=\"" ++ f ++ "\"")
, Header HdrContentType t ]
encHeader n _ = [Header hdrContentDisposition ("form-data; name=\"" ++ n ++ "\"")]
encContent :: FormVarValue -> IO String
encContent (TextField v) = return v
encContent (CheckBox True) = return "true"
encContent (CheckBox False) = return "false"
encContent (FileUpload f t) = readFile f >>= return
hdrContentDisposition :: HeaderName
hdrContentDisposition = HdrCustom "Content-disposition"
crlf :: String
crlf = "\r\n"
data FormVar = FormVar
{ fvName :: String
, fvValue :: FormVarValue
} deriving Show
data FormVarValue
= TextField String
| FileUpload FilePath String
| CheckBox Bool
deriving Show
data Form = Form RequestMethod URI [FormVar]
textField :: String -> String -> FormVar
textField n v = FormVar n $ TextField v
checkBox :: String -> Bool -> FormVar
checkBox n v = FormVar n $ CheckBox v
fileUpload :: String -> FilePath -> String -> FormVar
fileUpload n p t = FormVar n $ FileUpload p t
toMap :: [FormVar] -> [(String, String)]
toMap = map (\fv -> (fvName fv, toNBValue . fvValue $ fv))
toFormVar :: [(String, String)] -> [FormVar]
toFormVar = map (\(n, v) -> textField n v)
toNBValue :: FormVarValue -> String
toNBValue (TextField v) = v
toNBValue (FileUpload f t) = f
toNBValue (CheckBox True) = "true"
toNBValue (CheckBox False) = "false"