-- |
-- Module      : Amazonka.Data.Headers
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Headers
  ( module Amazonka.Data.Headers,
    HeaderName,
    Header,
    HTTP.hContentType,
  )
where

import Amazonka.Data.ByteString
import Amazonka.Data.Text
import Amazonka.Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text.Encoding as Text
import Network.HTTP.Types (Header, HeaderName, ResponseHeaders)
import qualified Network.HTTP.Types as HTTP

infixl 7 .#, .#?

-- FIXME: This whole toText/fromText shit is just stupid.
(.#) :: FromText a => ResponseHeaders -> HeaderName -> Either String a
ResponseHeaders
hs .# :: ResponseHeaders -> HeaderName -> Either String a
.# HeaderName
k = ResponseHeaders
hs ResponseHeaders -> HeaderName -> Either String (Maybe a)
forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
.#? HeaderName
k Either String (Maybe a)
-> (Maybe a -> Either String a) -> Either String a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> Either String a
note
  where
    note :: Maybe a -> Either String a
note Maybe a
Nothing = String -> Either String a
forall a b. a -> Either a b
Left (ByteString -> String
BS8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
"Unable to find header: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
k)
    note (Just a
x) = a -> Either String a
forall a b. b -> Either a b
Right a
x

(.#?) :: FromText a => ResponseHeaders -> HeaderName -> Either String (Maybe a)
ResponseHeaders
hs .#? :: ResponseHeaders -> HeaderName -> Either String (Maybe a)
.#? HeaderName
k =
  Either String (Maybe a)
-> (ByteString -> Either String (Maybe a))
-> Maybe ByteString
-> Either String (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
    ((a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Either String (Maybe a))
-> (ByteString -> Either String a)
-> ByteString
-> Either String (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String a
forall a. FromText a => Text -> Either String a
fromText (Text -> Either String a)
-> (ByteString -> Text) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8)
    (HeaderName
k HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` ResponseHeaders
hs)

infixr 7 =#

(=#) :: ToHeader a => HeaderName -> a -> [Header]
=# :: HeaderName -> a -> ResponseHeaders
(=#) = HeaderName -> a -> ResponseHeaders
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
toHeader

hdr :: HeaderName -> ByteString -> [Header] -> [Header]
hdr :: HeaderName -> ByteString -> ResponseHeaders -> ResponseHeaders
hdr HeaderName
k ByteString
v ResponseHeaders
hs = (HeaderName
k, ByteString
v) (HeaderName, ByteString) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
k) (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) ResponseHeaders
hs

class ToHeaders a where
  toHeaders :: a -> [Header]

instance (ToByteString k, ToByteString v) => ToHeaders (HashMap k v) where
  toHeaders :: HashMap k v -> ResponseHeaders
toHeaders = ((k, v) -> (HeaderName, ByteString)) -> [(k, v)] -> ResponseHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((k -> HeaderName)
-> (v -> ByteString) -> (k, v) -> (HeaderName, ByteString)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> HeaderName) -> (k -> ByteString) -> k -> HeaderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ByteString
forall a. ToByteString a => a -> ByteString
toBS) v -> ByteString
forall a. ToByteString a => a -> ByteString
toBS) ([(k, v)] -> ResponseHeaders)
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> ResponseHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList

class ToHeader a where
  toHeader :: HeaderName -> a -> [Header]
  default toHeader :: ToText a => HeaderName -> a -> [Header]
  toHeader HeaderName
k = HeaderName -> Text -> ResponseHeaders
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
toHeader HeaderName
k (Text -> ResponseHeaders) -> (a -> Text) -> a -> ResponseHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toText

instance ToHeader Int

instance ToHeader Integer

instance ToHeader Natural

instance ToHeader Text where
  toHeader :: HeaderName -> Text -> ResponseHeaders
toHeader HeaderName
k Text
v = [(HeaderName
k, Text -> ByteString
Text.encodeUtf8 Text
v)]

instance ToHeader ByteString where
  toHeader :: HeaderName -> ByteString -> ResponseHeaders
toHeader HeaderName
k ByteString
v = [(HeaderName
k, ByteString
v)]

instance ToText a => ToHeader (Maybe a) where
  toHeader :: HeaderName -> Maybe a -> ResponseHeaders
toHeader HeaderName
k = ResponseHeaders
-> (a -> ResponseHeaders) -> Maybe a -> ResponseHeaders
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (HeaderName -> Text -> ResponseHeaders
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
toHeader HeaderName
k (Text -> ResponseHeaders) -> (a -> Text) -> a -> ResponseHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toText)

instance (ToByteString k, ToByteString v) => ToHeader (HashMap k v) where
  toHeader :: HeaderName -> HashMap k v -> ResponseHeaders
toHeader HeaderName
p = ((k, v) -> (HeaderName, ByteString)) -> [(k, v)] -> ResponseHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((k -> HeaderName)
-> (v -> ByteString) -> (k, v) -> (HeaderName, ByteString)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap k -> HeaderName
k v -> ByteString
v) ([(k, v)] -> ResponseHeaders)
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> ResponseHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    where
      k :: k -> HeaderName
k = HeaderName -> HeaderName -> HeaderName
forall a. Monoid a => a -> a -> a
mappend HeaderName
p (HeaderName -> HeaderName) -> (k -> HeaderName) -> k -> HeaderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> HeaderName) -> (k -> ByteString) -> k -> HeaderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ByteString
forall a. ToByteString a => a -> ByteString
toBS
      v :: v -> ByteString
v = v -> ByteString
forall a. ToByteString a => a -> ByteString
toBS

parseHeadersMap ::
  FromText a =>
  ByteString ->
  ResponseHeaders ->
  Either String (HashMap Text a)
parseHeadersMap :: ByteString -> ResponseHeaders -> Either String (HashMap Text a)
parseHeadersMap ByteString
p = ([(Text, a)] -> HashMap Text a)
-> Either String [(Text, a)] -> Either String (HashMap Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, a)] -> HashMap Text a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Either String [(Text, a)] -> Either String (HashMap Text a))
-> (ResponseHeaders -> Either String [(Text, a)])
-> ResponseHeaders
-> Either String (HashMap Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, ByteString) -> Either String (Text, a))
-> ResponseHeaders -> Either String [(Text, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (HeaderName, ByteString) -> Either String (Text, a)
g (ResponseHeaders -> Either String [(Text, a)])
-> (ResponseHeaders -> ResponseHeaders)
-> ResponseHeaders
-> Either String [(Text, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, ByteString) -> Bool)
-> ResponseHeaders -> ResponseHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter (HeaderName, ByteString) -> Bool
f
  where
    f :: (HeaderName, ByteString) -> Bool
f = ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
p (ByteString -> Bool)
-> ((HeaderName, ByteString) -> ByteString)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString
forall s. CI s -> s
CI.foldedCase (HeaderName -> ByteString)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst

    g :: (HeaderName, ByteString) -> Either String (Text, a)
g (HeaderName
k, ByteString
v) =
      (ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
n (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
k,)
        (a -> (Text, a)) -> Either String a -> Either String (Text, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String a
forall a. FromText a => Text -> Either String a
fromText (ByteString -> Text
Text.decodeUtf8 ByteString
v)

    n :: Int
n = ByteString -> Int
BS.length ByteString
p

hHost :: HeaderName
hHost :: HeaderName
hHost = HeaderName
"Host"

hExpect :: HeaderName
hExpect :: HeaderName
hExpect = HeaderName
"Expect"

hAMZToken :: HeaderName
hAMZToken :: HeaderName
hAMZToken = HeaderName
"X-Amz-Security-Token"

hAMZTarget :: HeaderName
hAMZTarget :: HeaderName
hAMZTarget = HeaderName
"X-Amz-Target"

hAMZAlgorithm :: HeaderName
hAMZAlgorithm :: HeaderName
hAMZAlgorithm = HeaderName
"X-Amz-Algorithm"

hAMZCredential :: HeaderName
hAMZCredential :: HeaderName
hAMZCredential = HeaderName
"X-Amz-Credential"

hAMZExpires :: HeaderName
hAMZExpires :: HeaderName
hAMZExpires = HeaderName
"X-Amz-Expires"

hAMZSignedHeaders :: HeaderName
hAMZSignedHeaders :: HeaderName
hAMZSignedHeaders = HeaderName
"X-Amz-SignedHeaders"

hAMZContentSHA256 :: HeaderName
hAMZContentSHA256 :: HeaderName
hAMZContentSHA256 = HeaderName
"X-Amz-Content-SHA256"

hAMZDate :: HeaderName
hAMZDate :: HeaderName
hAMZDate = HeaderName
"X-Amz-Date"

hMetaPrefix :: HeaderName
hMetaPrefix :: HeaderName
hMetaPrefix = HeaderName
"X-Amz-"

hAMZRequestId :: HeaderName
hAMZRequestId :: HeaderName
hAMZRequestId = HeaderName
"X-Amz-Request-Id"

hAMZNRequestId :: HeaderName
hAMZNRequestId :: HeaderName
hAMZNRequestId = HeaderName
"X-Amzn-RequestId"

hAMZNErrorType :: HeaderName
hAMZNErrorType :: HeaderName
hAMZNErrorType = HeaderName
"X-Amzn-ErrorType"

hAMZNAuth :: HeaderName
hAMZNAuth :: HeaderName
hAMZNAuth = HeaderName
"X-Amzn-Authorization"

hAMZDecodedContentLength :: HeaderName
hAMZDecodedContentLength :: HeaderName
hAMZDecodedContentLength = HeaderName
"X-Amz-Decoded-Content-Length"

hTransferEncoding :: HeaderName
hTransferEncoding :: HeaderName
hTransferEncoding = HeaderName
"Transfer-Encoding"

hFormEncoded :: ByteString
hFormEncoded :: ByteString
hFormEncoded = ByteString
"application/x-www-form-urlencoded; charset=utf-8"