    {-|
    Module      : Web.Scotty.Cookie
    Copyright   : (c) 2014, 2015 Mārtiņš Mačs,
                  (c) 2023 Marco Zocca

    License     : BSD-3-Clause
    Maintainer  :
    Stability   : experimental
    Portability : GHC

    This module provides utilities for adding cookie support inside @scotty@ applications. Most code has been adapted from 'scotty-cookie'.

    == Example

    A simple hit counter that stores the number of page visits in a cookie:

    @
    \{\-\# LANGUAGE OverloadedStrings \#\-\}

    import Control.Monad
    import Data.Monoid
    import Data.Maybe
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Lazy.Read as TL (decimal)
    import Web.Scotty (scotty, html)
    import Web.Scotty.Cookie (getCookie, setSimpleCookie)

    main :: IO ()
    main = scotty 3000 $
        get \"/\" $ do
            hits <- liftM (fromMaybe \"0\") $ 'getCookie' \"hits\"
            let hits' =
                  case TL.decimal hits of
                    Right n -> TL.pack . show . (+1) $ (fst n :: Integer)
                    Left _  -> \"1\"
            'setSimpleCookie' \"hits\" $ TL.toStrict hits'
            html $ mconcat [ \"\<html\>\<body\>\"
                           , hits'
                           , \"\<\/body\>\<\/html\>\"
                           ]
    @
    -}
    {-# LANGUAGE OverloadedStrings #-}
    module Web.Scotty.Cookie (
        -- * Set cookie
          setCookie
        , setSimpleCookie
        -- * Get cookie(s)
        , getCookie
        , getCookies
        -- * Delete a cookie
        , deleteCookie
        -- * Helpers and advanced interface (re-exported from 'cookie')
        , CookiesText
        , makeSimpleCookie
        -- ** cookie configuration
        , SetCookie
        , defaultSetCookie
        , setCookieName
        , setCookieValue
        , setCookiePath
        , setCookieExpires
        , setCookieMaxAge
        , setCookieDomain
        , setCookieHttpOnly
        , setCookieSecure
        , setCookieSameSite
        , SameSiteOption
        , sameSiteNone
        , sameSiteLax
        , sameSiteStrict
        ) where

    import           Control.Monad.IO.Class (MonadIO(..))

    -- bytestring
    import Data.ByteString.Builder (toLazyByteString)
    import qualified Data.ByteString.Lazy as BSL (toStrict)
    -- cookie
    import Web.Cookie (SetCookie, setCookieName , setCookieValue, setCookiePath, setCookieExpires, setCookieMaxAge, setCookieDomain, setCookieHttpOnly, setCookieSecure, setCookieSameSite, renderSetCookie, defaultSetCookie, CookiesText, parseCookiesText, SameSiteOption, sameSiteStrict, sameSiteNone, sameSiteLax)
    -- scotty
    import Web.Scotty.Action (ActionT, addHeader, header)
    -- time
    import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
    -- text
    import Data.Text (Text)
    import qualified Data.Text.Encoding as T (encodeUtf8)
    import Web.Scotty.Util (decodeUtf8Lenient)

    -- | Set a cookie, with full access to its options (see 'SetCookie')
    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
    $ LazyByteString -> ByteString
    BSL.toStrict
      (LazyByteString -> ByteString) -> LazyByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Builder -> LazyByteString
    toLazyByteString
      (Builder -> LazyByteString) -> Builder -> LazyByteString
    forall a b. (a -> b) -> a -> b
    $ SetCookie -> Builder
    renderSetCookie SetCookie
    c

    -- | 'makeSimpleCookie' and 'setCookie' combined.
    setSimpleCookie :: (MonadIO m)
                    => Text -- ^ name
                    -> Text -- ^ value
                    -> 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

    -- | Lookup one cookie name
    getCookie :: (Monad m)
              => Text -- ^ name
              -> 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

    -- | Returns all cookies
    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

    -- | Browsers don't directly delete a cookie, but setting its expiry to a past date (e.g. the UNIX epoch) ensures that the cookie will be invalidated (whether and when it will be actually deleted by the browser seems to be browser-dependent).
    deleteCookie :: (MonadIO m)
                 => Text -- ^ name
                 -> 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 }

    -- | Construct a simple cookie (an UTF-8 string pair with default cookie options)
    makeSimpleCookie :: Text -- ^ name
                     -> Text -- ^ value
                     -> SetCookie
    makeSimpleCookie :: Text -> Text -> SetCookie
    makeSimpleCookie Text
    n Text
    v = SetCookie
    defaultSetCookie { setCookieName  = T.encodeUtf8 n
                                            , setCookieValue = T.encodeUtf8 v
                                            }