{-# LANGUAGE OverloadedStrings #-}
module Web.Scotty.Cookie (
setCookie
, setSimpleCookie
, getCookie
, getCookies
, deleteCookie
, CookiesText
, makeSimpleCookie
, SetCookie
, defaultSetCookie
, setCookieName
, setCookieValue
, setCookiePath
, setCookieExpires
, setCookieMaxAge
, setCookieDomain
, setCookieHttpOnly
, setCookieSecure
, setCookieSameSite
, SameSiteOption
, sameSiteNone
, sameSiteLax
, sameSiteStrict
) where
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Lazy as BSL (toStrict)
import Web.Cookie (SetCookie, setCookieName , setCookieValue, setCookiePath, setCookieExpires, setCookieMaxAge, setCookieDomain, setCookieHttpOnly, setCookieSecure, setCookieSameSite, renderSetCookie, defaultSetCookie, CookiesText, parseCookiesText, SameSiteOption, sameSiteStrict, sameSiteNone, sameSiteLax)
import Web.Scotty.Trans (ActionT, addHeader, header)
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
import Data.Text (Text)
import qualified Data.Text.Encoding as T (encodeUtf8)
import qualified Data.Text.Lazy.Encoding as TL (encodeUtf8, decodeUtf8)
setCookie :: (MonadIO m)
=> SetCookie
-> ActionT m ()
setCookie :: forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie SetCookie
c = forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
addHeader Text
"Set-Cookie" (ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ SetCookie -> Builder
renderSetCookie SetCookie
c)
setSimpleCookie :: (MonadIO m)
=> Text
-> Text
-> ActionT m ()
setSimpleCookie :: forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
setSimpleCookie Text
n Text
v = forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie forall a b. (a -> b) -> a -> b
$ Text -> Text -> SetCookie
makeSimpleCookie Text
n Text
v
getCookie :: (Monad m)
=> Text
-> ActionT m (Maybe Text)
getCookie :: forall (m :: * -> *). Monad m => Text -> ActionT m (Maybe Text)
getCookie Text
c = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => ActionT m CookiesText
getCookies
getCookies :: (Monad m)
=> ActionT m CookiesText
getCookies :: forall (m :: * -> *). Monad m => ActionT m CookiesText
getCookies = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> CookiesText
parse) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Text -> ActionT m (Maybe Text)
header Text
"Cookie"
where parse :: Text -> CookiesText
parse = ByteString -> CookiesText
parseCookiesText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TL.encodeUtf8
deleteCookie :: (MonadIO m)
=> Text
-> ActionT m ()
deleteCookie :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
deleteCookie Text
c = forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie forall a b. (a -> b) -> a -> b
$ (Text -> Text -> SetCookie
makeSimpleCookie Text
c Text
"") { setCookieExpires :: Maybe UTCTime
setCookieExpires = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0 }
makeSimpleCookie :: Text
-> Text
-> SetCookie
makeSimpleCookie :: Text -> Text -> SetCookie
makeSimpleCookie Text
n Text
v = SetCookie
defaultSetCookie { setCookieName :: ByteString
setCookieName = Text -> ByteString
T.encodeUtf8 Text
n
, setCookieValue :: ByteString
setCookieValue = Text -> ByteString
T.encodeUtf8 Text
v
}