-- |
-- Module      : Amazonka.Presign
-- 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)
--
-- It is intended for use directly with 'Amazonka.Auth.Auth' when only
-- presigning and no other AWS actions are required.
-- See 'Amazonka.Auth.withAuth' to extract an 'AuthEnv' from an 'Auth'.

{-# LANGUAGE BangPatterns #-}

module Amazonka.Presign where

import Amazonka.Data
import Amazonka.Prelude
import Amazonka.Request (clientRequestURL)
import Amazonka.Types hiding (presign)
import qualified Network.HTTP.Types as HTTP

-- | Presign an URL that is valid from the specified time until the
-- number of seconds expiry has elapsed.
--
-- /See:/ 'presign', 'presignWith'
presignURL ::
  (AWSRequest a) =>
  AuthEnv ->
  Region ->
  -- | Signing time.
  UTCTime ->
  -- | Expiry time.
  Seconds ->
  -- | Request to presign.
  a ->
  ByteString
presignURL :: forall a.
AWSRequest a =>
AuthEnv -> Region -> UTCTime -> Seconds -> a -> ByteString
presignURL AuthEnv
a Region
r UTCTime
e Seconds
ts = ClientRequest -> ByteString
clientRequestURL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
AWSRequest a =>
AuthEnv -> Region -> UTCTime -> Seconds -> a -> ClientRequest
presign AuthEnv
a Region
r UTCTime
e Seconds
ts

-- | Presign an HTTP request that is valid from the specified time until the
-- number of seconds expiry has elapsed.
--
-- /See:/ 'presignWith', 'presignWithHeaders'
presign ::
  (AWSRequest a) =>
  AuthEnv ->
  Region ->
  -- | Signing time.
  UTCTime ->
  -- | Expiry time.
  Seconds ->
  -- | Request to presign.
  a ->
  ClientRequest
presign :: forall a.
AWSRequest a =>
AuthEnv -> Region -> UTCTime -> Seconds -> a -> ClientRequest
presign =
  forall a.
AWSRequest a =>
(Service -> Service)
-> AuthEnv -> Region -> UTCTime -> Seconds -> a -> ClientRequest
presignWith forall a. a -> a
id

-- | A variant of 'presign' that allows modifying the default 'Service'
-- definition used to configure the request.
--
-- /See:/ 'presignWithHeaders'
presignWith ::
  (AWSRequest a) =>
  -- | Modify the default service configuration.
  (Service -> Service) ->
  AuthEnv ->
  Region ->
  -- | Signing time.
  UTCTime ->
  -- | Expiry time.
  Seconds ->
  -- | Request to presign.
  a ->
  ClientRequest
presignWith :: forall a.
AWSRequest a =>
(Service -> Service)
-> AuthEnv -> Region -> UTCTime -> Seconds -> a -> ClientRequest
presignWith = forall a.
AWSRequest a =>
([Header] -> [Header])
-> (Service -> Service)
-> AuthEnv
-> Region
-> UTCTime
-> Seconds
-> a
-> ClientRequest
presignWithHeaders [Header] -> [Header]
defaultHeaders

-- | Modification to the headers that is applied by default (in 'presignWith');
-- removes the "Expect" header which is added to every 'PutObject'.
defaultHeaders :: [HTTP.Header] -> [HTTP.Header]
defaultHeaders :: [Header] -> [Header]
defaultHeaders = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= HeaderName
hExpect) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | A variant of 'presign' that allows modifying the default 'Headers'
-- and the default 'Service' definition used to configure the request.
presignWithHeaders ::
  forall a.
  (AWSRequest a) =>
  -- | Modify the default headers.
  ([Header] -> [Header]) ->
  -- | Modify the default service configuration.
  (Service -> Service) ->
  AuthEnv ->
  Region ->
  -- | Signing time.
  UTCTime ->
  -- | Expiry time.
  Seconds ->
  -- | Request to presign.
  a ->
  ClientRequest
presignWithHeaders :: forall a.
AWSRequest a =>
([Header] -> [Header])
-> (Service -> Service)
-> AuthEnv
-> Region
-> UTCTime
-> Seconds
-> a
-> ClientRequest
presignWithHeaders [Header] -> [Header]
f Service -> Service
g AuthEnv
ae Region
r UTCTime
ts Seconds
ex a
x =
  let rq :: Request a
rq@Request {[Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers :: [Header]
headers} = forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request Service -> Service
g a
x
      rq' :: Request a
      rq' :: Request a
rq' = Request a
rq {$sel:headers:Request :: [Header]
headers = [Header] -> [Header]
f [Header]
headers}
      !creq :: ClientRequest
creq = forall a. Signed a -> ClientRequest
signedRequest forall a b. (a -> b) -> a -> b
$ forall a. Seconds -> Algorithm a
requestPresign Seconds
ex Request a
rq' AuthEnv
ae Region
r UTCTime
ts
   in ClientRequest
creq