{-# LANGUAGE AllowAmbiguousTypes #-}

module Web.Hyperbole.Data.Cookie where

import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Network.HTTP.Types (urlDecode, urlEncode)
import Web.Hyperbole.Data.URI


type Key = Text


data Cookie = Cookie
  { Cookie -> Key
key :: Key
  , Cookie -> Maybe Path
path :: Maybe Path
  , Cookie -> Maybe CookieValue
value :: Maybe CookieValue
  }
  deriving (Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookie -> ShowS
showsPrec :: Int -> Cookie -> ShowS
$cshow :: Cookie -> String
show :: Cookie -> String
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq)


newtype Cookies = Cookies (Map Key Cookie)
  deriving newtype (Semigroup Cookies
Cookies
Semigroup Cookies =>
Cookies
-> (Cookies -> Cookies -> Cookies)
-> ([Cookies] -> Cookies)
-> Monoid Cookies
[Cookies] -> Cookies
Cookies -> Cookies -> Cookies
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Cookies
mempty :: Cookies
$cmappend :: Cookies -> Cookies -> Cookies
mappend :: Cookies -> Cookies -> Cookies
$cmconcat :: [Cookies] -> Cookies
mconcat :: [Cookies] -> Cookies
Monoid, NonEmpty Cookies -> Cookies
Cookies -> Cookies -> Cookies
(Cookies -> Cookies -> Cookies)
-> (NonEmpty Cookies -> Cookies)
-> (forall b. Integral b => b -> Cookies -> Cookies)
-> Semigroup Cookies
forall b. Integral b => b -> Cookies -> Cookies
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Cookies -> Cookies -> Cookies
<> :: Cookies -> Cookies -> Cookies
$csconcat :: NonEmpty Cookies -> Cookies
sconcat :: NonEmpty Cookies -> Cookies
$cstimes :: forall b. Integral b => b -> Cookies -> Cookies
stimes :: forall b. Integral b => b -> Cookies -> Cookies
Semigroup, Int -> Cookies -> ShowS
[Cookies] -> ShowS
Cookies -> String
(Int -> Cookies -> ShowS)
-> (Cookies -> String) -> ([Cookies] -> ShowS) -> Show Cookies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookies -> ShowS
showsPrec :: Int -> Cookies -> ShowS
$cshow :: Cookies -> String
show :: Cookies -> String
$cshowList :: [Cookies] -> ShowS
showList :: [Cookies] -> ShowS
Show, Cookies -> Cookies -> Bool
(Cookies -> Cookies -> Bool)
-> (Cookies -> Cookies -> Bool) -> Eq Cookies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookies -> Cookies -> Bool
== :: Cookies -> Cookies -> Bool
$c/= :: Cookies -> Cookies -> Bool
/= :: Cookies -> Cookies -> Bool
Eq)


newtype CookieValue = CookieValue ByteString
  deriving newtype (Int -> CookieValue -> ShowS
[CookieValue] -> ShowS
CookieValue -> String
(Int -> CookieValue -> ShowS)
-> (CookieValue -> String)
-> ([CookieValue] -> ShowS)
-> Show CookieValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieValue -> ShowS
showsPrec :: Int -> CookieValue -> ShowS
$cshow :: CookieValue -> String
show :: CookieValue -> String
$cshowList :: [CookieValue] -> ShowS
showList :: [CookieValue] -> ShowS
Show, CookieValue -> CookieValue -> Bool
(CookieValue -> CookieValue -> Bool)
-> (CookieValue -> CookieValue -> Bool) -> Eq CookieValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieValue -> CookieValue -> Bool
== :: CookieValue -> CookieValue -> Bool
$c/= :: CookieValue -> CookieValue -> Bool
/= :: CookieValue -> CookieValue -> Bool
Eq)


insert :: Cookie -> Cookies -> Cookies
insert :: Cookie -> Cookies -> Cookies
insert Cookie
cookie (Cookies Map Key Cookie
m) =
  Map Key Cookie -> Cookies
Cookies (Map Key Cookie -> Cookies) -> Map Key Cookie -> Cookies
forall a b. (a -> b) -> a -> b
$ Key -> Cookie -> Map Key Cookie -> Map Key Cookie
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Cookie
cookie.key Cookie
cookie Map Key Cookie
m


delete :: Key -> Cookies -> Cookies
delete :: Key -> Cookies -> Cookies
delete Key
key (Cookies Map Key Cookie
m) =
  Map Key Cookie -> Cookies
Cookies (Map Key Cookie -> Cookies) -> Map Key Cookie -> Cookies
forall a b. (a -> b) -> a -> b
$ Key -> Map Key Cookie -> Map Key Cookie
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Key
key Map Key Cookie
m


lookup :: Key -> Cookies -> Maybe CookieValue
lookup :: Key -> Cookies -> Maybe CookieValue
lookup Key
key (Cookies Map Key Cookie
m) = do
  Cookie
cook <- Key -> Map Key Cookie -> Maybe Cookie
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key Map Key Cookie
m
  Cookie
cook.value


fromList :: [Cookie] -> Cookies
fromList :: [Cookie] -> Cookies
fromList [Cookie]
cks = Map Key Cookie -> Cookies
Cookies (Map Key Cookie -> Cookies) -> Map Key Cookie -> Cookies
forall a b. (a -> b) -> a -> b
$ [(Key, Cookie)] -> Map Key Cookie
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Cookie -> (Key, Cookie)) -> [Cookie] -> [(Key, Cookie)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> (Key, Cookie)
forall {b} {a}. HasField "key" b a => b -> (a, b)
keyValue [Cookie]
cks)
 where
  keyValue :: b -> (a, b)
