module Freckle.App.Http.Header
  ( HasHeaders (..)
  , getHeaderCsv
  , lookupHeader

    -- * Utilities
  , splitHeader
  ) where

import Prelude

import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS8
import Data.Char (isSpace)
import Data.Maybe (listToMaybe)
import Network.HTTP.Client (Request, Response, requestHeaders, responseHeaders)
import Network.HTTP.Simple (getRequestHeader, getResponseHeader)
import Network.HTTP.Types.Header (Header, HeaderName)

class HasHeaders a where
  getHeaders :: a -> [Header]

  getHeader :: HeaderName -> a -> [ByteString]
  getHeader HeaderName
h = ((HeaderName, ByteString) -> ByteString)
-> [(HeaderName, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ([(HeaderName, ByteString)] -> [ByteString])
-> (a -> [(HeaderName, ByteString)]) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, ByteString) -> Bool)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
h) (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
-> (a -> [(HeaderName, ByteString)])
-> a
-> [(HeaderName, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(HeaderName, ByteString)]
forall a. HasHeaders a => a -> [(HeaderName, ByteString)]
getHeaders

instance HasHeaders [Header] where
  getHeaders :: [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
getHeaders = [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> a
id

instance HasHeaders Request where
  getHeaders :: Request -> [(HeaderName, ByteString)]
getHeaders = Request -> [(HeaderName, ByteString)]
requestHeaders
  getHeader :: HeaderName -> Request -> [ByteString]
getHeader = HeaderName -> Request -> [ByteString]
getRequestHeader

instance HasHeaders (Response body) where
  getHeaders :: Response body -> [(HeaderName, ByteString)]
getHeaders = Response body -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders
  getHeader :: HeaderName -> Response body -> [ByteString]
getHeader = HeaderName -> Response body -> [ByteString]
forall body. HeaderName -> Response body -> [ByteString]
getResponseHeader

getHeaderCsv :: HasHeaders a => HeaderName -> a -> [ByteString]
getHeaderCsv :: forall a. HasHeaders a => HeaderName -> a -> [ByteString]
getHeaderCsv HeaderName
hn = (ByteString -> [ByteString]) -> [ByteString] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ByteString -> [ByteString]
splitHeader ([ByteString] -> [ByteString])
-> (a -> [ByteString]) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> a -> [ByteString]
forall a. HasHeaders a => HeaderName -> a -> [ByteString]
getHeader HeaderName
hn

splitHeader :: ByteString -> [ByteString]
splitHeader :: ByteString -> [ByteString]
splitHeader = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
trimSpace ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BS8.split Char
','

trimSpace :: ByteString -> ByteString
trimSpace :: ByteString -> ByteString
trimSpace = (Char -> Bool) -> ByteString -> ByteString
BS8.dropWhile Char -> Bool
isSpace (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS8.dropWhileEnd Char -> Bool
isSpace

lookupHeader :: HasHeaders a => HeaderName -> a -> Maybe ByteString
lookupHeader :: forall a. HasHeaders a => HeaderName -> a -> Maybe ByteString
lookupHeader HeaderName
h = [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> (a -> [ByteString]) -> a -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> a -> [ByteString]
forall a. HasHeaders a => HeaderName -> a -> [ByteString]
getHeader HeaderName
h