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