-- |
-- Module      : Amazonka.Data.Headers
-- Copyright   : (c) 2013-2023 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 as Text
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 .# :: forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String a
.# HeaderName
k = ResponseHeaders
hs forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
.#? HeaderName
k 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 = forall a b. a -> Either a b
Left (ByteString -> String
BS8.unpack forall a b. (a -> b) -> a -> b
$ ByteString
"Unable to find header: " forall a. Semigroup a => a -> a -> a
<> forall s. CI s -> s
CI.original HeaderName
k)
    note (Just a
x) = forall a b. b -> Either a b
Right a
x

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

infixr 7 =#

(=#) :: ToHeader a => HeaderName -> a -> [Header]
=# :: forall a. ToHeader a => 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) forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= HeaderName
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall s. FoldCase s => s -> CI s
CI.mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS) forall a. ToByteString a => a -> ByteString
toBS) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
toHeader HeaderName
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
toHeader HeaderName
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText)

instance ToText a => ToHeader [a] where
  toHeader :: HeaderName -> [a] -> ResponseHeaders
toHeader HeaderName
k [a]
vs = case [a]
vs of
    [] -> []
    [a]
_ -> forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
toHeader HeaderName
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ToText a => a -> Text
toText [a]
vs

instance (ToByteString k, ToByteString v) => ToHeader (HashMap k v) where
  toHeader :: HeaderName -> HashMap k v -> ResponseHeaders
toHeader HeaderName
p = forall a b. (a -> b) -> [a] -> [b]
map (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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    where
      k :: k -> HeaderName
k = forall a. Monoid a => a -> a -> a
mappend HeaderName
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. FoldCase s => s -> CI s
CI.mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS
      v :: v -> ByteString
v = forall a. ToByteString a => a -> ByteString
toBS

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

    g :: Header -> Either String (Text, a)
g (HeaderName
k, ByteString
v) =
      (ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
n forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original HeaderName
k,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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"