module Yesod.Session.Cookie.Reading
  ( findSessionKey
  )
where

import Internal.Prelude

import Network.HTTP.Types.Header
import Network.Wai
import Web.Cookie

-- | Find a session key in the request
findSessionKey :: ByteString -> Request -> Maybe ByteString
findSessionKey :: ByteString -> Request -> Maybe ByteString
findSessionKey ByteString
cookieNameBS =
  [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
one
    ([ByteString] -> Maybe ByteString)
-> (Request -> [ByteString]) -> Request -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString]) -> [ByteString] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString -> [(ByteString, ByteString)] -> [ByteString]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookupAll ByteString
cookieNameBS ([(ByteString, ByteString)] -> [ByteString])
-> (ByteString -> [(ByteString, ByteString)])
-> ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, ByteString)]
parseCookies)
    ([ByteString] -> [ByteString])
-> (Request -> [ByteString]) -> Request -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> [(HeaderName, ByteString)] -> [ByteString]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookupAll HeaderName
hCookie
    ([(HeaderName, ByteString)] -> [ByteString])
-> (Request -> [(HeaderName, ByteString)])
-> Request
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> [(HeaderName, ByteString)]
requestHeaders

one :: [a] -> Maybe a
one :: forall a. [a] -> Maybe a
one = \case [a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x; [a]
_ -> Maybe a
forall a. Maybe a
Nothing

lookupAll :: Eq a => a -> [(a, b)] -> [b]
lookupAll :: forall a b. Eq a => a -> [(a, b)] -> [b]
lookupAll a
a = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd ([(a, b)] -> [b]) -> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst)