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

    -- ** Empty body
    post,
    put,

    -- ** Specialised body
    patchBody,
    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.Data
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' :: forall a. ToRequest a => Service -> a -> Request a
head' Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
HEAD}

delete :: ToRequest a => Service -> a -> Request a
delete :: forall a. ToRequest a => Service -> a -> Request a
delete Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
DELETE}

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

post :: ToRequest a => Service -> a -> Request a
post :: forall a. ToRequest a => Service -> a -> Request a
post Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
POST}

put :: ToRequest a => Service -> a -> Request a
put :: forall a. ToRequest a => Service -> a -> Request a
put Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
get Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
PUT}

patchBody :: (ToRequest a, ToBody a) => Service -> a -> Request a
patchBody :: forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
patchBody Service
s a
x = (forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
putBody Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
PATCH}

patchJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a
patchJSON :: forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
patchJSON Service
s a
x = (forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
PATCH}

postXML :: (ToRequest a, ToElement a) => Service -> a -> Request a
postXML :: forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
postXML Service
s a
x = (forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
putXML Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
POST}

postJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a
postJSON :: forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
postJSON Service
s a
x = (forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON Service
s a
x) {$sel:method:Request :: StdMethod
method = StdMethod
POST}

postQuery :: ToRequest a => Service -> a -> Request a
postQuery :: forall a. ToRequest a => Service -> a -> Request a
postQuery Service
service a
x =
  Request
    { Service
$sel:service:Request :: Service
service :: Service
service,
      $sel:method:Request :: StdMethod
method = StdMethod
POST,
      $sel:path:Request :: RawPath
path = forall a. ToPath a => a -> RawPath
rawPath a
x,
      $sel:query:Request :: QueryString
query = forall a. Monoid a => a
mempty,
      $sel:body:Request :: RequestBody
body = forall a. ToBody a => a -> RequestBody
toBody (forall a. ToQuery a => a -> QueryString
toQuery a
x),
      $sel:headers:Request :: [Header]
headers = HeaderName -> ByteString -> [Header] -> [Header]
hdr HeaderName
hContentType ByteString
hFormEncoded (forall a. ToHeaders a => a -> [Header]
toHeaders a
x)
    }

postBody :: (ToRequest a, ToBody a) => Service -> a -> Request a
postBody :: forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
postBody Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
post Service
s a
x) {$sel:body:Request :: RequestBody
body = forall a. ToBody a => a -> RequestBody
toBody a
x}

putXML :: (ToRequest a, ToElement a) => Service -> a -> Request a
putXML :: forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
putXML Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
put Service
s a
x) {$sel:body:Request :: RequestBody
body = forall b a. b -> (a -> b) -> Maybe a -> b
maybe RequestBody
"" forall a. ToBody a => a -> RequestBody
toBody (forall a. ToElement a => a -> Maybe Element
maybeElement a
x)}

putJSON :: (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON :: forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
putJSON Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
put Service
s a
x) {$sel:body:Request :: RequestBody
body = forall a. ToBody a => a -> RequestBody
toBody (forall a. ToJSON a => a -> Value
toJSON a
x)}

putBody :: (ToRequest a, ToBody a) => Service -> a -> Request a
putBody :: forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
putBody Service
s a
x = (forall a. ToRequest a => Service -> a -> Request a
put Service
s a
x) {$sel:body:Request :: RequestBody
body = forall a. ToBody a => a -> RequestBody
toBody a
x}

defaultRequest :: ToRequest a => Service -> a -> Request a
defaultRequest :: forall a. ToRequest a => Service -> a -> Request a
defaultRequest Service
service a
x =
  Request
    { Service
service :: Service
$sel:service:Request :: Service
service,
      $sel:method:Request :: StdMethod
method = StdMethod
GET,
      $sel:path:Request :: RawPath
path = forall a. ToPath a => a -> RawPath
rawPath a
x,
      $sel:query:Request :: QueryString
query = forall a. ToQuery a => a -> QueryString
toQuery a
x,
      $sel:headers:Request :: [Header]
headers = forall a. ToHeaders a => a -> [Header]
toHeaders a
x,
      $sel:body:Request :: RequestBody
body = RequestBody
""
    }

