{-|
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.Trans (ActionT, addHeader, header)
-- time
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
-- text
import Data.Text (Text)
import qualified Data.Text.Encoding as T (encodeUtf8)
import qualified Data.Text.Lazy.Encoding as TL (encodeUtf8, decodeUtf8)



-- | 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 = 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)


-- | '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 = forall (m :: * -> *). MonadIO m => SetCookie -> ActionT m ()
setCookie 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 = 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


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

-- | 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 = 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 }


-- | 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 :: ByteString
setCookieName  = Text -> ByteString
T.encodeUtf8 Text
n
                                        , setCookieValue :: ByteString
setCookieValue = Text -> ByteString
T.encodeUtf8 Text
v
                                        }