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

module Utils.Session where

import ClassyPrelude.Yesod

import Utils.PathPiece

import Data.Universe

import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as LBS


data SessionKey = SessionActiveAuthTags | SessionInactiveAuthTags
                | SessionNewStudyTerms | SessionConflictingStudyTerms
                | SessionBearer
                | SessionLang
                | SessionError
                | SessionFiles
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''SessionKey $ camelToPathPiece' 1

setSessionJson :: (PathPiece k, ToJSON v, MonadHandler m) => k -> v -> m ()
setSessionJson (toPathPiece -> key) (LBS.toStrict . Aeson.encode -> val) = setSessionBS key val

lookupSessionJson :: (PathPiece k, FromJSON v, MonadHandler m) => k -> m (Maybe v)
lookupSessionJson (toPathPiece -> key) = (Aeson.decode' . LBS.fromStrict =<<) <$> lookupSessionBS key

modifySessionJson :: (PathPiece k, FromJSON v, ToJSON v, MonadHandler m) => k -> (Maybe v -> Maybe v) -> m ()
modifySessionJson (toPathPiece -> key) f = lookupSessionJson key >>= maybe (deleteSession key) (setSessionJson key) . f

tellSessionJson :: (PathPiece k, FromJSON v, ToJSON v, MonadHandler m, Semigroup v) => k -> v -> m ()
tellSessionJson key val = modifySessionJson key (`mappend` Just val)

takeSessionJson :: (PathPiece k, FromJSON v, MonadHandler m) => k -> m (Maybe v)
-- ^ `lookupSessionJson` followed by `deleteSession`
takeSessionJson key = lookupSessionJson key <* deleteSession (toPathPiece key)


lookupSessionKey :: MonadHandler m => SessionKey -> m (Maybe Text)
lookupSessionKey = lookupSession . toPathPiece

lookupSessionKeyBS :: MonadHandler m => SessionKey -> m (Maybe ByteString)
lookupSessionKeyBS = lookupSessionBS . toPathPiece

setSessionKey :: MonadHandler m => SessionKey -> Text -> m ()
setSessionKey = setSession . toPathPiece

setSessionKeyBS :: MonadHandler m => SessionKey -> ByteString -> m ()
setSessionKeyBS = setSessionBS . toPathPiece

deleteSessionKey :: MonadHandler m => SessionKey -> m ()
deleteSessionKey = deleteSession . toPathPiece