-- |
-- Module      : Amazonka.Request
-- 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.Request
  ( -- * Requests
    head',
    delete,
    get,

    -- ** Empty body
    post,
    put,

    -- ** Specialised body
    patchJSON,
    postXML,
    postJSON,
    postQuery,
    postBody,
    putXML,
    putJSON,
    putBody,

    -- ** Constructors
    defaultRequest,

    -- ** Operation Plugins
    contentMD5Header,
    expectHeader,
    glacierVersionHeader,
    s3vhost,

    -- ** Lenses
    clientRequestHeaders,
    clientRequestQuery,
    clientRequestURL,
  )
where

import Amazonka.Core
import Amazonka.Lens ((%~), (.~))
import Amazonka.Prelude
import qualified Data.ByteString.Char8 as B8
import qualified Network.HTTP.Client as Client
import Network.HTTP.Types (StdMethod (..))
import qualified Network.HTTP.Types as HTTP
import Text.Regex.Posix

type ToRequest a = (ToPath a, ToQuery a, ToHeaders a)

head' :: ToRequest a => Service -> a -> Request a
head' :: Service -> a -> Request a
head' Service
s a
x = Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
HEAD

delete :: ToRequest a => Service -> a -> Request a
delete :: Service -> a -> Request a
delete Service
s a
x = Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
DELETE

get :: ToRequest a => Service -> a -> Request a
get :: Service -> a -> Request a
get Service
s = Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
defaultRequest Service
s

post :: ToRequest a => Service -> a -> Request a
post :: Service -> a -> Request a
post Service
s a
x = Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
POST

put :: ToRequest a => Service -> a -> Request a
put :: Service -> a -> Request a
put Service
s a
x = Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
PUT

patchJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a
patchJSON :: Service -> a -> Request a
patchJSON Service
s a
x = Service -> a -> Request a
forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
PATCH

postXML :: (ToRequest a, ToElement a) => Service -> a -> Request a
postXML :: Service -> a -> Request a
postXML Service
s a
x = Service -> a -> Request a
forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
putXML Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
POST

postJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a
postJSON :: Service -> a -> Request a
postJSON Service
s a
x = Service -> a -> Request a
forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON Service
s a
x Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
POST

postQuery :: ToRequest a => Service -> a -> Request a
postQuery :: Service -> a -> Request a
postQuery Service
s a
x =
  Request :: forall a.
Service
-> StdMethod
-> RawPath
-> QueryString
-> [Header]
-> RequestBody
-> Request a
Request
    { $sel:_requestService:Request :: Service
_requestService = Service
s,
      $sel:_requestMethod:Request :: StdMethod
_requestMethod = StdMethod
POST,
      $sel:_requestPath:Request :: RawPath
_requestPath = a -> RawPath
forall a. ToPath a => a -> RawPath
rawPath a
x,
      $sel:_requestQuery:Request :: QueryString
_requestQuery = QueryString
forall a. Monoid a => a
mempty,
      $sel:_requestBody:Request :: RequestBody
_requestBody = QueryString -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody (a -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery a
x),
      $sel:_requestHeaders:Request :: [Header]
_requestHeaders = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
hContentType ByteString
hFormEncoded (a -> [Header]
forall a. ToHeaders a => a -> [Header]
toHeaders a
x)
    }

postBody :: (ToRequest a, ToBody a) => Service -> a -> Request a
postBody :: Service -> a -> Request a
postBody Service
s a
x =
  Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
defaultRequest Service
s a
x
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
POST
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (RequestBody -> Identity RequestBody)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) RequestBody
requestBody ((RequestBody -> Identity RequestBody)
 -> Request a -> Identity (Request a))
-> RequestBody -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody a
x

putXML :: (ToRequest a, ToElement a) => Service -> a -> Request a
putXML :: Service -> a -> Request a
putXML Service
s a
x =
  Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
defaultRequest Service
s a
x
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
PUT
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (RequestBody -> Identity RequestBody)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) RequestBody
requestBody ((RequestBody -> Identity RequestBody)
 -> Request a -> Identity (Request a))
-> RequestBody -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestBody
-> (Element -> RequestBody) -> Maybe Element -> RequestBody
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RequestBody
"" Element -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody (a -> Maybe Element
forall a. ToElement a => a -> Maybe Element
maybeElement a
x)

putJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON :: Service -> a -> Request a
putJSON Service
s a
x =
  Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
defaultRequest Service
s a
x
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
PUT
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (RequestBody -> Identity RequestBody)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) RequestBody
requestBody ((RequestBody -> Identity RequestBody)
 -> Request a -> Identity (Request a))
-> RequestBody -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Value -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x)

putBody :: (ToRequest a, ToBody a) => Service -> a -> Request a
putBody :: Service -> a -> Request a
putBody Service
s a
x =
  Service -> a -> Request a
forall a. ToRequest a => Service -> a -> Request a
defaultRequest Service
s a
x
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (StdMethod -> Identity StdMethod)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) StdMethod
requestMethod ((StdMethod -> Identity StdMethod)
 -> Request a -> Identity (Request a))
-> StdMethod -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StdMethod
PUT
    Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (RequestBody -> Identity RequestBody)
-> Request a -> Identity (Request a)
forall a. Lens' (Request a) RequestBody
requestBody ((RequestBody -> Identity RequestBody)
 -> Request a -> Identity (Request a))
-> RequestBody -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a -> RequestBody
forall a. ToBody a => a -> RequestBody
toBody a
x

defaultRequest :: ToRequest a => Service -> a -> Request a
defaultRequest :: Service -> a -> Request a
defaultRequest Service
s a
x =
  Request :: forall a.
Service
-> StdMethod
-> RawPath
-> QueryString
-> [Header]
-> RequestBody
-> Request a
Request
    { $sel:_requestService:Request :: Service
_requestService = Service
s,
      $sel:_requestMethod:Request :: StdMethod
_requestMethod = StdMethod
GET,
      $sel:_requestPath:Request :: RawPath
_requestPath = a -> RawPath
forall a. ToPath a => a -> RawPath
rawPath a
x,
      $sel:_requestQuery:Request :: QueryString
_requestQuery = a -> QueryString
forall a. ToQuery a => a -> QueryString
toQuery a
x,
      $sel:_requestHeaders:Request :: [Header]
_requestHeaders = a -> [Header]
forall a. ToHeaders a => a -> [Header]
toHeaders a
x,
      $sel:_requestBody:Request :: RequestBody
_requestBody = RequestBody
""
    }

clientRequestQuery :: Lens' ClientRequest ByteString
clientRequestQuery :: (ByteString -> f ByteString) -> ClientRequest -> f ClientRequest
clientRequestQuery ByteString -> f ByteString
f ClientRequest
x =
  ByteString -> f ByteString
f (ClientRequest -> ByteString
Client.queryString ClientRequest
x) f ByteString -> (ByteString -> ClientRequest) -> f ClientRequest
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
y -> ClientRequest
x {queryString :: ByteString
Client.queryString = ByteString
y}

clientRequestHeaders :: Lens' ClientRequest HTTP.RequestHeaders
clientRequestHeaders :: ([Header] -> f [Header]) -> ClientRequest -> f ClientRequest
clientRequestHeaders [Header] -> f [Header]
f ClientRequest
x =
  [Header] -> f [Header]
f (ClientRequest -> [Header]
Client.requestHeaders ClientRequest
x) f [Header] -> ([Header] -> ClientRequest) -> f ClientRequest
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Header]
y -> ClientRequest
x {requestHeaders :: [Header]
Client.requestHeaders = [Header]
y}

clientRequestURL :: ClientRequest -> ByteString
clientRequestURL :: ClientRequest -> ByteString
clientRequestURL ClientRequest
x =
  ByteString
scheme
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ClientRequest -> ByteString
Client.host ClientRequest
x)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
port (ClientRequest -> Int
Client.port ClientRequest
x)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ClientRequest -> ByteString
Client.path ClientRequest
x)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ClientRequest -> ByteString
Client.queryString ClientRequest
x)
  where
    scheme :: ByteString
scheme
      | Bool
secure = ByteString
"https://"
      | Bool
otherwise = ByteString
"http://"

    port :: Int -> ByteString
port = \case
      Int
80 -> ByteString
""
      Int
443 | Bool
secure -> ByteString
""
      Int
n -> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Int
n

    secure :: Bool
secure = ClientRequest -> Bool
Client.secure ClientRequest
x

contentMD5Header :: Request a -> Request a
contentMD5Header :: Request a -> Request a
contentMD5Header Request a
rq
  | Bool
isMissing, Just ByteString
x <- Maybe ByteString
maybeMD5 = Request a
rq {$sel:_requestHeaders:Request :: [Header]
_requestHeaders = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
HTTP.hContentMD5 ByteString
x [Header]
headers}
  | Bool
