git.iko.soy/Idris-dev
on 86c2bee help sign in
Idris-dev/lib/network/cgi.idr
127 lines 3.1 kB history raw
1module network.cgi
3import system
5public
6Vars : Set
7Vars = List (String, String)
9record CGIInfo : Set where
10 CGISt : (GET : Vars) ->
11 (POST : Vars) ->
12 (Cookies : Vars) ->
13 (UserAgent : String) ->
14 (Headers : String) ->
15 (Output : String) -> CGIInfo
17add_Headers : String -> CGIInfo -> CGIInfo
18add_Headers str st = record { Headers = Headers st ++ str } st
20add_Output : String -> CGIInfo -> CGIInfo
21add_Output str st = record { Output = Output st ++ str } st
23abstract
24data CGI : Set -> Set where
25 MkCGI : (CGIInfo -> IO (a, CGIInfo)) -> CGI a
27getAction : CGI a -> CGIInfo -> IO (a, CGIInfo)
28getAction (MkCGI act) = act
30instance Monad CGI where {
31 (>>=) (MkCGI f) k = MkCGI (\s => do v <- f s
32 getAction (k (fst v)) (snd v))
34 return v = MkCGI (\s => return (v, s))
37setInfo : CGIInfo -> CGI ()
38setInfo i = MkCGI (\s => return ((), i))
40getInfo : CGI CGIInfo
41getInfo = MkCGI (\s => return (s, s))
43abstract
44lift : IO a -> CGI a
45lift op = MkCGI (\st => do { x <- op
46 return (x, st) } )
48abstract
49output : String -> CGI ()
50output s = do i <- getInfo
51 setInfo (add_Output s i)
53abstract
54queryVars : CGI Vars
55queryVars = do i <- getInfo
56 return (GET i)
58abstract
59postVars : CGI Vars
60postVars = do i <- getInfo
61 return (POST i)
63abstract
64cookieVars : CGI Vars
65cookieVars = do i <- getInfo
66 return (Cookies i)
68abstract
69queryVar : String -> CGI (Maybe String)
70queryVar x = do vs <- queryVars
71 return (lookup x vs)
73getOutput : CGI String
74getOutput = do i <- getInfo
75 return (Output i)
77getHeaders : CGI String
78getHeaders = do i <- getInfo
79 return (Headers i)
81abstract
82flushHeaders : CGI ()
83flushHeaders = do o <- getHeaders
84 lift (putStrLn o)
86abstract
87flush : CGI ()
88flush = do o <- getOutput
89 lift (putStr o)
91getVars : List Char -> String -> List (String, String)
92getVars seps query = mapMaybe readVar (split (\x => elem x seps) query)
93 where
94 readVar : String -> Maybe (String, String)
95 readVar xs with (split (\x => x == '=') xs)
96 | [k, v] = Just (trim k, trim v)
97 | _ = Nothing
99getContent : Int -> IO String
100getContent x = getC x "" where
101 getC : Int -> String -> IO String
102 getC 0 acc = return $ reverse acc
103 getC n acc = do x <- getChar
104 getC (n-1) (strCons x acc)
106abstract
107runCGI : CGI a -> IO a
108runCGI prog = do
109 clen_in <- getEnv "CONTENT_LENGTH"
110 let clen = prim__strToInt clen_in
111 content <- getContent clen
112 query <- getEnv "QUERY_STRING"
113 cookie <- getEnv "HTTP_COOKIE"
114 agent <- getEnv "HTTP_USER_AGENT"
116 let get_vars = getVars ['&',';'] query
117 let post_vars = getVars ['&'] content
118 let cookies = getVars [';'] cookie
120 (v, st) <- getAction prog (CGISt get_vars post_vars cookies agent
121 "Content-type: text/html\n"
122 "")
123 putStrLn (Headers st)
124 putStr (Output st)
125 return v