-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Settings.Cookies
  ( CookieSettings(..)
  , HasCookieSettings(..)
  , cookieSettingsToSetCookie
  ) where

import ClassyPrelude

import Web.Cookie
import Web.Cookie.Instances ()

import Utils.PathPiece

import Data.Time.Clock
import Data.Time.Clock.Instances ()

import qualified Data.Text as Text
import qualified Data.HashMap.Strict as HashMap
import qualified Data.CaseInsensitive as CI

import Data.Aeson
import Data.Aeson.TH

import Control.Lens ((&))
import Control.Monad.Fail


data CookieSettings = CookieSettings
  { cookieExpires :: Maybe NominalDiffTime
  , cookieSameSite :: Maybe SameSiteOption
  , cookieHttpOnly
  , cookieSecure :: Maybe Bool
  } deriving (Eq, Show, Generic)
    deriving anyclass (Hashable)

instance FromJSON SameSiteOption where
  parseJSON = withText "SameSiteOption" $ \(CI.mk -> ciT) -> HashMap.lookup ciT options
      & maybe (fail . unpack $ "Expected one of: " <> Text.intercalate ", " (map CI.original $ HashMap.keys options)) return
    where options = mconcat
            [ singletonMap "Lax"    sameSiteLax
            , singletonMap "Strict" sameSiteStrict
            , singletonMap "None"   sameSiteNone
            ]

deriveFromJSON defaultOptions
  { omitNothingFields = True
  , fieldLabelModifier = camelToPathPiece' 1
  } ''CookieSettings


class HasCookieSettings ident app | app -> ident where
  getCookieSettings :: app -> ident -> CookieSettings

instance HasCookieSettings ident (ident -> CookieSettings) where
  getCookieSettings = id


cookieSettingsToSetCookie :: MonadIO m => CookieSettings -> m SetCookie
cookieSettingsToSetCookie CookieSettings{..} = do
  now <- liftIO getCurrentTime
  return def
    { setCookieExpires  = addUTCTime <$> cookieExpires <*> pure now
    , setCookieSameSite = cookieSameSite
    , setCookieHttpOnly = fromMaybe (setCookieHttpOnly def) cookieHttpOnly
    , setCookieSecure   = fromMaybe (setCookieSecure   def) cookieSecure
    }