module Foundation.Yesod.Session
  ( makeSessionBackend
  ) where

import Import.NoFoundation hiding (makeSessionBackend)

import Foundation.Type

import qualified Web.ServerSession.Core as ServerSession
import qualified Web.ServerSession.Frontend.Yesod.Jwt as JwtSession

import qualified Network.Wai as W
import qualified Network.HTTP.Types.Header as W
import qualified Network.Wai.Middleware.HttpAuth as W (extractBearerAuth)

import Web.Cookie


makeSessionBackend :: Yesod UniWorX => UniWorX -> IO (Maybe SessionBackend)
makeSessionBackend app@UniWorX{ appSettings' = AppSettings{..}, ..} = notForBearer . sameSite $ case appSessionStore of
        SessionStorageMemcachedSql sqlStore
          -> mkBackend . stateSettings =<< ServerSession.createState sqlStore
        SessionStorageAcid acidStore
          | appServerSessionAcidFallback
            -> mkBackend . stateSettings =<< ServerSession.createState acidStore
        _other
          -> return Nothing
      where
        cfg = JwtSession.ServerSessionJwtConfig
          { sJwtJwkSet     = appJSONWebKeySet
          , sJwtStart      = Nothing
          , sJwtExpiration = appSessionTokenExpiration
          , sJwtEncoding   = appSessionTokenEncoding
          , sJwtIssueBy    = appInstanceID
          , sJwtIssueFor   = appClusterID
          }
        mkBackend :: forall sto.
                   ( ServerSession.SessionData sto ~ Map Text ByteString
                   , ServerSession.Storage sto
                   )
                  => ServerSession.State sto -> IO (Maybe SessionBackend)
        mkBackend = JwtSession.backend cfg (JwtSession.siteApproot app)
        stateSettings :: forall sto. ServerSession.State sto -> ServerSession.State sto
        stateSettings = ServerSession.setCookieName (toPathPiece CookieSession) . applyServerSessionSettings appServerSessionConfig
        sameSite
          | Just sameSiteStrict == cookieSameSite (getCookieSettings app CookieSession)
          = strictSameSiteSessions
          | Just sameSiteLax    == cookieSameSite (getCookieSettings app CookieSession)
          = laxSameSiteSessions
          | otherwise
          = id
        notForBearer :: IO (Maybe SessionBackend) -> IO (Maybe SessionBackend)
        notForBearer = fmap $ fmap notForBearer'
          where notForBearer' :: SessionBackend -> SessionBackend
                notForBearer' (SessionBackend load)
                  = let load' req
                          | aHdrs <- mapMaybe (\(h, v) -> v <$ guard (h == W.hAuthorization)) $ W.requestHeaders req
                          , any (is _Just . W.extractBearerAuth) aHdrs
                          = return (mempty, const $ return [])
                          | otherwise
                          = load req
                     in SessionBackend load'