otherwise = Request a
rq
  where
    maybeMD5 :: Maybe ByteString
maybeMD5 = RequestBody -> Maybe ByteString
md5Base64 (Request a -> RequestBody
forall a. Request a -> RequestBody
_requestBody Request a
rq)
    isMissing :: Bool
isMissing = Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isNothing (HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
HTTP.hContentMD5 [Header]
headers)
    headers :: [Header]
headers = Request a -> [Header]
forall a. Request a -> [Header]
_requestHeaders Request a
rq

expectHeader :: Request a -> Request a
expectHeader :: Request a -> Request a
expectHeader Request a
rq =
  Request a
rq {$sel:_requestHeaders:Request :: [Header]
_requestHeaders = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
hExpect ByteString
"100-continue" (Request a -> [Header]
forall a. Request a -> [Header]
_requestHeaders Request a
rq)}

glacierVersionHeader :: ByteString -> Request a -> Request a
glacierVersionHeader :: ByteString -> Request a -> Request a
glacierVersionHeader ByteString
version Request a
rq =
  Request a
rq {$sel:_requestHeaders:Request :: [Header]
_requestHeaders = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
"x-amz-glacier-version" ByteString
version (Request a -> [Header]
forall a. Request a -> [Header]
_requestHeaders Request a
rq)}

-- Rewrite a request to use virtual-hosted-style buckets where
-- possible.  A request to endpoint "s3.region.amazonaws.com" with
-- path "/foo/bar" means "object bar in bucket foo". Rewrite it to
-- endpoint "foo.s3.region.amazonaws.com" and path "/bar".
--
-- See: https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html
s3vhost :: Request a -> Request a
s3vhost :: Request a -> Request a
s3vhost Request a
rq = case Request a -> RawPath
forall a. Request a -> RawPath
_requestPath Request a
rq of
  Raw [] -> Request a
rq -- Impossible?
  Raw (ByteString
bucketName : [ByteString]
p) ->
    let path :: RawPath
path = [ByteString] -> RawPath
Raw [ByteString]
p
        bucketNameLen :: Int
bucketNameLen = ByteString -> Int
B8.length ByteString
bucketName

        -- Inspired by:
        -- https://github.com/boto/botocore/blob/04d1fae43b657952e49b21d16daa86378ddb4253/botocore/utils.py#L1067
        rewritePossible :: Bool
rewritePossible
          | Char
'.' Char -> ByteString -> Bool
`B8.elem` ByteString
bucketName = Bool
False
          | Int
bucketNameLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| Int
bucketNameLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63 = Bool
False
          | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
bucketName ByteString -> ByteString -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (ByteString
"^[a-z0-9][a-z0-9\\-]*[a-z0-9]$" :: ByteString) = Bool
False
          | Bool
otherwise = Bool
True
     in if Bool
rewritePossible
          then
            Request a
rq
              Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (Service -> Identity Service) -> Request a -> Identity (Request a)
forall a. Lens' (Request a) Service
requestService ((Service -> Identity Service)
 -> Request a -> Identity (Request a))
-> ((ByteString -> Identity ByteString)
    -> Service -> Identity Service)
-> (ByteString -> Identity ByteString)
-> Request a
-> Identity (Request a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endpoint -> Identity Endpoint) -> Service -> Identity Service
Setter' Service Endpoint
serviceEndpoint ((Endpoint -> Identity Endpoint) -> Service -> Identity Service)
-> ((ByteString -> Identity ByteString)
    -> Endpoint -> Identity Endpoint)
-> (ByteString -> Identity ByteString)
-> Service
-> Identity Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString)
-> Endpoint -> Identity Endpoint
Lens' Endpoint ByteString
endpointHost ((ByteString -> Identity ByteString)
 -> Request a -> Identity (Request a))
-> (ByteString -> ByteString) -> Request a -> Request a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((ByteString
bucketName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".") ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)
              Request a -> (Request a -> Request a) -> Request a
forall a b. a -> (a -> b) -> b
& (RawPath -> Identity RawPath) -> Request a -> Identity (Request a)
forall a. Lens' (Request a) RawPath
requestPath ((RawPath -> Identity RawPath)
 -> Request a -> Identity (Request a))
-> RawPath -> Request a -> Request a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RawPath
path
          else Request a
rq