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