module Web.Hyperbole.Session where

import Data.ByteString (ByteString)
import Data.List qualified as L
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Network.HTTP.Types
import Web.HttpApiData
import Prelude


newtype Session = Session (Map Text Text)
  deriving (Int -> Session -> ShowS
[Session] -> ShowS
Session -> String
(Int -> Session -> ShowS)
-> (Session -> String) -> ([Session] -> ShowS) -> Show Session
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Session -> ShowS
showsPrec :: Int -> Session -> ShowS
$cshow :: Session -> String
show :: Session -> String
$cshowList :: [Session] -> ShowS
showList :: [Session] -> ShowS
Show)


-- | Set the session key to value
sessionSet :: (ToHttpApiData a) => Text -> a -> Session -> Session
sessionSet :: forall a. ToHttpApiData a => Text -> a -> Session -> Session
sessionSet Text
k a
a (Session Map Text Text
kvs) =
  let val :: Text
val = a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
a
   in Map Text Text -> Session
Session (Map Text Text -> Session) -> Map Text Text -> Session
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k Text
val Map Text Text
kvs


sessionDel :: Text -> Session -> Session
sessionDel :: Text -> Session -> Session
sessionDel Text
k (Session Map Text Text
kvs) =
  Map Text Text -> Session
Session (Map Text Text -> Session) -> Map Text Text -> Session
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
k Map Text Text
kvs


sessionLookup :: (FromHttpApiData a) => Text -> Session -> Maybe a
sessionLookup :: forall a. FromHttpApiData a => Text -> Session -> Maybe a
sessionLookup Text
k (Session Map Text Text
sm) = do
  Text
t <- Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Map Text Text
sm
  (Text -> Maybe a) -> (a -> Maybe a) -> Either Text a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Text -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a -> Maybe a) -> Either Text a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


sessionEmpty :: Session
sessionEmpty :: Session
sessionEmpty = Map Text Text -> Session
Session Map Text Text
forall k a. Map k a
Map.empty


-- | Render a session as a url-encoded query string
sessionRender :: Session -> ByteString
sessionRender :: Session -> ByteString
sessionRender (Session Map Text Text
sm) =
  Bool -> ByteString -> ByteString
urlEncode Bool
True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> ByteString
renderQuery Bool
False ([(Text, Text)] -> Query
forall a. QueryLike a => a -> Query
toQuery ([(Text, Text)] -> Query) -> [(Text, Text)] -> Query
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
sm)


-- | Parse a session as a url-encoded query string
sessionParse :: ByteString -> Session
sessionParse :: ByteString -> Session
sessionParse = Map Text Text -> Session
Session (Map Text Text -> Session)
-> (ByteString -> Map Text Text) -> ByteString -> Session
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> (ByteString -> [(Text, Text)]) -> ByteString -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Maybe ByteString) -> (Text, Text))
-> Query -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Maybe ByteString) -> (Text, Text)
forall {b} {a} {a} {a}.
(IsString b, ConvertibleStrings a a, ConvertibleStrings a b) =>
(a, Maybe a) -> (a, b)
toText (Query -> [(Text, Text)])
-> (ByteString -> Query) -> ByteString -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
parseQuery (ByteString -> Query)
-> (ByteString -> ByteString) -> ByteString -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
True
 where
  toText :: (a, Maybe a) -> (a, b)
toText (a
k, Maybe a
Nothing) = (a -> a
forall a b. ConvertibleStrings a b => a -> b
cs a
k, b
"false")
  toText (a
k, Just a
v) = (a -> a
forall a b. ConvertibleStrings a b => a -> b
cs a
k, a -> b
forall a b. ConvertibleStrings a b => a -> b
cs a
v)


sessionFromCookies :: [(ByteString, ByteString)] -> Session
sessionFromCookies :: [(ByteString, ByteString)] -> Session
sessionFromCookies [(ByteString, ByteString)]
cks = Session -> Maybe Session -> Session
forall a. a -> Maybe a -> a
fromMaybe Session
sessionEmpty (Maybe Session -> Session) -> Maybe Session -> Session
forall a b. (a -> b) -> a -> b
$ do
  ByteString
bs <- ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup ByteString
"session" [(ByteString, ByteString)]
cks
  Session -> Maybe Session
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Session -> Maybe Session) -> Session -> Maybe Session
forall a b. (a -> b) -> a -> b
$ ByteString -> Session
sessionParse ByteString
bs


sessionSetCookie :: Session -> ByteString
sessionSetCookie :: Session -> ByteString
sessionSetCookie Session
ss = ByteString
"session=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Session -> ByteString
sessionRender Session
ss ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"; SameSite=None; secure; path=/"

-- sessionKeyParse :: (FromHttpApiData a) => Text -> Session -> Either Text (Maybe a)
-- sessionKeyParse k (Session kvs) =
--   case Map.lookup k kvs of
--     Nothing -> pure Nothing
--     Just t -> Just <$> parseQueryParam t