1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
| module Cookies
( setCookie
, getCookie
, getCookieFromHeader
, setSession
, deleteSession
) where
import Web.Cookie
import Web.Scotty.Trans
import Data.Text
import Utils
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Encoding as T
import Control.Monad.IO.Class (liftIO, MonadIO)
import Models
import Control.Monad.Reader (lift)
import Repos.Utils
import qualified Repos.Sessions as Sessions
setCookie :: MonadIO m => Text -> Text -> ActionT m ()
setCookie key value = addHeader "Set-Cookie" $
TL.fromStrict . T.decodeUtf8 . renderSetCookieBS $ simpleCookie key value
simpleCookie :: Text -> Text -> SetCookie
simpleCookie key value =
defaultSetCookie {
setCookieName = T.encodeUtf8 key,
setCookieValue = T.encodeUtf8 value,
setCookieHttpOnly = True,
setCookieSecure = True,
setCookieSameSite = Just sameSiteLax
}
getCookie :: Monad m => Text -> ActionT m (Maybe Text)
getCookie key = do
rawCookie <- header "Cookie"
return $ getCookieFromHeader (TL.toStrict <$> rawCookie) key
getCookieFromHeader :: Maybe Text -> Text -> Maybe Text
getCookieFromHeader rawCookie key = do
let cookie = parseCookiesText . T.encodeUtf8 <$> rawCookie
-- tutorial monad >>= TODO
cookie >>= lookup key
setSession :: CanDB m => Text -> ActionT m ()
setSession userId = do
-- tutorial functor
session <- liftIO $ Session <$> uuid <*> pure userId <*> now
-- TODO what when couldn't create session
_ <- lift $ Sessions.create session
setCookie "session" session.token
deleteSession :: CanDB m => ActionT m ()
deleteSession = do
sessionId <- getCookie "session"
-- tutorial mapM_ / maybe function
lift $ mapM_ Sessions.delete sessionId
-- TODO set expire at
setCookie "session" ""
|