content: {-# LANGUAGE AllowAmbiguousTypes  #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-|
  Module: IHP.Controller.Session
  Description: Functions to work with session cookies, provides 'setSession', 'getSession' and friends
  Copyright: (c) digitally induced GmbH, 2021
  
  The session provides a way for your application to store small amounts of information that will be persisted between requests. It’s mainly used from inside your controller actions.
  
  In general, you should not store complex data structures in the session. It’s better to store scalar values in there only. For example: Store the current user-id instead of the current user record.
  
  The session works by storing the data inside a cryptographically signed and encrypted cookie on the client. The encryption key is generated automatically and is stored at @Config/client_session_key.aes@. Internally IHP uses the clientsession library. You can find more technical details on the implementation in the <https://hackage.haskell.org/package/clientsession-0.9.1.2/docs/Web-ClientSession.html clientsession> documentation.
  
  The cookie @max-age@ is set to 30 days by default. To protect against CSRF, the @SameSite@ Policy is set to @Lax@.
  -}
  module IHP.Controller.Session
    (
    -- * Session Error
    SessionError (..)
  
    -- * Interacting with session store
    , setSession
    , getSession
    , getSessionEither
    , deleteSession
    , getSessionAndClear
    , sessionVaultKey
    ) where
  
  import IHP.Prelude
  import IHP.Controller.RequestContext
  import IHP.Controller.Context
  import IHP.ModelSupport
  import qualified Data.UUID as UUID
  import qualified Data.Vault.Lazy as Vault
  import qualified Network.Wai as Wai
  import qualified Data.Serialize as Serialize
  import Data.Serialize (Serialize)
  import Data.Serialize.Text ()
  import qualified Network.Wai.Session
  import System.IO.Unsafe (unsafePerformIO)
  
  -- | Types of possible errors as a result of
  -- requesting a value from the session storage
  data SessionError
      -- | Value not found in the session storage
      = NotFoundError
      -- | Error occurce during parsing value
      | ParseError String
      deriving (Show, Eq)
  
  -- | Stores a value inside the session:
  --
  -- > action SessionExampleAction { userId } = do
  -- >     setSession "userId" userId
  --
  -- For cases where setSession is used with literals,
  -- to avoid type ambiguity, you can use one of the options below
  --
  -- __Example:__ Annotate a literal with a type
  --
  -- > action LogoutAction = do
  -- >     setSession "userEmail" ("hi@digitallyinduced.com" :: Text)
  --
  -- __Example:__ Using setSession with type application
  --
  -- > action LogoutAction = do
  -- >     setSession @Text "userEmail" "hi@digitallyinduced.com"
  --
  setSession :: (?context :: ControllerContext, Serialize value)
             => ByteString -> value -> IO ()
  setSession name value = sessionInsert name (Serialize.encode value)
  {-# INLINABLE setSession #-}
  
  -- | Retrives a value from the session:
  --
  -- > action SessionExampleAction = do
  -- >     userEmail <- getSession @Text "userEmail"
  -- >     counter <- getSession @Int "counter"
  -- >     userId <- getSession @(Id User) "userId"
  --
  -- @userEmail@ is set to @Just' "hi@digitallyinduced.com"@
  -- when the value has been set before. Otherwise, it will be 'Nothing'.
  --
  -- If an error occurs while getting the value, the result will be 'Nothing'.
  getSession :: forall value
              . (?context :: ControllerContext, Serialize value)
             => ByteString -> IO (Maybe value)
  getSession name = getSessionEither name >>= \case
      Left _ -> pure Nothing
      Right result -> pure (Just result)
  {-# INLINABLE getSession #-}
  
  -- | Retrives a value from the session:
  --
  -- 'getSession' variant, which returns 'SessionError' if an error occurs
  -- while getting value from session storage
  --
  -- > action SessionExampleAction = do
  -- >     counter <- getSessionEither @Int "counter"
  -- >     case counter of
  -- >         Right value -> ...
  -- >         Left (ParseError errorMessage) -> ...
  -- >         Left NotFoundError -> ...
  -- >         Left VaultError -> ...
  getSessionEither :: forall value
              . (?context :: ControllerContext, Serialize value)
             => ByteString -> IO (Either SessionError value)
  getSessionEither name = sessionLookup name >>= \case
          Nothing -> pure $ Left NotFoundError
          Just "" -> pure $ Left NotFoundError
          Just stringValue -> case Serialize.decode stringValue of
              Left error -> pure . Left $ ParseError error
              Right value -> pure $ Right value
  {-# INLINABLE getSessionEither #-}
  
  -- | Remove session values from storage:
  --
  -- __Example:__ Deleting a @userId@ field from the session
  --
  -- > action LogoutAction = do
  -- >     deleteSession "userId"
  --
  -- __Example:__ Calling 'getSession' after
  -- using 'deleteSession' will return @Nothing@
  --
  -- > setSession "userId" (1337 :: Int)
  -- > userId <- getSession @Int "userId" -- Returns: Just 1337
  -- >
  -- > deleteSession "userId"
  -- > userId <- getSession @Int "userId" -- Returns: Nothing
  deleteSession :: (?context :: ControllerContext) => ByteString -> IO ()
  deleteSession name = sessionInsert name ""
  
  -- | Returns a value from the session, and deletes it after retrieving:
  --
  -- > action SessionExampleAction = do
  -- >     notification <- getSessionAndClear @Text "notification"
  getSessionAndClear :: forall value
                      . (?context :: ControllerContext, Serialize value)
                     => ByteString -> IO (Maybe value)
  getSessionAndClear name = do
      value <- getSession @value name
      when (isJust value) (deleteSession name)
      pure value
  {-# INLINABLE getSessionAndClear #-}
  
  instance (PrimaryKey table ~ UUID) => Serialize (Id' table) where
      put (Id value) = Serialize.put (UUID.toASCIIBytes value)
      get = do
          maybeUUID <- UUID.fromASCIIBytes <$> Serialize.get
          case maybeUUID of
              Nothing -> fail "Failed to parse UUID"
              Just uuid -> pure (Id uuid)
  
  sessionInsert :: (?context :: ControllerContext) => ByteString -> ByteString -> IO ()
  sessionInsert = snd sessionVault
  
  sessionLookup :: (?context :: ControllerContext) => ByteString -> IO (Maybe ByteString)
  sessionLookup = fst sessionVault
  
  sessionVault :: (?context :: ControllerContext) => (ByteString -> IO (Maybe ByteString), ByteString -> ByteString -> IO ())
  sessionVault = case vaultLookup of
          Just session -> session
          Nothing -> error "sessionInsert: The session vault is missing in the request"
      where
          RequestContext { request } = ?context.requestContext
          vaultLookup = Vault.lookup sessionVaultKey request.vault
  
  sessionVaultKey :: Vault.Key (Network.Wai.Session.Session IO ByteString ByteString)
  sessionVaultKey = unsafePerformIO Vault.newKey
  {-# NOINLINE sessionVaultKey #-}