56 lines
2.1 KiB
Haskell
56 lines
2.1 KiB
Haskell
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
|
|
| SessionAllocationResults
|
|
| SessionLang
|
|
| SessionError
|
|
| SessionFiles
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
|
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
|