examples/Multipart.hs

   1 import qualified Data.ByteString.Lazy.Char8 as L8
   2 import Data.List
   3 import Data.Maybe
   4 import Network.HTTP.Lucu
   5
   6 main :: IO ()
   7 main = let config    = defaultConfig { cnfServerPort = "9999" }
   8            resources = mkResTree [ ([], resMain) ]
   9        in
  10          do putStrLn "Access http://localhost:9999/ with your browser."
  11             runHttpd config resources []
  12
  13
  14 resMain :: ResourceDef
  15 resMain
  16     = ResourceDef {
  17         resUsesNativeThread = False
  18       , resIsGreedy         = False
  19       , resGet
  20           = Just $ do setContentType $ read "text/html"
  21                       output ("<title>Multipart Form Test</title>" ++
  22                               "<form action=\"/\" method=\"post\" enctype=\"multipart/form-data\">" ++
  23                               "  Upload some file:" ++
  24                               "  <input type=\"text\" name=\"text\">" ++
  25                               "  <input type=\"file\" name=\"file\">" ++
  26                               "  <input type=\"submit\" value=\"Submit\">" ++
  27                               "</form>")
  28       , resHead   = Nothing
  29       , resPost
  30           = Just $ do form <- inputForm defaultLimit
  31                       let text     = fromMaybe L8.empty $ fmap fdContent $ find ((== "text") . fdName) form
  32                           file     = fromMaybe L8.empty $ fmap fdContent $ find ((== "file") . fdName) form
  33                           fileName = fdFileName =<< find ((== "file") . fdName) form
  34                       setContentType $ read "text/plain"
  35                       outputChunk ("You entered \"" ++ L8.unpack text ++ "\".\n")
  36                       outputChunk ("You uploaded a " ++ show (L8.length file) ++ " bytes long file.\n")
  37                       output ("The file name is " ++ show fileName ++ ".\n")
  38       , resPut    = Nothing
  39       , resDelete = Nothing
  40       }