module Session.Key
( SessionKey (..)
, SessionKeyManager (..)
, makeSessionKeyManager
, sessionKeyToCookieValue
, sessionKeyFromCookieValue
)
where
import Internal.Prelude
import Base64 (decodeBase64, encodeBase64)
import Data.ByteString.Char8 qualified as BS8
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Randomization
data SessionKeyManager m = SessionKeyManager
{ forall (m :: * -> *). SessionKeyManager m -> m SessionKey
new :: m SessionKey
, forall (m :: * -> *). SessionKeyManager m -> SessionKey -> Bool
check :: SessionKey -> Bool
}
newtype SessionKey = SessionKey {SessionKey -> Text
text :: Text}
deriving newtype (SessionKey -> SessionKey -> Bool
(SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool) -> Eq SessionKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionKey -> SessionKey -> Bool
== :: SessionKey -> SessionKey -> Bool
$c/= :: SessionKey -> SessionKey -> Bool
/= :: SessionKey -> SessionKey -> Bool
Eq, Eq SessionKey
Eq SessionKey =>
(SessionKey -> SessionKey -> Ordering)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> Bool)
-> (SessionKey -> SessionKey -> SessionKey)
-> (SessionKey -> SessionKey -> SessionKey)
-> Ord SessionKey
SessionKey -> SessionKey -> Bool
SessionKey -> SessionKey -> Ordering
SessionKey -> SessionKey -> SessionKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SessionKey -> SessionKey -> Ordering
compare :: SessionKey -> SessionKey -> Ordering
$c< :: SessionKey -> SessionKey -> Bool
< :: SessionKey -> SessionKey -> Bool
$c<= :: SessionKey -> SessionKey -> Bool
<= :: SessionKey -> SessionKey -> Bool
$c> :: SessionKey -> SessionKey -> Bool
> :: SessionKey -> SessionKey -> Bool
$c>= :: SessionKey -> SessionKey -> Bool
>= :: SessionKey -> SessionKey -> Bool
$cmax :: SessionKey -> SessionKey -> SessionKey
max :: SessionKey -> SessionKey -> SessionKey
$cmin :: SessionKey -> SessionKey -> SessionKey
min :: SessionKey -> SessionKey -> SessionKey
Ord, Int -> SessionKey -> ShowS
[SessionKey] -> ShowS
SessionKey -> String
(Int -> SessionKey -> ShowS)
-> (SessionKey -> String)
-> ([SessionKey] -> ShowS)
-> Show SessionKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionKey -> ShowS
showsPrec :: Int -> SessionKey -> ShowS
$cshow :: SessionKey -> String
show :: SessionKey -> String
$cshowList :: [SessionKey] -> ShowS
showList :: [SessionKey] -> ShowS
Show)
makeSessionKeyManager :: Monad m => Randomization m -> SessionKeyManager m
makeSessionKeyManager :: forall (m :: * -> *).
Monad m =>
Randomization m -> SessionKeyManager m
makeSessionKeyManager (Randomization Natural -> m ByteString
generateRandomBytes) =
let
new :: m SessionKey
new =
Text -> SessionKey
SessionKey
(Text -> SessionKey)
-> (ByteString -> Text) -> ByteString -> SessionKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeBase64
(ByteString -> SessionKey) -> m ByteString -> m SessionKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> m ByteString
generateRandomBytes Natural
forall a. Integral a => a
keyLengthInBytes
check :: SessionKey -> Bool
check (SessionKey Text
text) =
Text -> Int
T.length Text
text
Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Integral a => a
keyLengthAsText
Bool -> Bool -> Bool
&& (Text -> Bool)
-> (ByteString -> Bool) -> Either Text ByteString -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
False)
((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Integral a => a
keyLengthInBytes) (Int -> Bool) -> (ByteString -> Int) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS8.length)
(Text -> Either Text ByteString
decodeBase64 Text
text)
in
SessionKeyManager {m SessionKey
$sel:new:SessionKeyManager :: m SessionKey
new :: m SessionKey
new, SessionKey -> Bool
$sel:check:SessionKeyManager :: SessionKey -> Bool
check :: SessionKey -> Bool
check}
keyLengthInBytes :: Integral a => a
keyLengthInBytes :: forall a. Integral a => a
keyLengthInBytes = a
18
keyLengthAsText :: Integral a => a
keyLengthAsText :: forall a. Integral a => a
keyLengthAsText = a
24
sessionKeyToCookieValue :: SessionKey -> ByteString
sessionKeyToCookieValue :: SessionKey -> ByteString
sessionKeyToCookieValue = (.text) (SessionKey -> Text)
-> (Text -> ByteString) -> SessionKey -> ByteString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> ByteString
encodeUtf8
sessionKeyFromCookieValue :: ByteString -> Maybe SessionKey
sessionKeyFromCookieValue :: ByteString -> Maybe SessionKey
sessionKeyFromCookieValue ByteString
v =
ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
v Either UnicodeException Text
-> (Either UnicodeException Text -> Maybe Text) -> Maybe Text
forall a b. a -> (a -> b) -> b
& (UnicodeException -> Maybe Text)
-> (Text -> Maybe Text)
-> Either UnicodeException Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> UnicodeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just Maybe Text -> (Text -> SessionKey) -> Maybe SessionKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> SessionKey
SessionKey