clientRequestQuery :: Lens' ClientRequest ByteString
clientRequestQuery :: Lens' ClientRequest ByteString
clientRequestQuery ByteString -> f ByteString
f ClientRequest
x =
  ByteString -> f ByteString
f (ClientRequest -> ByteString
Client.queryString ClientRequest
x) 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 :: Lens' ClientRequest [Header]
clientRequestHeaders [Header] -> f [Header]
f ClientRequest
x =
  [Header] -> f [Header]
f (ClientRequest -> [Header]
Client.requestHeaders ClientRequest
x) 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
    forall a. Semigroup a => a -> a -> a
<> forall a. ToByteString a => a -> ByteString
toBS (ClientRequest -> ByteString
Client.host ClientRequest
x)
    forall a. Semigroup a => a -> a -> a
<> Int -> ByteString
port (ClientRequest -> Int
Client.port ClientRequest
x)
    forall a. Semigroup a => a -> a -> a
<> forall a. ToByteString a => a -> ByteString
toBS (ClientRequest -> ByteString
Client.path ClientRequest
x)
    forall a. Semigroup a => a -> a -> a
<> 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
":" forall a. Semigroup a => a -> a -> a
<> forall a. ToByteString a => a -> ByteString
toBS Int
n

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

contentMD5Header :: Request a -> Request a
contentMD5Header :: forall a. Request a -> Request a
contentMD5Header rq :: Request a
rq@Request {[Header]
headers :: [Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers, RequestBody
body :: RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body}
  | Bool
isMissing, Just ByteString
x <- Maybe ByteString
maybeMD5 = Request a
rq {$sel:headers:Request :: [Header]
headers = 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 RequestBody
body
    isMissing :: Bool
isMissing = forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
HTTP.hContentMD5 [Header]
headers)

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

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

-- Rewrite a request to use virtual-hosted-style buckets where
-- possible and requested.
--
-- Example: 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".
--
-- This is basically the logic in
-- https://github.com/boto/botocore/blob/04d1fae43b657952e49b21d16daa86378ddb4253/botocore/utils.py#L1922-L1941
-- except that we can't tell if an endpoint has been overridden, as a
-- 'Request' contains a 'Service' after all overrides have been
-- applied.
--
-- See: https://boto3.amazonaws.com/v1/documentation/api/1.9.42/guide/s3.html#changing-the-addressing-style
-- See: https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html
s3vhost :: Request a -> Request a
s3vhost :: forall a. Request a -> Request a
s3vhost
  rq :: Request a
rq@Request
    { $sel:path:Request :: forall a. Request a -> RawPath
path = RawPath
path,
      $sel:service:Request :: forall a. Request a -> Service
service = service :: Service
service@Service {Region -> Endpoint
$sel:endpoint:Service :: Service -> Region -> Endpoint
endpoint :: Region -> Endpoint
endpoint, S3AddressingStyle
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
s3AddressingStyle :: S3AddressingStyle
s3AddressingStyle}
    } = case RawPath
path of
    Raw [] -> Request a
rq -- Impossible?
    Raw (ByteString
bucketName : [ByteString]
p) ->
      let 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 forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| Int
bucketNameLen forall a. Ord a => a -> a -> Bool
> Int
63 = Bool
False
            | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ ByteString
bucketName 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

          doRewrite :: Bool
doRewrite = case S3AddressingStyle
s3AddressingStyle of
            S3AddressingStyle
S3AddressingStyleAuto -> Bool
rewritePossible
            S3AddressingStyle
S3AddressingStylePath -> Bool
False
            S3AddressingStyle
S3AddressingStyleVirtual -> Bool
True

          path' :: RawPath
path' = [ByteString] -> RawPath
Raw [ByteString]
p
          service' :: Service
service' =
            Service
service
              { $sel:endpoint:Service :: Region -> Endpoint
endpoint = \Region
r ->
                  let e :: Endpoint
e@Endpoint {ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host :: ByteString
host} = Region -> Endpoint
endpoint Region
r
                   in Endpoint
e {$sel:host:Endpoint :: ByteString
host = forall a. Monoid a => [a] -> a
mconcat [ByteString
bucketName, ByteString
".", ByteString
host]}
              }
       in if Bool
doRewrite
            then Request a
rq {$sel:path:Request :: RawPath
path = RawPath
path', $sel:service:Request :: Service
service = Service
service'}
            else Request a
rq