{-# 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.Action (ActionT, addHeader, header)
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
import Data.Text (Text)
import qualified Data.Text.Encoding as T (encodeUtf8)
import Web.Scotty.Util (decodeUtf8Lenient)
setCookie :: (MonadIO m)
=> SetCookie
-> ActionT m ()
setCookie :: forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie SetCookie
c = Text -> Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
addHeader Text
"Set-Cookie"
(Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8Lenient
(ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString
(Builder -> ByteString) -> Builder -> ByteString
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 = SetCookie -> ActionT m ()
forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie (SetCookie -> ActionT m ()) -> SetCookie -> ActionT m ()
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 = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
c ([(Text, Text)] -> Maybe Text)
-> ActionT m [(Text, Text)] -> ActionT m (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT m [(Text, Text)]
forall (m :: * -> *). Monad m => ActionT m [(Text, Text)]
getCookies
getCookies :: (Monad m)
=> ActionT m CookiesText
getCookies :: forall (m :: * -> *). Monad m => ActionT m [(Text, Text)]
getCookies = ([(Text, Text)]
-> (Text -> [(Text, Text)]) -> Maybe Text -> [(Text, Text)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [(Text, Text)]
parse) (Maybe Text -> [(Text, Text)])
-> ActionT m (Maybe Text) -> ActionT m [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT m (Maybe Text)
forall (m :: * -> *). Monad m => Text -> ActionT m (Maybe Text)
header Text
"Cookie"
where parse :: Text -> [(Text, Text)]
parse = ByteString -> [(Text, Text)]
parseCookiesText (ByteString -> [(Text, Text)])
-> (Text -> ByteString) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
deleteCookie :: (MonadIO m)
=> Text
-> ActionT m ()
deleteCookie :: forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
deleteCookie Text
c = SetCookie -> ActionT m ()
forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie (SetCookie -> ActionT m ()) -> SetCookie -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> SetCookie
makeSimpleCookie Text
c Text
"") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }
makeSimpleCookie :: Text
-> Text
-> SetCookie
makeSimpleCookie :: Text -> Text -> SetCookie
makeSimpleCookie Text
n Text
v = SetCookie
defaultSetCookie { setCookieName = T.encodeUtf8 n
, setCookieValue = T.encodeUtf8 v
}