    {-# LANGUAGE OverloadedStrings, BangPatterns #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    module Network.Wreq.Internal.AWS
        (
          signRequest,
          signRequestFull
        ) where

    import Control.Applicative ((<$>))
    import Control.Lens ((%~), (^.), (&), to)
    import Crypto.MAC.HMAC (HMAC (..), hmac, hmacGetDigest)
    import Data.ByteString.Base16 as HEX (encode)
    import Data.ByteArray (convert)
    import Data.Char (toLower)
    import Data.List (sort)
    import Data.Monoid ((<>))
    import Data.Time.Clock (getCurrentTime)
    import Data.Time.Format (formatTime)
    import Data.Time.Locale.Compat (defaultTimeLocale)
    import Data.Time.LocalTime (utc, utcToLocalTime)
    import Network.HTTP.Types (parseSimpleQuery, urlEncode)
    import Network.Wreq.Internal.Lens
    import Network.Wreq.Internal.Types (AWSAuthVersion(..))
    import qualified Crypto.Hash as CT (Digest, SHA256, hash, hashlazy)
    import qualified Data.ByteString.Char8 as S
    import qualified Data.ByteString.Lazy.Char8  as L
    import qualified Data.CaseInsensitive  as CI (original)
    import qualified Data.HashSet as HashSet
    import qualified Network.HTTP.Client as HTTP

    -- Sign requests following the AWS v4 request signing specification:
    -- http://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html
    --
    -- Runscope Inc. Traffic Inspector support:
    -- We support (optionally) sending requests through the Runscope
    -- (http://www.runscope.com) Traffic Inspector. If given a Runscope
    -- URL to an AWS service, we will extract and correctly sign the
    -- request for the underlying AWS service. We support Runscope buckets
    -- with and without Bucket Authorization enabled
    -- ("Runscope-Bucket-Auth").
    --
    -- TODO: adjust when DELETE supports a body or PATCH is added
    signRequest :: AWSAuthVersion -> S.ByteString -> S.ByteString ->
                   Request -> IO Request
    signRequest :: AWSAuthVersion -> ByteString -> ByteString -> Request -> IO Request
    signRequest AWSAuthVersion
    AWSv4 ByteString
    aid ByteString
    key Request
    r = AWSAuthVersion
    -> ByteString
    -> ByteString
    -> Maybe (ByteString, ByteString)
    -> Request
    -> IO Request
    signRequestFull AWSAuthVersion
    AWSv4 ByteString
    aid ByteString
    key Maybe (ByteString, ByteString)
    forall a. Maybe a
    Nothing Request
    r

    hexSha256Hash :: S.ByteString -> S.ByteString
    hexSha256Hash :: ByteString -> ByteString
    hexSha256Hash ByteString
    dta =
      let digest :: Digest SHA256
    digest = ByteString -> Digest SHA256
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    ba -> Digest a
    CT.hash ByteString
    dta :: CT.Digest CT.SHA256
      in String -> ByteString
    S.pack (Digest SHA256 -> String
    forall a. Show a => a -> String
    show Digest SHA256
    digest)

    hexSha256HashLazy :: L.ByteString -> S.ByteString
    hexSha256HashLazy :: ByteString -> ByteString
    hexSha256HashLazy ByteString
    dta =
      let digest :: Digest SHA256
    digest = ByteString -> Digest SHA256
    forall a. HashAlgorithm a => ByteString -> Digest a
    CT.hashlazy ByteString
    dta :: CT.Digest CT.SHA256
      in String -> ByteString
    S.pack (Digest SHA256 -> String
    forall a. Show a => a -> String
    show Digest SHA256
    digest)

    signRequestFull :: AWSAuthVersion -> S.ByteString -> S.ByteString -> Maybe (S.ByteString, S.ByteString) -> Request -> IO Request
    signRequestFull :: AWSAuthVersion
    -> ByteString
    -> ByteString
    -> Maybe (ByteString, ByteString)
    -> Request
    -> IO Request
    signRequestFull AWSAuthVersion
    AWSv4 = ByteString
    -> ByteString
    -> Maybe (ByteString, ByteString)
    -> Request
    -> IO Request
    signRequestV4

    signRequestV4 :: S.ByteString -> S.ByteString -> Maybe (S.ByteString, S.ByteString) -> Request -> IO Request
    signRequestV4 :: ByteString
    -> ByteString
    -> Maybe (ByteString, ByteString)
    -> Request
    -> IO Request
    signRequestV4 ByteString
    key ByteString
    secret Maybe (ByteString, ByteString)
    serviceRegion Request
    request = do
      !ts <- IO ByteString
    timestamp                         -- YYYYMMDDT242424Z, UTC based
      let origHost = Request
    request Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    host          -- potentially w/ runscope bucket
          runscopeBucketAuth =
            HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    "Runscope-Bucket-Auth" ([(HeaderName, ByteString)] -> Maybe ByteString)
    -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Request
    request Request
    -> Getting
         [(HeaderName, ByteString)] Request [(HeaderName, ByteString)]
    -> [(HeaderName, ByteString)]
    forall s a. s -> Getting a s a -> a
    ^. Getting
      [(HeaderName, ByteString)] Request [(HeaderName, ByteString)]
    Lens' Request [(HeaderName, ByteString)]
    requestHeaders
          noRunscopeHost = ByteString -> ByteString
    removeRunscope ByteString
    origHost -- rm Runscope for signing
          (service, region) = case serviceRegion of
            Maybe (ByteString, ByteString)
    Nothing     -> ByteString -> (ByteString, ByteString)
    serviceAndRegion ByteString
    noRunscopeHost
            Just (ByteString
    a, ByteString
    b) ->　(ByteString
    a, ByteString
    b)
          date = (Char -> Bool) -> ByteString -> ByteString
    S.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    'T') ByteString
    ts      -- YYYYMMDD
          hashedPayload
            | Request
    request Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    method ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString
    "POST", ByteString
    "PUT"] = Request -> ByteString
    payloadHash Request
    req
            | Bool
    otherwise = ByteString -> ByteString
    hexSha256Hash ByteString
    ""
          -- add common v4 signing headers, service specific headers, and
          -- drop tmp header and Runscope-Bucket-Auth header (if present).
          req = Request
    request Request -> (Request -> Request) -> Request
    forall a b. a -> (a -> b) -> b
    & ([(HeaderName, ByteString)] -> Identity [(HeaderName, ByteString)])
    -> Request -> Identity Request
    Lens' Request [(HeaderName, ByteString)]
    requestHeaders (([(HeaderName, ByteString)]
      -> Identity [(HeaderName, ByteString)])
     -> Request -> Identity Request)
    -> ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
    -> Request
    -> Request
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    %~
                (([ (HeaderName
    "host", ByteString
    noRunscopeHost)
                  , (HeaderName
    "x-amz-date", ByteString
    ts)] [(HeaderName, ByteString)]
    -> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    forall a. [a] -> [a] -> [a]
    ++
                  [(HeaderName
    "x-amz-content-sha256", ByteString
    hashedPayload) | ByteString
    service ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "s3"]) [(HeaderName, ByteString)]
    -> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    forall a. [a] -> [a] -> [a]
    ++)
                -- Runscope (correctly) doesn't send Bucket Auth header to AWS,
                -- remove it from the headers we sign. Adding back in at the end.
                ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
    -> ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
    -> [(HeaderName, ByteString)]
    -> [(HeaderName, ByteString)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName
    -> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
    deleteKey HeaderName
    "Runscope-Bucket-Auth"
      let encodePath ByteString
    p = ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    "/" ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> ByteString -> ByteString
    urlEncode Bool
    False) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ Char -> ByteString -> [ByteString]
    S.split Char
    '/' ByteString
    p
      -- task 1
      let hl = Request
    req Request
    -> Getting
         [(HeaderName, ByteString)] Request [(HeaderName, ByteString)]
    -> [(HeaderName, ByteString)]
    forall s a. s -> Getting a s a -> a
    ^. Getting
      [(HeaderName, ByteString)] Request [(HeaderName, ByteString)]
    Lens' Request [(HeaderName, ByteString)]
    requestHeaders Getting
      [(HeaderName, ByteString)] Request [(HeaderName, ByteString)]
    -> (([(HeaderName, ByteString)]
         -> Const [(HeaderName, ByteString)] [(HeaderName, ByteString)])
        -> [(HeaderName, ByteString)]
        -> Const [(HeaderName, ByteString)] [(HeaderName, ByteString)])
    -> Getting
         [(HeaderName, ByteString)] Request [(HeaderName, ByteString)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
    -> ([(HeaderName, ByteString)]
        -> Const [(HeaderName, ByteString)] [(HeaderName, ByteString)])
    -> [(HeaderName, ByteString)]
    -> Const [(HeaderName, ByteString)] [(HeaderName, ByteString)]
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    to [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
    forall a. Ord a => [a] -> [a]
    sort
          signedHeaders = ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    ";" ([ByteString] -> ByteString)
    -> ([(HeaderName, ByteString)] -> [ByteString])
    -> [(HeaderName, ByteString)]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((HeaderName, ByteString) -> ByteString)
    -> [(HeaderName, ByteString)] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (HeaderName -> ByteString
    lowerCI (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) ([(HeaderName, ByteString)] -> ByteString)
    -> [(HeaderName, ByteString)] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [(HeaderName, ByteString)]
    hl
          canonicalReq = ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    "\n" [
              Request
    req Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    method             -- step 1
            , ByteString -> ByteString
    encodePath (Request
    req Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    path)  -- step 2
            ,   ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    "&"       -- step 3b, incl. sort
                -- urlEncode True (QS) to encode ':' and '/' (e.g. in AWS arns)
              ([ByteString] -> ByteString)
    -> ([(ByteString, ByteString)] -> [ByteString])
    -> [(ByteString, ByteString)]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((ByteString, ByteString) -> ByteString)
    -> [(ByteString, ByteString)] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ByteString
    k,ByteString
    v) -> Bool -> ByteString -> ByteString
    urlEncode Bool
    True ByteString
    k ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "=" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> Bool -> ByteString -> ByteString
    urlEncode Bool
    True ByteString
    v)
              ([(ByteString, ByteString)] -> [ByteString])
    -> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> [(ByteString, ByteString)]
    -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. Ord a => [a] -> [a]
    sort ([(ByteString, ByteString)] -> ByteString)
    -> [(ByteString, ByteString)] -> ByteString
    forall a b. (a -> b) -> a -> b
    $
              ByteString -> [(ByteString, ByteString)]
    parseSimpleQuery (ByteString -> [(ByteString, ByteString)])
    -> ByteString -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ Request
    req Request -> Getting ByteString Request ByteString -> ByteString
    forall s a. s -> Getting a s a -> a
    ^. Getting ByteString Request ByteString
    Lens' Request ByteString
    queryString
            ,   [ByteString] -> ByteString
    S.unlines                -- step 4, incl. sort
              ([ByteString] -> ByteString)
    -> ([(HeaderName, ByteString)] -> [ByteString])
    -> [(HeaderName, ByteString)]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((HeaderName, ByteString) -> ByteString)
    -> [(HeaderName, ByteString)] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(HeaderName
    k,ByteString
    v) -> HeaderName -> ByteString
    lowerCI HeaderName
    k ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    ":" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> ByteString
    forall {a}. a -> a
    trimHeaderValue ByteString
    v) ([(HeaderName, ByteString)] -> ByteString)
    -> [(HeaderName, ByteString)] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [(HeaderName, ByteString)]
    hl
            , ByteString
    signedHeaders             -- step 5
            , ByteString
    hashedPayload             -- step 6, handles empty payload
            ]
      -- task 2
      let dateScope = ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    "/" [ByteString
    date, ByteString
    region, ByteString
    service, ByteString
    "aws4_request"]
          stringToSign = ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    "\n" [
              ByteString
    "AWS4-HMAC-SHA256"
            , ByteString
    ts
            , ByteString
    dateScope
            , ByteString -> ByteString
    hexSha256Hash ByteString
    canonicalReq
            ]
      -- task 3, steps 1 and 2
      let signature = (ByteString
    "AWS4" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    secret) ByteString -> (ByteString -> ByteString) -> ByteString
    forall a b. a -> (a -> b) -> b
    &
                      ByteString -> ByteString -> ByteString
    hmac' ByteString
    date ByteString -> (ByteString -> ByteString) -> ByteString
    forall a b. a -> (a -> b) -> b
    & ByteString -> ByteString -> ByteString
    hmac' ByteString
    region ByteString -> (ByteString -> ByteString) -> ByteString
    forall a b. a -> (a -> b) -> b
    & ByteString -> ByteString -> ByteString
    hmac' ByteString
    service ByteString -> (ByteString -> ByteString) -> ByteString
    forall a b. a -> (a -> b) -> b
    &
                      ByteString -> ByteString -> ByteString
    hmac' ByteString
    "aws4_request" ByteString -> (ByteString -> ByteString) -> ByteString
    forall a b. a -> (a -> b) -> b
    & ByteString -> ByteString -> ByteString
    hmac' ByteString
    stringToSign ByteString -> (ByteString -> ByteString) -> ByteString
    forall a b. a -> (a -> b) -> b
    & ByteString -> ByteString
    HEX.encode
          authorization = ByteString -> [ByteString] -> ByteString
    S.intercalate ByteString
    ", " [
              ByteString
    "AWS4-HMAC-SHA256 Credential=" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    key ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "/" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    dateScope
            , ByteString
    "SignedHeaders=" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    signedHeaders
            , ByteString
    "Signature=" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    signature
            ]
      -- Add the AWS Authorization header.
      -- Restore the Host header to the Runscope endpoint
      -- so they can proxy accordingly (if used, otherwise this is a nop).
      -- Add the Runscope Bucket Auth header back in, if it was set originally.
      return $ setHeader "host" origHost
            <$> maybe id (setHeader "Runscope-Bucket-Auth") runscopeBucketAuth
            <$> setHeader "authorization" authorization $ req
      where
        lowerCI :: HeaderName -> ByteString
    lowerCI = (Char -> Char) -> ByteString -> ByteString
    S.map Char -> Char
    toLower (ByteString -> ByteString)
    -> (HeaderName -> ByteString) -> HeaderName -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HeaderName -> ByteString
    forall s. CI s -> s
    CI.original
        trimHeaderValue :: a -> a
    trimHeaderValue =
          a -> a
    forall {a}. a -> a
    id -- FIXME, see step 4, whitespace trimming but not in double
             -- quoted sections, AWS spec.
        timestamp :: IO ByteString
    timestamp = UTCTime -> ByteString
    render (UTCTime -> ByteString) -> IO UTCTime -> IO ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO UTCTime
    getCurrentTime
          where render :: UTCTime -> ByteString
    render = String -> ByteString
    S.pack (String -> ByteString)
    -> (UTCTime -> String) -> UTCTime -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeLocale -> String -> LocalTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale String
    "%Y%m%dT%H%M%SZ" (LocalTime -> String)
    -> (UTCTime -> LocalTime) -> UTCTime -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                         TimeZone -> UTCTime -> LocalTime
    utcToLocalTime TimeZone
    utc -- UTC printable: YYYYMMDDTHHMMSSZ
        hmac' :: S.ByteString -> S.ByteString -> S.ByteString
        hmac' :: ByteString -> ByteString -> ByteString
    hmac' ByteString
    s ByteString
    k = Digest SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    convert (HMAC SHA256 -> Digest SHA256
    forall a. HMAC a -> Digest a
    hmacGetDigest HMAC SHA256
    h)
          where h :: HMAC SHA256
    h = ByteString -> ByteString -> HMAC SHA256
    forall key message a.
    (ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
    key -> message -> HMAC a
    hmac ByteString
    k ByteString
    s :: (HMAC CT.SHA256)

    payloadHash :: Request -> S.ByteString
    payloadHash :: Request -> ByteString
    payloadHash Request
    req =
      case Request -> RequestBody
    HTTP.requestBody Request
    req of
        HTTP.RequestBodyBS ByteString
    bs ->   ByteString -> ByteString
    hexSha256Hash ByteString
    bs
        HTTP.RequestBodyLBS ByteString
    lbs -> ByteString -> ByteString
    hexSha256HashLazy ByteString
    lbs
        RequestBody
    _ -> String -> ByteString
    forall a. HasCallStack => String -> a
    error String
    "addTmpPayloadHashHeader: unexpected request body type"

    -- Per AWS documentation at:
    --   http://docs.aws.amazon.com/general/latest/gr/rande.html
    -- For example: "dynamodb.us-east-1.amazonaws.com" -> ("dynamodb", "us-east-1")
    serviceAndRegion :: S.ByteString -> (S.ByteString, S.ByteString)
    serviceAndRegion :: ByteString -> (ByteString, ByteString)
    serviceAndRegion ByteString
    endpoint
      -- For s3, check <bucket>.s3..., i.e. virtual-host style access
      | ByteString
    ".s3.amazonaws.com" ByteString -> ByteString -> Bool
    `S.isSuffixOf` ByteString
    endpoint = -- vhost style, classic
        (ByteString
    "s3", ByteString
    "us-east-1")
      | ByteString
    ".s3-external-1.amazonaws.com" ByteString -> ByteString -> Bool
    `S.isSuffixOf` ByteString
    endpoint =
        (ByteString
    "s3", ByteString
    "us-east-1")
      | ByteString
    ".s3-" ByteString -> ByteString -> Bool
    `S.isInfixOf` ByteString
    endpoint = -- vhost style, regional
        (ByteString
    "s3", ByteString -> ByteString
    regionInS3VHost ByteString
    endpoint)
      -- For s3, use /<bucket> style access, as opposed to
      -- <bucket>.s3... in the hostname.
      | ByteString
    endpoint ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString
    "s3.amazonaws.com", ByteString
    "s3-external-1.amazonaws.com"] =
        (ByteString
    "s3", ByteString
    "us-east-1")
      | Char -> ByteString -> ByteString
    servicePrefix Char
    '-' ByteString
    endpoint ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "s3" =
        -- format: e.g. s3-us-west-2.amazonaws.com
        let region :: ByteString
    region = (Char -> Bool) -> ByteString -> ByteString
    S.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> ByteString -> ByteString
    S.drop Int
    3 ByteString
    endpoint -- drop "s3-"
        in (ByteString
    "s3", ByteString
    region)
        -- not s3
      | ByteString
    endpoint ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString
    "sts.amazonaws.com"] =
        (ByteString
    "sts", ByteString
    "us-east-1")
      | ByteString
    ".execute-api." ByteString -> ByteString -> Bool
    `S.isInfixOf` ByteString
    endpoint =
        let ByteString
    gateway:ByteString
    service:ByteString
    region:[ByteString]
    _ = Char -> ByteString -> [ByteString]
    S.split Char
    '.' ByteString
    endpoint
        in (ByteString
    service, ByteString
    region)
      | ByteString
    ".es.amazonaws.com" ByteString -> ByteString -> Bool
    `S.isSuffixOf` ByteString
    endpoint =
        let ByteString
    _:ByteString
    region:[ByteString]
    _ = Char -> ByteString -> [ByteString]
    S.split Char
    '.' ByteString
    endpoint
        in (ByteString
    "es", ByteString
    region)
      | ByteString
    svc ByteString -> HashSet ByteString -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `HashSet.member` HashSet ByteString
    noRegion =
        (ByteString
    svc, ByteString
    "us-east-1")
      | Bool
    otherwise =
        let ByteString
    service:ByteString
    region:[ByteString]
    _ = Char -> ByteString -> [ByteString]
    S.split Char
    '.' ByteString
    endpoint
        in (ByteString
    service, ByteString
    region)
      where
        svc :: ByteString
    svc = Char -> ByteString -> ByteString
    servicePrefix Char
    '.' ByteString
    endpoint
        servicePrefix :: Char -> ByteString -> ByteString
    servicePrefix Char
    c = (Char -> Char) -> ByteString -> ByteString
    S.map Char -> Char
    toLower (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    S.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    c)
        regionInS3VHost :: ByteString -> ByteString
    regionInS3VHost ByteString
    s =
            (Char -> Bool) -> ByteString -> ByteString
    S.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') -- "eu-west-1"
          (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    S.reverse            -- "eu-west-1.amazonaws.com"
          (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> a
    fst                  -- "moc.swanozama.1-tsew-ue"
          ((ByteString, ByteString) -> ByteString)
    -> (ByteString -> (ByteString, ByteString))
    -> ByteString
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString -> (ByteString, ByteString)
    S.breakSubstring (String -> ByteString
    S.pack String
    "-3s.")
          (ByteString -> (ByteString, ByteString))
    -> (ByteString -> ByteString)
    -> ByteString
    -> (ByteString, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    S.reverse
          (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    s                  -- johnsmith.eu.s3-eu-west-1.amazonaws.com
        noRegion :: HashSet ByteString
    noRegion = [ByteString] -> HashSet ByteString
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    HashSet.fromList [ByteString
    "iam", ByteString
    "importexport", ByteString
    "route53", ByteString
    "cloudfront"]

    -- If the hostname doesn't end in runscope.net, return the original.
    -- For a hostname that includes runscope.net:
    -- given  sqs-us--east--1-amazonaws-com-<BUCKET>.runscope.net
    -- return sqs.us-east-1.amazonaws.com
    removeRunscope :: S.ByteString -> S.ByteString
    removeRunscope :: ByteString -> ByteString
    removeRunscope ByteString
    hostname
      | ByteString
    ".runscope.net" ByteString -> ByteString -> Bool
    `S.isSuffixOf` ByteString
    hostname =
        [ByteString] -> ByteString
    S.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    Prelude.map (ByteString -> ByteString
    forall {a}. (Eq a, IsString a) => a -> a
    p2 (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    forall {a}. (Eq a, IsString a) => a -> a
    p1) ([ByteString] -> [ByteString])
    -> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    S.group -- decode
        -- drop suffix "-<BUCKET>.runscope.net" before decoding
        (ByteString -> [ByteString])
    -> (ByteString -> ByteString) -> ByteString -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    S.reverse (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    S.tail (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    S.dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '-') (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    S.reverse
        (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    hostname
      | Bool
    otherwise = ByteString
    hostname
        where p1 :: a -> a
    p1 a
    "-"   = a
    "."
              p1 a
    other = a
    other
              p2 :: a -> a
    p2 a
    "--"  = a
    "-"
              p2 a
    other = a
    other