Skip to content
Newer
Older
100644 70 lines (62 sloc) 2.06 KB
d415794 @liamoc Sessions Example complete; Added transformer layering
authored
1 {-# LANGUAGE TypeOperators, QuasiQuotes, GADTs, ScopedTypeVariables, RecursiveDo, OverloadedStrings #-}
119c2fa @liamoc Added test file
authored
2
1b4adf3 @liamoc Updated test file
authored
3 import Geordi
119c2fa @liamoc Added test file
authored
4 import Network.Wai.Handler.Warp
19fb7e1 @liamoc Major cleanup, files actually work
authored
5 import Debug.Trace
6 import Data.Monoid
287ce8f @liamoc More interesting test program, no more null filebackend
authored
7 import Network.HTTP.Types.Status
d415794 @liamoc Sessions Example complete; Added transformer layering
authored
8 import Network.HTTP.Types.Header
287ce8f @liamoc More interesting test program, no more null filebackend
authored
9 import Control.Monad.Trans
10 import qualified Data.ByteString.Lazy.Char8 as L
090786b @liamoc Minor fixes, renamed file.
authored
11 import qualified Data.Text.Lazy as T
287ce8f @liamoc More interesting test program, no more null filebackend
authored
12 import qualified Data.Map as M
a2b74ea @liamoc Coming back to this after a break.
authored
13 import Text.Blaze.Renderer.Utf8
d415794 @liamoc Sessions Example complete; Added transformer layering
authored
14 import Text.Hamlet
15 import Control.Concurrent.STM
16 import SessionDB as Session
17 import qualified Control.Monad.State as S
a2b74ea @liamoc Coming back to this after a break.
authored
18
d415794 @liamoc Sessions Example complete; Added transformer layering
authored
19 pageWithSession logout x = [shamlet|
20 !!!
21 <body>
22 <form action="#{link logout}" method="post">
23 Count: #{x}
24 <input type="submit" value="Logout">
25 |]
26 pageWithoutSession login = [shamlet|
27 !!!
28 <body>
29 <form action="#{link login}" method="post">
30 You Have no Session
31 <input type="submit" value="Get one">
32 |]
a2b74ea @liamoc Coming back to this after a break.
authored
33
d415794 @liamoc Sessions Example complete; Added transformer layering
authored
34 pageLogout home = [shamlet|
35 !!!
36 <body>
37 You are now logged out
38 <a href="#{link home}">
39 Go back
40 |]
41
42 html x = builder (renderMarkupBuilder x)
43 . status ok200
44 . contentType "text/html; charset=utf-8"
45
46 redirect' :: T.Text -> Response -> Response
47 redirect' x = status found302
48 . header hLocation x
49
50 redirect :: Handler m f ts -> Types (LinkSegments ts) :--> (Response -> Response)
51 redirect h@(Handler {urlPat = urlPat}) = mapMany (linkWitness urlPat) redirect' (link h)
52
53 main = do db <- stmSDB
54 geordi 3000 $ mdo
55 inward <- session db (cookie "session") $ do
56 logout <- post (str "session") $ do
57 endSession
58 respond $ redirect home
59 request (nil) $ do
60 S.modify (+1)
61 (v :: Int) <- S.get
62 respond $ html $ pageWithSession logout v
63 login <- post (str "session") $ do
64 id <- newSession db 0
65 respond $ redirect inward
66 . setCookie ("session" := T.pack (show id))
67 home <- request nil $
68 respond $ html $ pageWithoutSession login
69 return ()
Something went wrong with that request. Please try again.