packages feed

hyperbole-0.3.5: src/Web/Hyperbole/Session.hs

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 (Show)


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


sessionDel :: Text -> Session -> Session
sessionDel k (Session kvs) =
  Session $ Map.delete k kvs


sessionLookup :: (FromHttpApiData a) => Text -> Session -> Maybe a
sessionLookup k (Session sm) = do
  t <- Map.lookup k sm
  either (const Nothing) pure $ parseQueryParam t


sessionEmpty :: Session
sessionEmpty = Session Map.empty


-- | Render a session as a url-encoded query string
sessionRender :: Session -> ByteString
sessionRender (Session sm) =
  urlEncode True $ renderQuery False (toQuery $ Map.toList sm)


-- | Parse a session as a url-encoded query string
sessionParse :: ByteString -> Session
sessionParse = Session . Map.fromList . map toText . parseQuery . urlDecode True
 where
  toText (k, Nothing) = (cs k, "false")
  toText (k, Just v) = (cs k, cs v)


sessionFromCookies :: [(ByteString, ByteString)] -> Session
sessionFromCookies cks = fromMaybe sessionEmpty $ do
  bs <- L.lookup "session" cks
  pure $ sessionParse bs


sessionSetCookie :: Session -> ByteString
sessionSetCookie ss = "session=" <> sessionRender ss <> "; 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