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

    -- * Utilities
  , splitHeader
  ) where

import Freckle.App.Prelude

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import Data.Char (isSpace)
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