module IHP.Controller.Session ( setSession , getSession , getSessionAndClear , getSessionInt , getSessionUUID ) where import IHP.Prelude import IHP.Controller.RequestContext import IHP.Controller.Context import qualified Data.Text.Read as Read import qualified Data.UUID as UUID import qualified Network.Wai as Wai import qualified Data.Vault.Lazy as Vault setSession :: (?context :: ControllerContext) => Text -> Text -> IO () setSession :: Text -> Text -> IO () setSession Text name Text value = case Maybe (Session IO String String) vaultLookup of Just (String -> IO (Maybe String) _, String -> String -> IO () sessionInsert) -> String -> String -> IO () sessionInsert (Text -> String forall a b. ConvertibleStrings a b => a -> b cs Text name) (Text -> String forall a b. ConvertibleStrings a b => a -> b cs Text value) Maybe (Session IO String String) Nothing -> () -> IO () forall (f :: * -> *) a. Applicative f => a -> f a pure () where RequestContext { Request $sel:request:RequestContext :: RequestContext -> Request request :: Request request, Key (Session IO String String) $sel:vault:RequestContext :: RequestContext -> Key (Session IO String String) vault :: Key (Session IO String String) vault } = Proxy "requestContext" -> ControllerContext -> RequestContext forall model (name :: Symbol) value. (KnownSymbol name, HasField name model value) => Proxy name -> model -> value get IsLabel "requestContext" (Proxy "requestContext") Proxy "requestContext" #requestContext ?context::ControllerContext ControllerContext ?context vaultLookup :: Maybe (Session IO String String) vaultLookup = Key (Session IO String String) -> Vault -> Maybe (Session IO String String) forall a. Key a -> Vault -> Maybe a Vault.lookup Key (Session IO String String) vault (Request -> Vault Wai.vault Request request) getSession :: (?context :: ControllerContext) => Text -> IO (Maybe Text) getSession :: Text -> IO (Maybe Text) getSession Text name = case Maybe (Session IO String String) vaultLookup of Just (String -> IO (Maybe String) sessionLookup, String -> String -> IO () _) -> do Maybe String value <- (String -> IO (Maybe String) sessionLookup (Text -> String forall a b. ConvertibleStrings a b => a -> b cs Text name)) let textValue :: Maybe Text textValue = (String -> Text) -> Maybe String -> Maybe Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap String -> Text forall a b. ConvertibleStrings a b => a -> b cs Maybe String value Maybe Text -> IO (Maybe Text) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text) forall a b. (a -> b) -> a -> b $! if Maybe Text textValue Maybe Text -> Maybe Text -> Bool forall a. Eq a => a -> a -> Bool == Text -> Maybe Text forall a. a -> Maybe a Just Text "" then Maybe Text forall a. Maybe a Nothing else Maybe Text textValue Maybe (Session IO String String) Nothing -> Maybe Text -> IO (Maybe Text) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Text forall a. Maybe a Nothing where RequestContext { Request request :: Request $sel:request:RequestContext :: RequestContext -> Request request, Key (Session IO String String) vault :: Key (Session IO String String) $sel:vault:RequestContext :: RequestContext -> Key (Session IO String String) vault } = Proxy "requestContext" -> ControllerContext -> RequestContext forall model (name :: Symbol) value. (KnownSymbol name, HasField name model value) => Proxy name -> model -> value get IsLabel "requestContext" (Proxy "requestContext") Proxy "requestContext" #requestContext ?context::ControllerContext ControllerContext ?context vaultLookup :: Maybe (Session IO String String) vaultLookup = Key (Session IO String String) -> Vault -> Maybe (Session IO String String) forall a. Key a -> Vault -> Maybe a Vault.lookup Key (Session IO String String) vault (Request -> Vault Wai.vault Request request) getSessionAndClear :: (?context :: ControllerContext) => Text -> IO (Maybe Text) getSessionAndClear :: Text -> IO (Maybe Text) getSessionAndClear Text name = do Maybe Text value <- (?context::ControllerContext) => Text -> IO (Maybe Text) Text -> IO (Maybe Text) getSession Text name Bool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Maybe Text -> Bool forall a. Maybe a -> Bool isJust Maybe Text value) ((?context::ControllerContext) => Text -> Text -> IO () Text -> Text -> IO () setSession Text name Text "") Maybe Text -> IO (Maybe Text) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Text value getSessionInt :: (?context :: ControllerContext) => Text -> IO (Maybe Int) getSessionInt :: Text -> IO (Maybe Int) getSessionInt Text name = do Maybe Text value <- (?context::ControllerContext) => Text -> IO (Maybe Text) Text -> IO (Maybe Text) getSession Text name Maybe Int -> IO (Maybe Int) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int) forall a b. (a -> b) -> a -> b $! case (Text -> Either String (Int, Text)) -> Maybe Text -> Maybe (Either String (Int, Text)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -> Either String (Int, Text) forall a. Integral a => Reader a Read.decimal (Text -> Either String (Int, Text)) -> (Text -> Text) -> Text -> Either String (Int, Text) forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Text -> Text forall a b. ConvertibleStrings a b => a -> b cs) Maybe Text value of Just (Right (Int, Text) value) -> Int -> Maybe Int forall a. a -> Maybe a Just (Int -> Maybe Int) -> Int -> Maybe Int forall a b. (a -> b) -> a -> b $ (Int, Text) -> Int forall a b. (a, b) -> a fst (Int, Text) value Maybe (Either String (Int, Text)) _ -> Maybe Int forall a. Maybe a Nothing getSessionUUID :: (?context :: ControllerContext) => Text -> IO (Maybe UUID) getSessionUUID :: Text -> IO (Maybe UUID) getSessionUUID Text name = do Maybe Text value <- (?context::ControllerContext) => Text -> IO (Maybe Text) Text -> IO (Maybe Text) getSession Text name Maybe UUID -> IO (Maybe UUID) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe UUID -> IO (Maybe UUID)) -> Maybe UUID -> IO (Maybe UUID) forall a b. (a -> b) -> a -> b $! case (Text -> Maybe UUID) -> Maybe Text -> Maybe (Maybe UUID) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Maybe UUID UUID.fromText Maybe Text value of Just (Just UUID value) -> UUID -> Maybe UUID forall a. a -> Maybe a Just UUID value Maybe (Maybe UUID) _ -> Maybe UUID forall a. Maybe a Nothing