module Yesod.Session.Cookie.SetCookie
  ( makeSetCookieHeaders
  ) where

import Internal.Prelude

import Data.Text.Encoding (encodeUtf8)
import Session.Key
import Session.Timing.Math
import Session.Timing.Options
import Session.Timing.Time
import Session.Timing.Timeout
import Session.TransportSecurity qualified as TransportSecurity
import Time
import Web.Cookie qualified as C
import Yesod.Core.Types (Header (AddCookie))
import Yesod.Session.Options

makeSetCookieHeaders
  :: Options tx m -> Maybe (SessionKey, Time UTCTime) -> [Header]
makeSetCookieHeaders :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> Maybe (SessionKey, Time UTCTime) -> [Header]
makeSetCookieHeaders Options tx m
options =
  (Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: []) (Header -> [Header])
-> (Maybe (SessionKey, Time UTCTime) -> Header)
-> Maybe (SessionKey, Time UTCTime)
-> [Header]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header
-> ((SessionKey, Time UTCTime) -> Header)
-> Maybe (SessionKey, Time UTCTime)
-> Header
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Options tx m -> Header
forall (tx :: * -> *) (m :: * -> *). Options tx m -> Header
deleteCookie Options tx m
options) (Options tx m -> (SessionKey, Time UTCTime) -> Header
forall (tx :: * -> *) (m :: * -> *).
Options tx m -> (SessionKey, Time UTCTime) -> Header
createCookie Options tx m
options)

cookieNameBS :: Options tx m -> ByteString
cookieNameBS :: forall (tx :: * -> *) (m :: * -> *). Options tx m -> ByteString
cookieNameBS Options tx m
options = Text -> ByteString
encodeUtf8 Options tx m
options.cookieName

-- | Create a cookie for the given session
createCookie :: Options tx m -> (SessionKey, Time UTCTime) -> Header
createCookie :: forall (tx :: * -> *) (m :: * -> *).
Options tx m -> (SessionKey, Time UTCTime) -> Header
createCookie Options tx m
options (SessionKey
key, Time UTCTime
time) =
  SetCookie -> Header
AddCookie
    SetCookie
forall a. Default a => a
C.def
      { C.setCookieName = cookieNameBS options
      , C.setCookieValue = sessionKeyToCookieValue key
      , C.setCookiePath = Just "/"
      , C.setCookieExpires = Just $ cookieExpires options.timing.timeout time
      , C.setCookieDomain = Nothing
      , C.setCookieHttpOnly = True
      , C.setCookieSecure = TransportSecurity.cookieSecure options.transportSecurity
      }

-- | Remove the session cookie from the client
deleteCookie :: Options tx m -> Header
deleteCookie :: forall (tx :: * -> *) (m :: * -> *). Options tx m -> Header
deleteCookie Options tx m
options =
  SetCookie -> Header
AddCookie
    SetCookie
forall a. Default a => a
C.def
      { C.setCookieName = cookieNameBS options
      , C.setCookieValue = ""
      , C.setCookiePath = Just "/"
      , C.setCookieExpires = Just $ UTCTime systemEpochDay 1
      , C.setCookieMaxAge = Just 0
      , C.setCookieDomain = Nothing
      , C.setCookieHttpOnly = True
      , C.setCookieSecure = TransportSecurity.cookieSecure options.transportSecurity
      }

-- | Calculate the date that should be used for the cookie's "expires" field
cookieExpires :: Timeout NominalDiffTime -> Time UTCTime -> UTCTime
cookieExpires :: Timeout NominalDiffTime -> Time UTCTime -> UTCTime
cookieExpires Timeout NominalDiffTime
timeout Time UTCTime
time =
  UTCTime -> Maybe UTCTime -> UTCTime
forall a. a -> Maybe a -> a
fromMaybe (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime -> NominalDiffTime
years NominalDiffTime
10) Time UTCTime
time.accessed)
    (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Timeout NominalDiffTime -> Time UTCTime -> Maybe UTCTime
nextExpires Timeout NominalDiffTime
timeout Time UTCTime
time