keyValue b
c = (b
c.key, b
c)


toList :: Cookies -> [Cookie]
toList :: Cookies -> [Cookie]
toList (Cookies Map Key Cookie
m) = Map Key Cookie -> [Cookie]
forall k a. Map k a -> [a]
M.elems Map Key Cookie
m


render :: Path -> Cookie -> ByteString
render :: Path -> Cookie -> ByteString
render Path
requestPath Cookie
cookie =
  let p :: Path
p = Path -> Maybe Path -> Path
forall a. a -> Maybe a -> a
fromMaybe Path
requestPath Cookie
cookie.path
   in Key -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Cookie
cookie.key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Maybe CookieValue -> ByteString
value Cookie
cookie.value ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"; SameSite=None; secure; path=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Key -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (URI -> Key
uriToText (Path -> URI
pathUri Path
p))
 where
  value :: Maybe CookieValue -> ByteString
value Maybe CookieValue
Nothing = ByteString
"; expires=Thu, 01 Jan 1970 00:00:00 GMT"
  value (Just (CookieValue ByteString
val)) = Bool -> ByteString -> ByteString
urlEncode Bool
True (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
val


parse :: [(ByteString, ByteString)] -> Either String Cookies
parse :: [(ByteString, ByteString)] -> Either String Cookies
parse [(ByteString, ByteString)]
kvs = do
  [Cookie]
cks <- ((ByteString, ByteString) -> Either String Cookie)
-> [(ByteString, ByteString)] -> Either String [Cookie]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ByteString -> ByteString -> Either String Cookie)
-> (ByteString, ByteString) -> Either String Cookie
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Either String Cookie
parseValue) [(ByteString, ByteString)]
kvs
  Cookies -> Either String Cookies
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cookies -> Either String Cookies)
-> Cookies -> Either String Cookies
forall a b. (a -> b) -> a -> b
$ [Cookie] -> Cookies
fromList [Cookie]
cks


parseValue :: ByteString -> ByteString -> Either String Cookie
parseValue :: ByteString -> ByteString -> Either String Cookie
parseValue ByteString
k ByteString
val = do
  let cval :: CookieValue
cval = ByteString -> CookieValue
CookieValue (ByteString -> CookieValue) -> ByteString -> CookieValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> ByteString -> ByteString
urlDecode Bool
True ByteString
val
  Cookie -> Either String Cookie
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cookie -> Either String Cookie) -> Cookie -> Either String Cookie
forall a b. (a -> b) -> a -> b
$ Key -> Maybe Path -> Maybe CookieValue -> Cookie
Cookie (ByteString -> Key
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
k) Maybe Path
forall a. Maybe a
Nothing (CookieValue -> Maybe CookieValue
forall a. a -> Maybe a
Just (CookieValue -> Maybe CookieValue)
-> CookieValue -> Maybe CookieValue
forall a b. (a -> b) -> a -> b
$ CookieValue
cval)