-- |
-- Module      : Amazonka.Types
-- 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.Types
  ( -- * Authentication

    -- ** Credentials
    AccessKey (..),
    SecretKey (..),
    SessionToken (..),

    -- *** Optics
    _AccessKey,
    _SecretKey,
    _SessionToken,

    -- ** Environment
    Auth (..),
    withAuth,
    AuthEnv (..),

    -- *** Lenses
    authEnv_accessKeyId,
    authEnv_secretAccessKey,
    authEnv_sessionToken,
    authEnv_expiration,

    -- * Signing
    Algorithm,
    Meta (..),
    Signer (..),
    Signed (..),

    -- ** Lenses
    signed_signedMeta,
    signed_signedRequest,

    -- * Service
    Abbrev,
    Service (..),
    S3AddressingStyle (..),

    -- ** Optics
    _Abbrev,
    service_abbrev,
    service_signer,
    service_signingName,
    service_version,
    service_s3AddressingStyle,
    service_endpointPrefix,
    service_endpoint,
    service_timeout,
    service_check,
    service_error,
    service_retry,

    -- * Requests
    AWSRequest (..),
    Request (..),
    requestSign,
    requestPresign,
    requestUnsigned,

    -- ** Lenses
    request_service,
    request_method,
    request_path,
    request_query,
    request_headers,
    request_body,

    -- * Retries
    Retry (..),

    -- ** Lenses
    retry_base,
    retry_growth,
    retry_attempts,
    retry_check,

    -- * Errors
    AsError (..),
    Error (..),

    -- ** HTTP Errors
    Client.HttpException,

    -- ** Serialize Errors
    SerializeError (..),

    -- *** Lenses
    serializeError_abbrev,
    serializeError_status,
    serializeError_body,
    serializeError_message,

    -- ** Service Errors
    ServiceError (..),

    -- *** Lenses
    serviceError_abbrev,
    serviceError_status,
    serviceError_headers,
    serviceError_code,
    serviceError_message,
    serviceError_requestId,

    -- ** Error Types
    ErrorCode (..),
    newErrorCode,
    ErrorMessage (..),
    RequestId (..),

    -- *** Optics
    _ErrorCode,
    _ErrorMessage,
    _RequestId,

    -- * Regions
    Region
      ( Ohio,
        NorthVirginia,
        NorthCalifornia,
        Oregon,
        CapeTown,
        HongKong,
        Hyderabad,
        Jakarta,
        Melbourne,
        Mumbai,
        Osaka,
        Seoul,
        Singapore,
        Sydney,
        Tokyo,
        Montreal,
        Frankfurt,
        Ireland,
        London,
        Milan,
        Paris,
        Spain,
        Stockholm,
        Zurich,
        Bahrain,
        UAE,
        SaoPaulo,
        GovCloudEast,
        GovCloudWest,
        Beijing,
        Ningxia,
        ..
      ),

    -- * Endpoints
    Endpoint (..),

    -- ** Lenses
    endpoint_host,
    endpoint_basePath,
    endpoint_secure,
    endpoint_port,
    endpoint_scope,

    -- * HTTP
    ClientRequest,
    ClientResponse,
    ClientBody,
    newClientRequest,

    -- ** Seconds
    Seconds (..),
    toSeconds,
    toMicroseconds,
  )
where

import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.Data
import Amazonka.Prelude hiding (error)
import Control.Concurrent (ThreadId)
import Control.Monad.Trans.Resource (ResourceT)
import Data.Conduit (ConduitM)
import Data.IORef (IORef, readIORef)
import qualified Data.Text as Text
import Data.Time (defaultTimeLocale, formatTime, parseTimeM)
import qualified Network.HTTP.Client as Client
import Network.HTTP.Types.Method (StdMethod)
import Network.HTTP.Types.Status (Status)

-- | A convenience alias to avoid type ambiguity.
type ClientRequest = Client.Request

-- | Construct a 'ClientRequest' using common parameters such as TLS and prevent
-- throwing errors when receiving erroneous status codes in respones.
newClientRequest :: Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest :: Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest Endpoint {ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host :: ByteString
host, Bool
$sel:secure:Endpoint :: Endpoint -> Bool
secure :: Bool
secure, Int
$sel:port:Endpoint :: Endpoint -> Int
port :: Int
port} Maybe Seconds
timeout =
  ClientRequest
Client.defaultRequest
    { secure :: Bool
Client.secure = Bool
secure,
      host :: ByteString
Client.host = ByteString
host,
      port :: Int
Client.port = Int
port,
      redirectCount :: Int
Client.redirectCount = Int
0,
      responseTimeout :: ResponseTimeout
Client.responseTimeout =
        case Maybe Seconds
timeout of
          Maybe Seconds
Nothing -> ResponseTimeout
Client.responseTimeoutNone
          Just Seconds
n -> Int -> ResponseTimeout
Client.responseTimeoutMicro (Seconds -> Int
toMicroseconds Seconds
n)
    }

-- | A convenience alias encapsulating the common 'Response'.
type ClientResponse = Client.Response

-- | A convenience alias encapsulating the common 'Response' body.
type ClientBody = ConduitM () ByteString (ResourceT IO) ()

-- | Abbreviated service name.
newtype Abbrev = Abbrev {Abbrev -> Text
fromAbbrev :: Text}
  deriving stock (Abbrev -> Abbrev -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Abbrev -> Abbrev -> Bool
$c/= :: Abbrev -> Abbrev -> Bool
== :: Abbrev -> Abbrev -> Bool
$c== :: Abbrev -> Abbrev -> Bool
Eq, Eq Abbrev
Abbrev -> Abbrev -> Bool
Abbrev -> Abbrev -> Ordering
Abbrev -> Abbrev -> Abbrev
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Abbrev -> Abbrev -> Abbrev
$cmin :: Abbrev -> Abbrev -> Abbrev
max :: Abbrev -> Abbrev -> Abbrev
$cmax :: Abbrev -> Abbrev -> Abbrev
>= :: Abbrev -> Abbrev -> Bool
$c>= :: Abbrev -> Abbrev -> Bool
> :: Abbrev -> Abbrev -> Bool
$c> :: Abbrev -> Abbrev -> Bool
<= :: Abbrev -> Abbrev -> Bool
$c<= :: Abbrev -> Abbrev -> Bool
< :: Abbrev -> Abbrev -> Bool
$c< :: Abbrev -> Abbrev -> Bool
compare :: Abbrev -> Abbrev -> Ordering
$ccompare :: Abbrev -> Abbrev -> Ordering
Ord, Int -> Abbrev -> ShowS
[Abbrev] -> ShowS
Abbrev -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Abbrev] -> ShowS
$cshowList :: [Abbrev] -> ShowS
show :: Abbrev -> String
$cshow :: Abbrev -> String
showsPrec :: Int -> Abbrev -> ShowS
$cshowsPrec :: Int -> Abbrev -> ShowS
Show, forall x. Rep Abbrev x -> Abbrev
forall x. Abbrev -> Rep Abbrev x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Abbrev x -> Abbrev
$cfrom :: forall x. Abbrev -> Rep Abbrev x
Generic)
  deriving newtype (String -> Abbrev
forall a. (String -> a) -> IsString a
fromString :: String -> Abbrev
$cfromString :: String -> Abbrev
IsString, [Node] -> Either String Abbrev
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String Abbrev
$cparseXML :: [Node] -> Either String Abbrev
FromXML, Value -> Parser [Abbrev]
Value -> Parser Abbrev
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Abbrev]
$cparseJSONList :: Value -> Parser [Abbrev]
parseJSON :: Value -> Parser Abbrev
$cparseJSON :: Value -> Parser Abbrev
FromJSON, Text -> Either String Abbrev
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String Abbrev
$cfromText :: Text -> Either String Abbrev
FromText, Abbrev -> Text
forall a. (a -> Text) -> ToText a
toText :: Abbrev -> Text
$ctoText :: Abbrev -> Text
ToText, Abbrev -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: Abbrev -> ByteStringBuilder
$cbuild :: Abbrev -> ByteStringBuilder
ToLog)

{-# INLINE _Abbrev #-}
_Abbrev :: Iso' Abbrev Text
_Abbrev :: Iso' Abbrev Text
_Abbrev = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

newtype ErrorCode = ErrorCode Text
  deriving stock (ErrorCode -> ErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorCode -> ErrorCode -> Bool
$c/= :: ErrorCode -> ErrorCode -> Bool
== :: ErrorCode -> ErrorCode -> Bool
$c== :: ErrorCode -> ErrorCode -> Bool
Eq, Eq ErrorCode
ErrorCode -> ErrorCode -> Bool
ErrorCode -> ErrorCode -> Ordering
ErrorCode -> ErrorCode -> ErrorCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorCode -> ErrorCode -> ErrorCode
$cmin :: ErrorCode -> ErrorCode -> ErrorCode
max :: ErrorCode -> ErrorCode -> ErrorCode
$cmax :: ErrorCode -> ErrorCode -> ErrorCode
>= :: ErrorCode -> ErrorCode -> Bool
$c>= :: ErrorCode -> ErrorCode -> Bool
> :: ErrorCode -> ErrorCode -> Bool
$c> :: ErrorCode -> ErrorCode -> Bool
<= :: ErrorCode -> ErrorCode -> Bool
$c<= :: ErrorCode -> ErrorCode -> Bool
< :: ErrorCode -> ErrorCode -> Bool
$c< :: ErrorCode -> ErrorCode -> Bool
compare :: ErrorCode -> ErrorCode -> Ordering
$ccompare :: ErrorCode -> ErrorCode -> Ordering
Ord, Int -> ErrorCode -> ShowS
[ErrorCode] -> ShowS
ErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorCode] -> ShowS
$cshowList :: [ErrorCode] -> ShowS
show :: ErrorCode -> String
$cshow :: ErrorCode -> String
showsPrec :: Int -> ErrorCode -> ShowS
$cshowsPrec :: Int -> ErrorCode -> ShowS
Show)
  deriving newtype (ErrorCode -> Text
forall a. (a -> Text) -> ToText a
toText :: ErrorCode -> Text
$ctoText :: ErrorCode -> Text
ToText, ErrorCode -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: ErrorCode -> ByteStringBuilder
$cbuild :: ErrorCode -> ByteStringBuilder
ToLog)

{-# INLINE _ErrorCode #-}
_ErrorCode :: Iso' ErrorCode Text
_ErrorCode :: Iso' ErrorCode Text
_ErrorCode = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance IsString ErrorCode where
  fromString :: String -> ErrorCode
fromString = Text -> ErrorCode
newErrorCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance FromJSON ErrorCode where
  parseJSON :: Value -> Parser ErrorCode
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"ErrorCode"

instance FromXML ErrorCode where
  parseXML :: [Node] -> Either String ErrorCode
parseXML = forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"ErrorCode"

instance FromText ErrorCode where
  fromText :: Text -> Either String ErrorCode
fromText = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ErrorCode
newErrorCode

-- | Construct an 'ErrorCode'.
newErrorCode :: Text -> ErrorCode
newErrorCode :: Text -> ErrorCode
newErrorCode = Text -> ErrorCode
ErrorCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unnamespace
  where
    -- Common suffixes are stripped since the service definitions are ambigiuous
    -- as to whether the error shape's name, or the error code is present
    -- in the response.
    strip :: Text -> Text
strip Text
x =
      forall a. a -> Maybe a -> a
fromMaybe Text
x forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Maybe Text
Text.stripSuffix Text
"Exception" Text
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Text -> Maybe Text
Text.stripSuffix Text
"Fault" Text
x

    -- Removing the (potential) leading ...# namespace.
    unnamespace :: Text -> Text
unnamespace Text
x =
      case (Char -> Bool) -> Text -> (Text, Text)
Text.break (forall a. Eq a => a -> a -> Bool
== Char
'#') Text
x of
        (Text
ns, Text
e)
          | Text -> Bool
Text.null Text
e -> Text
ns
          | Bool
otherwise -> Int -> Text -> Text
Text.drop Int
1 Text
e

newtype ErrorMessage = ErrorMessage {ErrorMessage -> Text
fromErrorMessage :: Text}
  deriving stock (ErrorMessage -> ErrorMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorMessage -> ErrorMessage -> Bool
$c/= :: ErrorMessage -> ErrorMessage -> Bool
== :: ErrorMessage -> ErrorMessage -> Bool
$c== :: ErrorMessage -> ErrorMessage -> Bool
Eq, Eq ErrorMessage
ErrorMessage -> ErrorMessage -> Bool
ErrorMessage -> ErrorMessage -> Ordering
ErrorMessage -> ErrorMessage -> ErrorMessage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorMessage -> ErrorMessage -> ErrorMessage
$cmin :: ErrorMessage -> ErrorMessage -> ErrorMessage
max :: ErrorMessage -> ErrorMessage -> ErrorMessage
$cmax :: ErrorMessage -> ErrorMessage -> ErrorMessage
>= :: ErrorMessage -> ErrorMessage -> Bool
$c>= :: ErrorMessage -> ErrorMessage -> Bool
> :: ErrorMessage -> ErrorMessage -> Bool
$c> :: ErrorMessage -> ErrorMessage -> Bool
<= :: ErrorMessage -> ErrorMessage -> Bool
$c<= :: ErrorMessage -> ErrorMessage -> Bool
< :: ErrorMessage -> ErrorMessage -> Bool
$c< :: ErrorMessage -> ErrorMessage -> Bool
compare :: ErrorMessage -> ErrorMessage -> Ordering
$ccompare :: ErrorMessage -> ErrorMessage -> Ordering
Ord, Int -> ErrorMessage -> ShowS
[ErrorMessage] -> ShowS
ErrorMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorMessage] -> ShowS
$cshowList :: [ErrorMessage] -> ShowS
show :: ErrorMessage -> String
$cshow :: ErrorMessage -> String
showsPrec :: Int -> ErrorMessage -> ShowS
$cshowsPrec :: Int -> ErrorMessage -> ShowS
Show, forall x. Rep ErrorMessage x -> ErrorMessage
forall x. ErrorMessage -> Rep ErrorMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorMessage x -> ErrorMessage
$cfrom :: forall x. ErrorMessage -> Rep ErrorMessage x
Generic)
  deriving newtype (String -> ErrorMessage
forall a. (String -> a) -> IsString a
fromString :: String -> ErrorMessage
$cfromString :: String -> ErrorMessage
IsString, [Node] -> Either String ErrorMessage
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String ErrorMessage
$cparseXML :: [Node] -> Either String ErrorMessage
FromXML, Value -> Parser [ErrorMessage]
Value -> Parser ErrorMessage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ErrorMessage]
$cparseJSONList :: Value -> Parser [ErrorMessage]
parseJSON :: Value -> Parser ErrorMessage
$cparseJSON :: Value -> Parser ErrorMessage
FromJSON, Text -> Either String ErrorMessage
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String ErrorMessage
$cfromText :: Text -> Either String ErrorMessage
FromText, ErrorMessage -> Text
forall a. (a -> Text) -> ToText a
toText :: ErrorMessage -> Text
$ctoText :: ErrorMessage -> Text
ToText, ErrorMessage -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: ErrorMessage -> ByteStringBuilder
$cbuild :: ErrorMessage -> ByteStringBuilder
ToLog)

{-# INLINE _ErrorMessage #-}
_ErrorMessage :: Iso' ErrorMessage Text
_ErrorMessage :: Iso' ErrorMessage Text
_ErrorMessage = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

newtype RequestId = RequestId {RequestId -> Text
fromRequestId :: Text}
  deriving stock (RequestId -> RequestId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestId -> RequestId -> Bool
$c/= :: RequestId -> RequestId -> Bool
== :: RequestId -> RequestId -> Bool
$c== :: RequestId -> RequestId -> Bool
Eq, Eq RequestId
RequestId -> RequestId -> Bool
RequestId -> RequestId -> Ordering
RequestId -> RequestId -> RequestId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RequestId -> RequestId -> RequestId
$cmin :: RequestId -> RequestId -> RequestId
max :: RequestId -> RequestId -> RequestId
$cmax :: RequestId -> RequestId -> RequestId
>= :: RequestId -> RequestId -> Bool
$c>= :: RequestId -> RequestId -> Bool
> :: RequestId -> RequestId -> Bool
$c> :: RequestId -> RequestId -> Bool
<= :: RequestId -> RequestId -> Bool
$c<= :: RequestId -> RequestId -> Bool
< :: RequestId -> RequestId -> Bool
$c< :: RequestId -> RequestId -> Bool
compare :: RequestId -> RequestId -> Ordering
$ccompare :: RequestId -> RequestId -> Ordering
Ord, Int -> RequestId -> ShowS
[RequestId] -> ShowS
RequestId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestId] -> ShowS
$cshowList :: [RequestId] -> ShowS
show :: RequestId -> String
$cshow :: RequestId -> String
showsPrec :: Int -> RequestId -> ShowS
$cshowsPrec :: Int -> RequestId -> ShowS
Show, forall x. Rep RequestId x -> RequestId
forall x. RequestId -> Rep RequestId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestId x -> RequestId
$cfrom :: forall x. RequestId -> Rep RequestId x
Generic)
  deriving newtype (String -> RequestId
forall a. (String -> a) -> IsString a
fromString :: String -> RequestId
$cfromString :: String -> RequestId
IsString, [Node] -> Either String RequestId
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String RequestId
$cparseXML :: [Node] -> Either String RequestId
FromXML, Value -> Parser [RequestId]
Value -> Parser RequestId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RequestId]
$cparseJSONList :: Value -> Parser [RequestId]
parseJSON :: Value -> Parser RequestId
$cparseJSON :: Value -> Parser RequestId
FromJSON, Text -> Either String RequestId
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String RequestId
$cfromText :: Text -> Either String RequestId
FromText, RequestId -> Text
forall a. (a -> Text) -> ToText a
toText :: RequestId -> Text
$ctoText :: RequestId -> Text
ToText, RequestId -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: RequestId -> ByteStringBuilder
$cbuild :: RequestId -> ByteStringBuilder
ToLog)

{-# INLINE _RequestId #-}
_RequestId :: Iso' RequestId Text
_RequestId :: Iso' RequestId Text
_RequestId = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An error type representing errors that can be attributed to this library.
data Error
  = TransportError Client.HttpException
  | SerializeError SerializeError
  | ServiceError ServiceError
  deriving stock (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic)

instance Exception Error

instance ToLog Error where
  build :: Error -> ByteStringBuilder
build = \case
    TransportError HttpException
e -> forall a. ToLog a => a -> ByteStringBuilder
build HttpException
e
    SerializeError SerializeError
e -> forall a. ToLog a => a -> ByteStringBuilder
build SerializeError
e
    ServiceError ServiceError
e -> forall a. ToLog a => a -> ByteStringBuilder
build ServiceError
e

data SerializeError = SerializeError'
  { SerializeError -> Abbrev
abbrev :: Abbrev,
    SerializeError -> Status
status :: Status,
    -- | The response body, if the response was not streaming.
    SerializeError -> Maybe ByteStringLazy
body :: Maybe ByteStringLazy,
    SerializeError -> String
message :: String
  }
  deriving stock (SerializeError -> SerializeError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerializeError -> SerializeError -> Bool
$c/= :: SerializeError -> SerializeError -> Bool
== :: SerializeError -> SerializeError -> Bool
$c== :: SerializeError -> SerializeError -> Bool
Eq, Int -> SerializeError -> ShowS
[SerializeError] -> ShowS
SerializeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializeError] -> ShowS
$cshowList :: [SerializeError] -> ShowS
show :: SerializeError -> String
$cshow :: SerializeError -> String
showsPrec :: Int -> SerializeError -> ShowS
$cshowsPrec :: Int -> SerializeError -> ShowS
Show, forall x. Rep SerializeError x -> SerializeError
forall x. SerializeError -> Rep SerializeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SerializeError x -> SerializeError
$cfrom :: forall x. SerializeError -> Rep SerializeError x
Generic)

instance ToLog SerializeError where
  build :: SerializeError -> ByteStringBuilder
build SerializeError' {String
Maybe ByteStringLazy
Status
Abbrev
message :: String
body :: Maybe ByteStringLazy
status :: Status
abbrev :: Abbrev
$sel:message:SerializeError' :: SerializeError -> String
$sel:body:SerializeError' :: SerializeError -> Maybe ByteStringLazy
$sel:status:SerializeError' :: SerializeError -> Status
$sel:abbrev:SerializeError' :: SerializeError -> Abbrev
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[SerializeError] {",
        ByteStringBuilder
"  service = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Abbrev
abbrev,
        ByteStringBuilder
"  status  = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Status
status,
        ByteStringBuilder
"  message = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build String
message,
        ByteStringBuilder
"  body    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Maybe ByteStringLazy
body,
        ByteStringBuilder
"}"
      ]

{-# INLINE serializeError_abbrev #-}
serializeError_abbrev :: Lens' SerializeError Abbrev
serializeError_abbrev :: Lens' SerializeError Abbrev
serializeError_abbrev Abbrev -> f Abbrev
f e :: SerializeError
e@SerializeError' {Abbrev
abbrev :: Abbrev
$sel:abbrev:SerializeError' :: SerializeError -> Abbrev
abbrev} = Abbrev -> f Abbrev
f Abbrev
abbrev forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Abbrev
abbrev' -> (SerializeError
e :: SerializeError) {$sel:abbrev:SerializeError' :: Abbrev
abbrev = Abbrev
abbrev'}

{-# INLINE serializeError_status #-}
serializeError_status :: Lens' SerializeError Status
serializeError_status :: Lens' SerializeError Status
serializeError_status Status -> f Status
f e :: SerializeError
e@SerializeError' {Status
status :: Status
$sel:status:SerializeError' :: SerializeError -> Status
status} = Status -> f Status
f Status
status forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Status
status' -> (SerializeError
e :: SerializeError) {$sel:status:SerializeError' :: Status
status = Status
status'}

{-# INLINE serializeError_body #-}
serializeError_body :: Lens' SerializeError (Maybe ByteStringLazy)
serializeError_body :: Lens' SerializeError (Maybe ByteStringLazy)
serializeError_body Maybe ByteStringLazy -> f (Maybe ByteStringLazy)
f e :: SerializeError
e@SerializeError' {Maybe ByteStringLazy
body :: Maybe ByteStringLazy
$sel:body:SerializeError' :: SerializeError -> Maybe ByteStringLazy
body} = Maybe ByteStringLazy -> f (Maybe ByteStringLazy)
f Maybe ByteStringLazy
body forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe ByteStringLazy
body' -> (SerializeError
e :: SerializeError) {$sel:body:SerializeError' :: Maybe ByteStringLazy
body = Maybe ByteStringLazy
body'}

{-# INLINE serializeError_message #-}
serializeError_message :: Lens' SerializeError String
serializeError_message :: Lens' SerializeError String
serializeError_message String -> f String
f e :: SerializeError
e@SerializeError' {String
message :: String
$sel:message:SerializeError' :: SerializeError -> String
message} = String -> f String
f String
message forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
message' -> (SerializeError
e :: SerializeError) {$sel:message:SerializeError' :: String
message = String
message'}

data ServiceError = ServiceError'
  { ServiceError -> Abbrev
abbrev :: Abbrev,
    ServiceError -> Status
status :: Status,
    ServiceError -> [Header]
headers :: [Header],
    ServiceError -> ErrorCode
code :: ErrorCode,
    ServiceError -> Maybe ErrorMessage
message :: Maybe ErrorMessage,
    ServiceError -> Maybe RequestId
requestId :: Maybe RequestId
  }
  deriving stock (ServiceError -> ServiceError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceError -> ServiceError -> Bool
$c/= :: ServiceError -> ServiceError -> Bool
== :: ServiceError -> ServiceError -> Bool
$c== :: ServiceError -> ServiceError -> Bool
Eq, Int -> ServiceError -> ShowS
[ServiceError] -> ShowS
ServiceError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceError] -> ShowS
$cshowList :: [ServiceError] -> ShowS
show :: ServiceError -> String
$cshow :: ServiceError -> String
showsPrec :: Int -> ServiceError -> ShowS
$cshowsPrec :: Int -> ServiceError -> ShowS
Show, forall x. Rep ServiceError x -> ServiceError
forall x. ServiceError -> Rep ServiceError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServiceError x -> ServiceError
$cfrom :: forall x. ServiceError -> Rep ServiceError x
Generic)

instance ToLog ServiceError where
  build :: ServiceError -> ByteStringBuilder
build ServiceError' {[Header]
Maybe RequestId
Maybe ErrorMessage
Status
ErrorCode
Abbrev
requestId :: Maybe RequestId
message :: Maybe ErrorMessage
code :: ErrorCode
headers :: [Header]
status :: Status
abbrev :: Abbrev
$sel:requestId:ServiceError' :: ServiceError -> Maybe RequestId
$sel:message:ServiceError' :: ServiceError -> Maybe ErrorMessage
$sel:code:ServiceError' :: ServiceError -> ErrorCode
$sel:headers:ServiceError' :: ServiceError -> [Header]
$sel:status:ServiceError' :: ServiceError -> Status
$sel:abbrev:ServiceError' :: ServiceError -> Abbrev
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[ServiceError] {",
        ByteStringBuilder
"  service    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Abbrev
abbrev,
        ByteStringBuilder
"  status     = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Status
status,
        ByteStringBuilder
"  code       = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build ErrorCode
code,
        ByteStringBuilder
"  message    = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Maybe ErrorMessage
message,
        ByteStringBuilder
"  request-id = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Maybe RequestId
requestId,
        ByteStringBuilder
"}"
      ]

{-# INLINE serviceError_abbrev #-}
serviceError_abbrev :: Lens' ServiceError Abbrev
serviceError_abbrev :: Lens' ServiceError Abbrev
serviceError_abbrev Abbrev -> f Abbrev
f e :: ServiceError
e@ServiceError' {Abbrev
abbrev :: Abbrev
$sel:abbrev:ServiceError' :: ServiceError -> Abbrev
abbrev} = Abbrev -> f Abbrev
f Abbrev
abbrev forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Abbrev
abbrev' -> (ServiceError
e :: ServiceError) {$sel:abbrev:ServiceError' :: Abbrev
abbrev = Abbrev
abbrev'}

{-# INLINE serviceError_status #-}
serviceError_status :: Lens' ServiceError Status
serviceError_status :: Lens' ServiceError Status
serviceError_status Status -> f Status
f e :: ServiceError
e@ServiceError' {Status
status :: Status
$sel:status:ServiceError' :: ServiceError -> Status
status} = Status -> f Status
f Status
status forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Status
status' -> (ServiceError
e :: ServiceError) {$sel:status:ServiceError' :: Status
status = Status
status'}

{-# INLINE serviceError_headers #-}
serviceError_headers :: Lens' ServiceError [Header]
serviceError_headers :: Lens' ServiceError [Header]
serviceError_headers [Header] -> f [Header]
f e :: ServiceError
e@ServiceError' {[Header]
headers :: [Header]
$sel:headers:ServiceError' :: ServiceError -> [Header]
headers} = [Header] -> f [Header]
f [Header]
headers forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Header]
headers' -> (ServiceError
e :: ServiceError) {$sel:headers:ServiceError' :: [Header]
headers = [Header]
headers'}

{-# INLINE serviceError_code #-}
serviceError_code :: Lens' ServiceError ErrorCode
serviceError_code :: Lens' ServiceError ErrorCode
serviceError_code ErrorCode -> f ErrorCode
f e :: ServiceError
e@ServiceError' {ErrorCode
code :: ErrorCode
$sel:code:ServiceError' :: ServiceError -> ErrorCode
code} = ErrorCode -> f ErrorCode
f ErrorCode
code forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ErrorCode
code' -> ServiceError
e {$sel:code:ServiceError' :: ErrorCode
code = ErrorCode
code'}

{-# INLINE serviceError_message #-}
serviceError_message :: Lens' ServiceError (Maybe ErrorMessage)
serviceError_message :: Lens' ServiceError (Maybe ErrorMessage)
serviceError_message Maybe ErrorMessage -> f (Maybe ErrorMessage)
f e :: ServiceError
e@ServiceError' {Maybe ErrorMessage
message :: Maybe ErrorMessage
$sel:message:ServiceError' :: ServiceError -> Maybe ErrorMessage
message} = Maybe ErrorMessage -> f (Maybe ErrorMessage)
f Maybe ErrorMessage
message forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe ErrorMessage
message' -> (ServiceError
e :: ServiceError) {$sel:message:ServiceError' :: Maybe ErrorMessage
message = Maybe ErrorMessage
message'}

{-# INLINE serviceError_requestId #-}
serviceError_requestId :: Lens' ServiceError (Maybe RequestId)
serviceError_requestId :: Lens' ServiceError (Maybe RequestId)
serviceError_requestId Maybe RequestId -> f (Maybe RequestId)
f e :: ServiceError
e@ServiceError' {Maybe RequestId
requestId :: Maybe RequestId
$sel:requestId:ServiceError' :: ServiceError -> Maybe RequestId
requestId} = Maybe RequestId -> f (Maybe RequestId)
f Maybe RequestId
requestId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe RequestId
requestId' -> (ServiceError
e :: ServiceError) {$sel:requestId:ServiceError' :: Maybe RequestId
requestId = Maybe RequestId
requestId'}

class AsError a where
  -- | A general Amazonka error.
  _Error :: Prism' a Error

  {-# MINIMAL _Error #-}

  -- | An error occured while communicating over HTTP with a remote service.
  _TransportError :: Prism' a Client.HttpException

  -- | A serialisation error occured when attempting to deserialise a response.
  _SerializeError :: Prism' a SerializeError

  -- | A service specific error returned by the remote service.
  _ServiceError :: Prism' a ServiceError

  _TransportError = forall a. AsError a => Prism' a Error
_Error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsError a => Prism' a HttpException
_TransportError
  _SerializeError = forall a. AsError a => Prism' a Error
_Error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsError a => Prism' a SerializeError
_SerializeError
  _ServiceError = forall a. AsError a => Prism' a Error
_Error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsError a => Prism' a ServiceError
_ServiceError

instance AsError SomeException where
  _Error :: Prism' SomeException Error
_Error = forall a. Exception a => Prism' SomeException a
Lens.exception

instance AsError Error where
  _Error :: Prism' Error Error
_Error = forall a. a -> a
id

  _TransportError :: Prism' Error HttpException
_TransportError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
Lens.prism HttpException -> Error
TransportError forall a b. (a -> b) -> a -> b
$ \case
    TransportError HttpException
e -> forall a b. b -> Either a b
Right HttpException
e
    Error
x -> forall a b. a -> Either a b
Left Error
x

  _SerializeError :: Prism' Error SerializeError
_SerializeError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
Lens.prism SerializeError -> Error
SerializeError forall a b. (a -> b) -> a -> b
$ \case
    SerializeError SerializeError
e -> forall a b. b -> Either a b
Right SerializeError
e
    Error
x -> forall a b. a -> Either a b
Left Error
x

  _ServiceError :: Prism' Error ServiceError
_ServiceError = forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
Lens.prism ServiceError -> Error
ServiceError forall a b. (a -> b) -> a -> b
$ \case
    ServiceError ServiceError
e -> forall a b. b -> Either a b
Right ServiceError
e
    Error
x -> forall a b. a -> Either a b
Left Error
x

data Endpoint = Endpoint
  { -- | The host to make requests to. Usually something like
    -- @s3.us-east-1.amazonaws.com@.
    Endpoint -> ByteString
host :: ByteString,
    -- | Path segment prepended to the request path of any request
    -- made to this endpoint. This is useful if you want to use the
    -- AWS API Gateway Management API, which requires you to override
    -- the client endpoint including a leading path segment (either
    -- the stage or, on a custom domain, the mapped base path).
    Endpoint -> RawPath
basePath :: RawPath,
    Endpoint -> Bool
secure :: Bool,
    Endpoint -> Int
port :: Int,
    -- | Signing scope, usually a region like @us-east-1@.
    Endpoint -> ByteString
scope :: ByteString
  }
  deriving stock (Endpoint -> Endpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show, forall x. Rep Endpoint x -> Endpoint
forall x. Endpoint -> Rep Endpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Endpoint x -> Endpoint
$cfrom :: forall x. Endpoint -> Rep Endpoint x
Generic)

{-# INLINE endpoint_host #-}
endpoint_host :: Lens' Endpoint ByteString
endpoint_host :: Lens' Endpoint ByteString
endpoint_host ByteString -> f ByteString
f e :: Endpoint
e@Endpoint {ByteString
host :: ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host} = ByteString -> f ByteString
f ByteString
host forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
host' -> Endpoint
e {$sel:host:Endpoint :: ByteString
host = ByteString
host'}

{-# INLINE endpoint_basePath #-}
endpoint_basePath :: Lens' Endpoint RawPath
endpoint_basePath :: Lens' Endpoint RawPath
endpoint_basePath RawPath -> f RawPath
f e :: Endpoint
e@Endpoint {RawPath
basePath :: RawPath
$sel:basePath:Endpoint :: Endpoint -> RawPath
basePath} = RawPath -> f RawPath
f RawPath
basePath forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \RawPath
basePath' -> Endpoint
e {$sel:basePath:Endpoint :: RawPath
basePath = RawPath
basePath'}

{-# INLINE endpoint_secure #-}
endpoint_secure :: Lens' Endpoint Bool
endpoint_secure :: Lens' Endpoint Bool
endpoint_secure Bool -> f Bool
f e :: Endpoint
e@Endpoint {Bool
secure :: Bool
$sel:secure:Endpoint :: Endpoint -> Bool
secure} = Bool -> f Bool
f Bool
secure forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Bool
secure' -> Endpoint
e {$sel:secure:Endpoint :: Bool
secure = Bool
secure'}

{-# INLINE endpoint_port #-}
endpoint_port :: Lens' Endpoint Int
endpoint_port :: Lens' Endpoint Int
endpoint_port Int -> f Int
f e :: Endpoint
e@Endpoint {Int
port :: Int
$sel:port:Endpoint :: Endpoint -> Int
port} = Int -> f Int
f Int
port forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
port' -> Endpoint
e {$sel:port:Endpoint :: Int
port = Int
port'}

{-# INLINE endpoint_scope #-}
endpoint_scope :: Lens' Endpoint ByteString
endpoint_scope :: Lens' Endpoint ByteString
endpoint_scope ByteString -> f ByteString
f e :: Endpoint
e@Endpoint {ByteString
scope :: ByteString
$sel:scope:Endpoint :: Endpoint -> ByteString
scope} = ByteString -> f ByteString
f ByteString
scope forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
scope' -> Endpoint
e {$sel:scope:Endpoint :: ByteString
scope = ByteString
scope'}

-- | Constants and predicates used to create a 'RetryPolicy'.
data Retry = Exponential
  { Retry -> Double
base :: Double,
    Retry -> Int
growth :: Int,
    Retry -> Int
attempts :: Int,
    -- | Returns a descriptive name for logging
    -- if the request should be retried.
    Retry -> ServiceError -> Maybe Text
check :: ServiceError -> Maybe Text
  }
  deriving stock (forall x. Rep Retry x -> Retry
forall x. Retry -> Rep Retry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Retry x -> Retry
$cfrom :: forall x. Retry -> Rep Retry x
Generic)

{-# INLINE retry_base #-}
retry_base :: Lens' Retry Double
retry_base :: Lens' Retry Double
retry_base Double -> f Double
f r :: Retry
r@Exponential {Double
base :: Double
$sel:base:Exponential :: Retry -> Double
base} = Double -> f Double
f Double
base forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Double
base' -> Retry
r {$sel:base:Exponential :: Double
base = Double
base'}

{-# INLINE retry_growth #-}
retry_growth :: Lens' Retry Int
retry_growth :: Lens' Retry Int
retry_growth Int -> f Int
f r :: Retry
r@Exponential {Int
growth :: Int
$sel:growth:Exponential :: Retry -> Int
growth} = Int -> f Int
f Int
growth forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
growth' -> Retry
r {$sel:growth:Exponential :: Int
growth = Int
growth'}

{-# INLINE retry_attempts #-}
retry_attempts :: Lens' Retry Int
retry_attempts :: Lens' Retry Int
retry_attempts Int -> f Int
f r :: Retry
r@Exponential {Int
attempts :: Int
$sel:attempts:Exponential :: Retry -> Int
attempts} = Int -> f Int
f Int
attempts forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
attempts' -> Retry
r {$sel:attempts:Exponential :: Int
attempts = Int
attempts'}

{-# INLINE retry_check #-}
retry_check :: Lens' Retry (ServiceError -> Maybe Text)
retry_check :: Lens' Retry (ServiceError -> Maybe Text)
retry_check (ServiceError -> Maybe Text) -> f (ServiceError -> Maybe Text)
f r :: Retry
r@Exponential {ServiceError -> Maybe Text
check :: ServiceError -> Maybe Text
$sel:check:Exponential :: Retry -> ServiceError -> Maybe Text
check} = (ServiceError -> Maybe Text) -> f (ServiceError -> Maybe Text)
f ServiceError -> Maybe Text
check forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ServiceError -> Maybe Text
check' -> (Retry
r :: Retry) {$sel:check:Exponential :: ServiceError -> Maybe Text
check = ServiceError -> Maybe Text
check'}

-- | Signing algorithm specific metadata.
data Meta where
  Meta :: ToLog a => a -> Meta

instance ToLog Meta where
  build :: Meta -> ByteStringBuilder
build (Meta a
m) = forall a. ToLog a => a -> ByteStringBuilder
build a
m

-- | A signed 'ClientRequest' and associated metadata specific
-- to the signing algorithm, tagged with the initial request type
-- to be able to obtain the associated response, @'AWSResponse' a@.
data Signed a = Signed
  { forall a. Signed a -> Meta
signedMeta :: Meta,
    forall a. Signed a -> ClientRequest
signedRequest :: ClientRequest
  }

{-# INLINE signed_signedMeta #-}
signed_signedMeta :: Lens' (Signed a) Meta
signed_signedMeta :: forall a. Lens' (Signed a) Meta
signed_signedMeta Meta -> f Meta
f s :: Signed a
s@Signed {Meta
signedMeta :: Meta
$sel:signedMeta:Signed :: forall a. Signed a -> Meta
signedMeta} = Meta -> f Meta
f Meta
signedMeta forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Meta
signedMeta' -> Signed a
s {$sel:signedMeta:Signed :: Meta
signedMeta = Meta
signedMeta'}

{-# INLINE signed_signedRequest #-}
signed_signedRequest :: Lens' (Signed a) ClientRequest
signed_signedRequest :: forall a. Lens' (Signed a) ClientRequest
signed_signedRequest ClientRequest -> f ClientRequest
f s :: Signed a
s@Signed {ClientRequest
signedRequest :: ClientRequest
$sel:signedRequest:Signed :: forall a. Signed a -> ClientRequest
signedRequest} = ClientRequest -> f ClientRequest
f ClientRequest
signedRequest forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ClientRequest
signedRequest' -> Signed a
s {$sel:signedRequest:Signed :: ClientRequest
signedRequest = ClientRequest
signedRequest'}

type Algorithm a = Request a -> AuthEnv -> Region -> UTCTime -> Signed a

data Signer = Signer
  { Signer -> forall a. Algorithm a
sign :: forall a. Algorithm a,
    Signer -> forall a. Seconds -> Algorithm a
presign :: forall a. Seconds -> Algorithm a
  }

-- | Attributes and functions specific to an AWS service.
data Service = Service
  { Service -> Abbrev
abbrev :: Abbrev,
    Service -> Signer
signer :: Signer,
    Service -> ByteString
signingName :: ByteString,
    Service -> ByteString
version :: ByteString,
    -- | Only service bindings using the s3vhost request plugin
    -- (configured in the generator) will care about this field. It is
    -- ignored otherwise.
    Service -> S3AddressingStyle
s3AddressingStyle :: S3AddressingStyle,
    Service -> ByteString
endpointPrefix :: ByteString,
    Service -> Region -> Endpoint
endpoint :: Region -> Endpoint,
    Service -> Maybe Seconds
timeout :: Maybe Seconds,
    Service -> Status -> Bool
check :: Status -> Bool,
    Service -> Status -> [Header] -> ByteStringLazy -> Error
error :: Status -> [Header] -> ByteStringLazy -> Error,
    Service -> Retry
retry :: Retry
  }
  deriving stock (forall x. Rep Service x -> Service
forall x. Service -> Rep Service x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Service x -> Service
$cfrom :: forall x. Service -> Rep Service x
Generic)

{-# INLINE service_abbrev #-}
service_abbrev :: Lens' Service Abbrev
service_abbrev :: Lens' Service Abbrev
service_abbrev Abbrev -> f Abbrev
f s :: Service
s@Service {Abbrev
abbrev :: Abbrev
$sel:abbrev:Service :: Service -> Abbrev
abbrev} = Abbrev -> f Abbrev
f Abbrev
abbrev forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Abbrev
abbrev' -> (Service
s :: Service) {$sel:abbrev:Service :: Abbrev
abbrev = Abbrev
abbrev'}

{-# INLINE service_signer #-}
service_signer :: Lens' Service Signer
service_signer :: Lens' Service Signer
service_signer Signer -> f Signer
f s :: Service
s@Service {Signer
signer :: Signer
$sel:signer:Service :: Service -> Signer
signer} = Signer -> f Signer
f Signer
signer forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Signer
signer' -> (Service
s :: Service) {$sel:signer:Service :: Signer
signer = Signer
signer'}

{-# INLINE service_signingName #-}
service_signingName :: Lens' Service ByteString
service_signingName :: Lens' Service ByteString
service_signingName ByteString -> f ByteString
f s :: Service
s@Service {ByteString
signingName :: ByteString
$sel:signingName:Service :: Service -> ByteString
signingName} = ByteString -> f ByteString
f ByteString
signingName forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
signingName' -> Service
s {$sel:signingName:Service :: ByteString
signingName = ByteString
signingName'}

{-# INLINE service_version #-}
service_version :: Lens' Service ByteString
service_version :: Lens' Service ByteString
service_version ByteString -> f ByteString
f s :: Service
s@Service {ByteString
version :: ByteString
$sel:version:Service :: Service -> ByteString
version} = ByteString -> f ByteString
f ByteString
version forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
version' -> Service
s {$sel:version:Service :: ByteString
version = ByteString
version'}

{-# INLINE service_s3AddressingStyle #-}
service_s3AddressingStyle :: Lens' Service S3AddressingStyle
service_s3AddressingStyle :: Lens' Service S3AddressingStyle
service_s3AddressingStyle S3AddressingStyle -> f S3AddressingStyle
f s :: Service
s@Service {S3AddressingStyle
s3AddressingStyle :: S3AddressingStyle
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
s3AddressingStyle} = S3AddressingStyle -> f S3AddressingStyle
f S3AddressingStyle
s3AddressingStyle forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \S3AddressingStyle
s3AddressingStyle' -> Service
s {$sel:s3AddressingStyle:Service :: S3AddressingStyle
s3AddressingStyle = S3AddressingStyle
s3AddressingStyle'}

{-# INLINE service_endpointPrefix #-}
service_endpointPrefix :: Lens' Service ByteString
service_endpointPrefix :: Lens' Service ByteString
service_endpointPrefix ByteString -> f ByteString
f s :: Service
s@Service {ByteString
endpointPrefix :: ByteString
$sel:endpointPrefix:Service :: Service -> ByteString
endpointPrefix} = ByteString -> f ByteString
f ByteString
endpointPrefix forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
endpointPrefix' -> Service
s {$sel:endpointPrefix:Service :: ByteString
endpointPrefix = ByteString
endpointPrefix'}

{-# INLINE service_endpoint #-}
service_endpoint :: Lens' Service (Region -> Endpoint)
service_endpoint :: Lens' Service (Region -> Endpoint)
service_endpoint (Region -> Endpoint) -> f (Region -> Endpoint)
f s :: Service
s@Service {Region -> Endpoint
endpoint :: Region -> Endpoint
$sel:endpoint:Service :: Service -> Region -> Endpoint
endpoint} = (Region -> Endpoint) -> f (Region -> Endpoint)
f Region -> Endpoint
endpoint forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Region -> Endpoint
endpoint' -> Service
s {$sel:endpoint:Service :: Region -> Endpoint
endpoint = Region -> Endpoint
endpoint'}

{-# INLINE service_timeout #-}
service_timeout :: Lens' Service (Maybe Seconds)
service_timeout :: Lens' Service (Maybe Seconds)
service_timeout Maybe Seconds -> f (Maybe Seconds)
f s :: Service
s@Service {Maybe Seconds
timeout :: Maybe Seconds
$sel:timeout:Service :: Service -> Maybe Seconds
timeout} = Maybe Seconds -> f (Maybe Seconds)
f Maybe Seconds
timeout forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Seconds
timeout' -> Service
s {$sel:timeout:Service :: Maybe Seconds
timeout = Maybe Seconds
timeout'}

{-# INLINE service_check #-}
service_check :: Lens' Service (Status -> Bool)
service_check :: Lens' Service (Status -> Bool)
service_check (Status -> Bool) -> f (Status -> Bool)
f s :: Service
s@Service {Status -> Bool
check :: Status -> Bool
$sel:check:Service :: Service -> Status -> Bool
check} = (Status -> Bool) -> f (Status -> Bool)
f Status -> Bool
check forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Status -> Bool
check' -> (Service
s :: Service) {$sel:check:Service :: Status -> Bool
check = Status -> Bool
check'}

{-# INLINE service_error #-}
service_error :: Lens' Service (Status -> [Header] -> ByteStringLazy -> Error)
service_error :: Lens' Service (Status -> [Header] -> ByteStringLazy -> Error)
service_error (Status -> [Header] -> ByteStringLazy -> Error)
-> f (Status -> [Header] -> ByteStringLazy -> Error)
f s :: Service
s@Service {Status -> [Header] -> ByteStringLazy -> Error
error :: Status -> [Header] -> ByteStringLazy -> Error
$sel:error:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
error} = (Status -> [Header] -> ByteStringLazy -> Error)
-> f (Status -> [Header] -> ByteStringLazy -> Error)
f Status -> [Header] -> ByteStringLazy -> Error
error forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Status -> [Header] -> ByteStringLazy -> Error
error' -> (Service
s :: Service) {$sel:error:Service :: Status -> [Header] -> ByteStringLazy -> Error
error = Status -> [Header] -> ByteStringLazy -> Error
error'}

{-# INLINE service_retry #-}
service_retry :: Lens' Service Retry
service_retry :: Lens' Service Retry
service_retry Retry -> f Retry
f s :: Service
s@Service {Retry
retry :: Retry
$sel:retry:Service :: Service -> Retry
retry} = Retry -> f Retry
f Retry
retry forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Retry
retry' -> (Service
s :: Service) {$sel:retry:Service :: Retry
retry = Retry
retry'}

-- | When to rewrite S3 requests into /virtual-hosted style/.
--
-- Requests to S3 can be rewritten to access buckets by setting the
-- @Host:@ header, which allows you to point a @CNAME@ record at an
-- Amazon S3 Bucket.
--
-- Non-S3 object stores usually do not support this, which is usually
-- the only time you'll need to change this.
--
-- /See:/ [Virtual hosting of buckets](https://docs.aws.amazon.com/AmazonS3/latest/userguide/VirtualHosting.html)
-- in the Amazon S3 User Guide.
--
-- /See:/ [Changing the Addressing Style](https://boto3.amazonaws.com/v1/documentation/api/1.9.42/guide/s3.html#changing-the-addressing-style)
-- for the corresponding option in Boto 3.
data S3AddressingStyle
  = -- | Rewrite S3 request paths only if they can be expressed
    -- as a DNS label. This is the default.
    S3AddressingStyleAuto
  | -- | Do not ever rewrite S3 request paths.
    S3AddressingStylePath
  | -- | Force virtual hosted style rewrites without checking the
    -- bucket name.
    S3AddressingStyleVirtual
  deriving stock (S3AddressingStyle -> S3AddressingStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3AddressingStyle -> S3AddressingStyle -> Bool
$c/= :: S3AddressingStyle -> S3AddressingStyle -> Bool
== :: S3AddressingStyle -> S3AddressingStyle -> Bool
$c== :: S3AddressingStyle -> S3AddressingStyle -> Bool
Eq, Int -> S3AddressingStyle -> ShowS
[S3AddressingStyle] -> ShowS
S3AddressingStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3AddressingStyle] -> ShowS
$cshowList :: [S3AddressingStyle] -> ShowS
show :: S3AddressingStyle -> String
$cshow :: S3AddressingStyle -> String
showsPrec :: Int -> S3AddressingStyle -> ShowS
$cshowsPrec :: Int -> S3AddressingStyle -> ShowS
Show, forall x. Rep S3AddressingStyle x -> S3AddressingStyle
forall x. S3AddressingStyle -> Rep S3AddressingStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3AddressingStyle x -> S3AddressingStyle
$cfrom :: forall x. S3AddressingStyle -> Rep S3AddressingStyle x
Generic)

-- | An unsigned request.
data Request a = Request
  { forall a. Request a -> Service
service :: Service,
    forall a. Request a -> StdMethod
method :: StdMethod,
    forall a. Request a -> RawPath
path :: RawPath,
    forall a. Request a -> QueryString
query :: QueryString,
    forall a. Request a -> [Header]
headers :: [Header],
    forall a. Request a -> RequestBody
body :: RequestBody
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Request a) x -> Request a
forall a x. Request a -> Rep (Request a) x
$cto :: forall a x. Rep (Request a) x -> Request a
$cfrom :: forall a x. Request a -> Rep (Request a) x
Generic)

{-# INLINE request_service #-}
request_service :: Lens' (Request a) Service
request_service :: forall a. Lens' (Request a) Service
request_service Service -> f Service
f rq :: Request a
rq@Request {Service
service :: Service
$sel:service:Request :: forall a. Request a -> Service
service} = Service -> f Service
f Service
service forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Service
service' -> Request a
rq {$sel:service:Request :: Service
service = Service
service'}

{-# INLINE request_method #-}
request_method :: Lens' (Request a) StdMethod
request_method :: forall a. Lens' (Request a) StdMethod
request_method StdMethod -> f StdMethod
f rq :: Request a
rq@Request {StdMethod
method :: StdMethod
$sel:method:Request :: forall a. Request a -> StdMethod
method} = StdMethod -> f StdMethod
f StdMethod
method forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \StdMethod
method' -> Request a
rq {$sel:method:Request :: StdMethod
method = StdMethod
method'}

{-# INLINE request_path #-}
request_path :: Lens' (Request a) RawPath
request_path :: forall a. Lens' (Request a) RawPath
request_path RawPath -> f RawPath
f rq :: Request a
rq@Request {RawPath
path :: RawPath
$sel:path:Request :: forall a. Request a -> RawPath
path} = RawPath -> f RawPath
f RawPath
path forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \RawPath
path' -> Request a
rq {$sel:path:Request :: RawPath
path = RawPath
path'}

{-# INLINE request_query #-}
request_query :: Lens' (Request a) QueryString
request_query :: forall a. Lens' (Request a) QueryString
request_query QueryString -> f QueryString
f rq :: Request a
rq@Request {QueryString
query :: QueryString
$sel:query:Request :: forall a. Request a -> QueryString
query} = QueryString -> f QueryString
f QueryString
query forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \QueryString
query' -> Request a
rq {$sel:query:Request :: QueryString
query = QueryString
query'}

{-# INLINE request_headers #-}
request_headers :: forall a. Lens' (Request a) [Header]
request_headers :: forall a. Lens' (Request a) [Header]
request_headers [Header] -> f [Header]
f rq :: Request a
rq@Request {[Header]
headers :: [Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers} = [Header] -> f [Header]
f [Header]
headers forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Header]
headers' -> (Request a
rq :: Request a) {$sel:headers:Request :: [Header]
headers = [Header]
headers'}

{-# INLINE request_body #-}
request_body :: forall a. Lens' (Request a) RequestBody
request_body :: forall a. Lens' (Request a) RequestBody
request_body RequestBody -> f RequestBody
f rq :: Request a
rq@Request {RequestBody
body :: RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body} = RequestBody -> f RequestBody
f RequestBody
body forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \RequestBody
body' -> (Request a
rq :: Request a) {$sel:body:Request :: RequestBody
body = RequestBody
body'}

requestSign :: Algorithm a
requestSign :: forall a. Algorithm a
requestSign rq :: Request a
rq@Request {$sel:service:Request :: forall a. Request a -> Service
service = Service {$sel:signer:Service :: Service -> Signer
signer = Signer {forall a. Algorithm a
sign :: forall a. Algorithm a
$sel:sign:Signer :: Signer -> forall a. Algorithm a
sign}}} = forall a. Algorithm a
sign Request a
rq

requestPresign :: Seconds -> Algorithm a
requestPresign :: forall a. Seconds -> Algorithm a
requestPresign Seconds
ex rq :: Request a
rq@Request {$sel:service:Request :: forall a. Request a -> Service
service = Service {$sel:signer:Service :: Service -> Signer
signer = Signer {forall a. Seconds -> Algorithm a
presign :: forall a. Seconds -> Algorithm a
$sel:presign:Signer :: Signer -> forall a. Seconds -> Algorithm a
presign}}} =
  forall a. Seconds -> Algorithm a
presign Seconds
ex Request a
rq

-- | Create an unsigned 'ClientRequest'. You will almost never need to do this.
requestUnsigned :: Request a -> Region -> ClientRequest
requestUnsigned :: forall a. Request a -> Region -> ClientRequest
requestUnsigned Request {$sel:service:Request :: forall a. Request a -> Service
service = Service {Maybe Seconds
ByteString
S3AddressingStyle
Signer
Retry
Abbrev
Status -> Bool
Status -> [Header] -> ByteStringLazy -> Error
Region -> Endpoint
retry :: Retry
error :: Status -> [Header] -> ByteStringLazy -> Error
check :: Status -> Bool
timeout :: Maybe Seconds
endpoint :: Region -> Endpoint
endpointPrefix :: ByteString
s3AddressingStyle :: S3AddressingStyle
version :: ByteString
signingName :: ByteString
signer :: Signer
abbrev :: Abbrev
$sel:retry:Service :: Service -> Retry
$sel:error:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
$sel:check:Service :: Service -> Status -> Bool
$sel:timeout:Service :: Service -> Maybe Seconds
$sel:endpoint:Service :: Service -> Region -> Endpoint
$sel:endpointPrefix:Service :: Service -> ByteString
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
$sel:version:Service :: Service -> ByteString
$sel:signingName:Service :: Service -> ByteString
$sel:signer:Service :: Service -> Signer
$sel:abbrev:Service :: Service -> Abbrev
..}, [Header]
StdMethod
QueryString
RawPath
RequestBody
body :: RequestBody
headers :: [Header]
query :: QueryString
path :: RawPath
method :: StdMethod
$sel:body:Request :: forall a. Request a -> RequestBody
$sel:headers:Request :: forall a. Request a -> [Header]
$sel:query:Request :: forall a. Request a -> QueryString
$sel:path:Request :: forall a. Request a -> RawPath
$sel:method:Request :: forall a. Request a -> StdMethod
..} Region
r =
  (Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest Endpoint
end Maybe Seconds
timeout)
    { method :: ByteString
Client.method = forall a. ToByteString a => a -> ByteString
toBS StdMethod
method,
      path :: ByteString
Client.path = forall a. ToByteString a => a -> ByteString
toBS (forall (a :: Encoding). Path a -> EscapedPath
escapePath RawPath
path),
      queryString :: ByteString
Client.queryString = forall a. ToByteString a => a -> ByteString
toBS QueryString
query,
      requestHeaders :: [Header]
Client.requestHeaders = [Header]
headers,
      requestBody :: RequestBody
Client.requestBody = RequestBody -> RequestBody
toRequestBody RequestBody
body
    }
  where
    end :: Endpoint
end = Region -> Endpoint
endpoint Region
r

-- | Specify how a request can be de/serialised.
class AWSRequest a where
  -- | The successful, expected response associated with a request.
  type AWSResponse a :: Type

  request ::
    -- | Overrides applied to the default 'Service'.
    (Service -> Service) ->
    a ->
    Request a

  response ::
    MonadResource m =>
    -- | Raw response body hook.
    (ByteStringLazy -> IO ByteStringLazy) ->
    Service ->
    Proxy a ->
    ClientResponse ClientBody ->
    m (Either Error (ClientResponse (AWSResponse a)))

-- | An access key ID.
--
-- For example: @AKIAIOSFODNN7EXAMPLE@
--
-- /See:/ <http://docs.aws.amazon.com/general/latest/gr/aws-sec-cred-types.html Understanding and Getting Your Security Credentials>.
newtype AccessKey = AccessKey ByteString
  deriving stock (AccessKey -> AccessKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessKey -> AccessKey -> Bool
$c/= :: AccessKey -> AccessKey -> Bool
== :: AccessKey -> AccessKey -> Bool
$c== :: AccessKey -> AccessKey -> Bool
Eq, Int -> AccessKey -> ShowS
[AccessKey] -> ShowS
AccessKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessKey] -> ShowS
$cshowList :: [AccessKey] -> ShowS
show :: AccessKey -> String
$cshow :: AccessKey -> String
showsPrec :: Int -> AccessKey -> ShowS
$cshowsPrec :: Int -> AccessKey -> ShowS
Show, ReadPrec [AccessKey]
ReadPrec AccessKey
Int -> ReadS AccessKey
ReadS [AccessKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AccessKey]
$creadListPrec :: ReadPrec [AccessKey]
readPrec :: ReadPrec AccessKey
$creadPrec :: ReadPrec AccessKey
readList :: ReadS [AccessKey]
$creadList :: ReadS [AccessKey]
readsPrec :: Int -> ReadS AccessKey
$creadsPrec :: Int -> ReadS AccessKey
Read, forall x. Rep AccessKey x -> AccessKey
forall x. AccessKey -> Rep AccessKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccessKey x -> AccessKey
$cfrom :: forall x. AccessKey -> Rep AccessKey x
Generic)
  deriving newtype
    ( String -> AccessKey
forall a. (String -> a) -> IsString a
fromString :: String -> AccessKey
$cfromString :: String -> AccessKey
IsString,
      AccessKey -> Text
forall a. (a -> Text) -> ToText a
toText :: AccessKey -> Text
$ctoText :: AccessKey -> Text
ToText,
      Text -> Either String AccessKey
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String AccessKey
$cfromText :: Text -> Either String AccessKey
FromText,
      AccessKey -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: AccessKey -> ByteStringBuilder
$cbuild :: AccessKey -> ByteStringBuilder
ToLog,
      AccessKey -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: AccessKey -> ByteString
$ctoBS :: AccessKey -> ByteString
ToByteString,
      AccessKey -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: AccessKey -> QueryString
$ctoQuery :: AccessKey -> QueryString
ToQuery,
      [Node] -> Either String AccessKey
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String AccessKey
$cparseXML :: [Node] -> Either String AccessKey
FromXML,
      AccessKey -> XML
forall a. (a -> XML) -> ToXML a
toXML :: AccessKey -> XML
$ctoXML :: AccessKey -> XML
ToXML,
      Eq AccessKey
Int -> AccessKey -> Int
AccessKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AccessKey -> Int
$chash :: AccessKey -> Int
hashWithSalt :: Int -> AccessKey -> Int
$chashWithSalt :: Int -> AccessKey -> Int
Hashable,
      AccessKey -> ()
forall a. (a -> ()) -> NFData a
rnf :: AccessKey -> ()
$crnf :: AccessKey -> ()
NFData
    )

instance ToJSON AccessKey where
  toJSON :: AccessKey -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance FromJSON AccessKey where
  parseJSON :: Value -> Parser AccessKey
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"AccessKey"

_AccessKey :: Iso' AccessKey ByteString
_AccessKey :: Iso' AccessKey ByteString
_AccessKey = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Secret access key credential.
--
-- For example: @wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKE@
--
-- /See:/ <http://docs.aws.amazon.com/general/latest/gr/aws-sec-cred-types.html Understanding and Getting Your Security Credentials>.
newtype SecretKey = SecretKey ByteString
  deriving stock (SecretKey -> SecretKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c== :: SecretKey -> SecretKey -> Bool
Eq, forall x. Rep SecretKey x -> SecretKey
forall x. SecretKey -> Rep SecretKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecretKey x -> SecretKey
$cfrom :: forall x. SecretKey -> Rep SecretKey x
Generic)
  deriving newtype
    ( String -> SecretKey
forall a. (String -> a) -> IsString a
fromString :: String -> SecretKey
$cfromString :: String -> SecretKey
IsString,
      SecretKey -> Text
forall a. (a -> Text) -> ToText a
toText :: SecretKey -> Text
$ctoText :: SecretKey -> Text
ToText,
      Text -> Either String SecretKey
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String SecretKey
$cfromText :: Text -> Either String SecretKey
FromText,
      SecretKey -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: SecretKey -> ByteString
$ctoBS :: SecretKey -> ByteString
ToByteString,
      [Node] -> Either String SecretKey
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String SecretKey
$cparseXML :: [Node] -> Either String SecretKey
FromXML,
      SecretKey -> XML
forall a. (a -> XML) -> ToXML a
toXML :: SecretKey -> XML
$ctoXML :: SecretKey -> XML
ToXML,
      Eq SecretKey
Int -> SecretKey -> Int
SecretKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SecretKey -> Int
$chash :: SecretKey -> Int
hashWithSalt :: Int -> SecretKey -> Int
$chashWithSalt :: Int -> SecretKey -> Int
Hashable,
      SecretKey -> ()
forall a. (a -> ()) -> NFData a
rnf :: SecretKey -> ()
$crnf :: SecretKey -> ()
NFData
    )

instance ToJSON SecretKey where
  toJSON :: SecretKey -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance FromJSON SecretKey where
  parseJSON :: Value -> Parser SecretKey
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"SecretKey"

_SecretKey :: Iso' SecretKey ByteString
_SecretKey :: Iso' SecretKey ByteString
_SecretKey = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A session token used by STS to temporarily authorise access to
-- an AWS resource.
--
-- /See:/ <http://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp.html Temporary Security Credentials>.
newtype SessionToken = SessionToken ByteString
  deriving stock (SessionToken -> SessionToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionToken -> SessionToken -> Bool
$c/= :: SessionToken -> SessionToken -> Bool
== :: SessionToken -> SessionToken -> Bool
$c== :: SessionToken -> SessionToken -> Bool
Eq, forall x. Rep SessionToken x -> SessionToken
forall x. SessionToken -> Rep SessionToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SessionToken x -> SessionToken
$cfrom :: forall x. SessionToken -> Rep SessionToken x
Generic)
  deriving newtype
    ( String -> SessionToken
forall a. (String -> a) -> IsString a
fromString :: String -> SessionToken
$cfromString :: String -> SessionToken
IsString,
      SessionToken -> Text
forall a. (a -> Text) -> ToText a
toText :: SessionToken -> Text
$ctoText :: SessionToken -> Text
ToText,
      Text -> Either String SessionToken
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String SessionToken
$cfromText :: Text -> Either String SessionToken
FromText,
      SessionToken -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: SessionToken -> ByteString
$ctoBS :: SessionToken -> ByteString
ToByteString,
      [Node] -> Either String SessionToken
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String SessionToken
$cparseXML :: [Node] -> Either String SessionToken
FromXML,
      SessionToken -> XML
forall a. (a -> XML) -> ToXML a
toXML :: SessionToken -> XML
$ctoXML :: SessionToken -> XML
ToXML,
      Eq SessionToken
Int -> SessionToken -> Int
SessionToken -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SessionToken -> Int
$chash :: SessionToken -> Int
hashWithSalt :: Int -> SessionToken -> Int
$chashWithSalt :: Int -> SessionToken -> Int
Hashable,
      SessionToken -> ()
forall a. (a -> ()) -> NFData a
rnf :: SessionToken -> ()
$crnf :: SessionToken -> ()
NFData
    )

instance ToJSON SessionToken where
  toJSON :: SessionToken -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance FromJSON SessionToken where
  parseJSON :: Value -> Parser SessionToken
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"SessionToken"

_SessionToken :: Iso' SessionToken ByteString
_SessionToken :: Iso' SessionToken ByteString
_SessionToken = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The AuthN/AuthZ credential environment.
data AuthEnv = AuthEnv
  { AuthEnv -> AccessKey
accessKeyId :: AccessKey,
    AuthEnv -> Sensitive SecretKey
secretAccessKey :: Sensitive SecretKey,
    AuthEnv -> Maybe (Sensitive SessionToken)
sessionToken :: Maybe (Sensitive SessionToken),
    AuthEnv -> Maybe ISO8601
expiration :: Maybe ISO8601
  }
  deriving stock (AuthEnv -> AuthEnv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthEnv -> AuthEnv -> Bool
$c/= :: AuthEnv -> AuthEnv -> Bool
== :: AuthEnv -> AuthEnv -> Bool
$c== :: AuthEnv -> AuthEnv -> Bool
Eq, Int -> AuthEnv -> ShowS
[AuthEnv] -> ShowS
AuthEnv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthEnv] -> ShowS
$cshowList :: [AuthEnv] -> ShowS
show :: AuthEnv -> String
$cshow :: AuthEnv -> String
showsPrec :: Int -> AuthEnv -> ShowS
$cshowsPrec :: Int -> AuthEnv -> ShowS
Show, forall x. Rep AuthEnv x -> AuthEnv
forall x. AuthEnv -> Rep AuthEnv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthEnv x -> AuthEnv
$cfrom :: forall x. AuthEnv -> Rep AuthEnv x
Generic)
  deriving anyclass (AuthEnv -> ()
forall a. (a -> ()) -> NFData a
rnf :: AuthEnv -> ()
$crnf :: AuthEnv -> ()
NFData)

instance ToLog AuthEnv where
  build :: AuthEnv -> ByteStringBuilder
build AuthEnv {Maybe ISO8601
Maybe (Sensitive SessionToken)
Sensitive SecretKey
AccessKey
expiration :: Maybe ISO8601
sessionToken :: Maybe (Sensitive SessionToken)
secretAccessKey :: Sensitive SecretKey
accessKeyId :: AccessKey
$sel:expiration:AuthEnv :: AuthEnv -> Maybe ISO8601
$sel:sessionToken:AuthEnv :: AuthEnv -> Maybe (Sensitive SessionToken)
$sel:secretAccessKey:AuthEnv :: AuthEnv -> Sensitive SecretKey
$sel:accessKeyId:AuthEnv :: AuthEnv -> AccessKey
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[Amazonka Auth] {",
        ByteStringBuilder
"  access key id     = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build AccessKey
accessKeyId,
        ByteStringBuilder
"  secret access key = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Sensitive SecretKey
secretAccessKey,
        ByteStringBuilder
"  session token     = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build Maybe (Sensitive SessionToken)
sessionToken,
        ByteStringBuilder
"  expiration        = " forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view forall (a :: Format). Iso' (Time a) UTCTime
_Time) Maybe ISO8601
expiration),
        ByteStringBuilder
"}"
      ]

instance FromJSON AuthEnv where
  parseJSON :: Value -> Parser AuthEnv
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AuthEnv" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AccessKeyId"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"SecretAccessKey"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Token"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Expiration"

instance FromXML AuthEnv where
  parseXML :: [Node] -> Either String AuthEnv
parseXML [Node]
x =
    AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
"AccessKeyId"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
"SecretAccessKey"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
.@? Text
"SessionToken"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
.@? Text
"Expiration"

{-# INLINE authEnv_accessKeyId #-}
authEnv_accessKeyId :: Lens' AuthEnv AccessKey
authEnv_accessKeyId :: Lens' AuthEnv AccessKey
authEnv_accessKeyId AccessKey -> f AccessKey
f a :: AuthEnv
a@AuthEnv {AccessKey
accessKeyId :: AccessKey
$sel:accessKeyId:AuthEnv :: AuthEnv -> AccessKey
accessKeyId} = AccessKey -> f AccessKey
f AccessKey
accessKeyId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \AccessKey
accessKeyId' -> AuthEnv
a {$sel:accessKeyId:AuthEnv :: AccessKey
accessKeyId = AccessKey
accessKeyId'}

{-# INLINE authEnv_secretAccessKey #-}
authEnv_secretAccessKey :: Lens' AuthEnv (Sensitive SecretKey)
authEnv_secretAccessKey :: Lens' AuthEnv (Sensitive SecretKey)
authEnv_secretAccessKey Sensitive SecretKey -> f (Sensitive SecretKey)
f a :: AuthEnv
a@AuthEnv {Sensitive SecretKey
secretAccessKey :: Sensitive SecretKey
$sel:secretAccessKey:AuthEnv :: AuthEnv -> Sensitive SecretKey
secretAccessKey} = Sensitive SecretKey -> f (Sensitive SecretKey)
f Sensitive SecretKey
secretAccessKey forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Sensitive SecretKey
secretAccessKey' -> AuthEnv
a {$sel:secretAccessKey:AuthEnv :: Sensitive SecretKey
secretAccessKey = Sensitive SecretKey
secretAccessKey'}

{-# INLINE authEnv_sessionToken #-}
authEnv_sessionToken :: Lens' AuthEnv (Maybe (Sensitive SessionToken))
authEnv_sessionToken :: Lens' AuthEnv (Maybe (Sensitive SessionToken))
authEnv_sessionToken Maybe (Sensitive SessionToken)
-> f (Maybe (Sensitive SessionToken))
f a :: AuthEnv
a@AuthEnv {Maybe (Sensitive SessionToken)
sessionToken :: Maybe (Sensitive SessionToken)
$sel:sessionToken:AuthEnv :: AuthEnv -> Maybe (Sensitive SessionToken)
sessionToken} = Maybe (Sensitive SessionToken)
-> f (Maybe (Sensitive SessionToken))
f Maybe (Sensitive SessionToken)
sessionToken forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe (Sensitive SessionToken)
sessionToken' -> AuthEnv
a {$sel:sessionToken:AuthEnv :: Maybe (Sensitive SessionToken)
sessionToken = Maybe (Sensitive SessionToken)
sessionToken'}

{-# INLINE authEnv_expiration #-}
authEnv_expiration :: Lens' AuthEnv (Maybe ISO8601)
authEnv_expiration :: Lens' AuthEnv (Maybe ISO8601)
authEnv_expiration Maybe ISO8601 -> f (Maybe ISO8601)
f a :: AuthEnv
a@AuthEnv {Maybe ISO8601
expiration :: Maybe ISO8601
$sel:expiration:AuthEnv :: AuthEnv -> Maybe ISO8601
expiration} = Maybe ISO8601 -> f (Maybe ISO8601)
f Maybe ISO8601
expiration forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe ISO8601
expiration' -> AuthEnv
a {$sel:expiration:AuthEnv :: Maybe ISO8601
expiration = Maybe ISO8601
expiration'}

-- | An authorisation environment containing AWS credentials, and potentially
-- a reference which can be refreshed out-of-band as temporary credentials expire.
data Auth
  = Ref ThreadId (IORef AuthEnv)
  | Auth AuthEnv

instance ToLog Auth where
  build :: Auth -> ByteStringBuilder
build (Ref ThreadId
t IORef AuthEnv
_) = ByteStringBuilder
"[Amazonka Auth] { <thread:" forall a. Semigroup a => a -> a -> a
<> forall a. ToLog a => a -> ByteStringBuilder
build (forall a. Show a => a -> String
show ThreadId
t) forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"> }"
  build (Auth AuthEnv
e) = forall a. ToLog a => a -> ByteStringBuilder
build AuthEnv
e

withAuth :: MonadIO m => Auth -> (AuthEnv -> m a) -> m a
withAuth :: forall (m :: * -> *) a.
MonadIO m =>
Auth -> (AuthEnv -> m a) -> m a
withAuth (Ref ThreadId
_ IORef AuthEnv
r) AuthEnv -> m a
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> IO a
readIORef IORef AuthEnv
r) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AuthEnv -> m a
f
withAuth (Auth AuthEnv
e) AuthEnv -> m a
f = AuthEnv -> m a
f AuthEnv
e

-- | The available AWS regions.
newtype Region = Region' {Region -> Text
fromRegion :: Text}
  deriving stock (Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Region] -> ShowS
$cshowList :: [Region] -> ShowS
show :: Region -> String
$cshow :: Region -> String
showsPrec :: Int -> Region -> ShowS
$cshowsPrec :: Int -> Region -> ShowS
Show, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Region]
$creadListPrec :: ReadPrec [Region]
readPrec :: ReadPrec Region
$creadPrec :: ReadPrec Region
readList :: ReadS [Region]
$creadList :: ReadS [Region]
readsPrec :: Int -> ReadS Region
$creadsPrec :: Int -> ReadS Region
Read, Region -> Region -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c== :: Region -> Region -> Bool
Eq, Eq Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmax :: Region -> Region -> Region
>= :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c< :: Region -> Region -> Bool
compare :: Region -> Region -> Ordering
$ccompare :: Region -> Region -> Ordering
Ord, forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Region x -> Region
$cfrom :: forall x. Region -> Rep Region x
Generic)
  deriving newtype
    ( String -> Region
forall a. (String -> a) -> IsString a
fromString :: String -> Region
$cfromString :: String -> Region
IsString,
      Eq Region
Int -> Region -> Int
Region -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Region -> Int
$chash :: Region -> Int
hashWithSalt :: Int -> Region -> Int
$chashWithSalt :: Int -> Region -> Int
Hashable,
      Region -> ()
forall a. (a -> ()) -> NFData a
rnf :: Region -> ()
$crnf :: Region -> ()
NFData,
      Region -> Text
forall a. (a -> Text) -> ToText a
toText :: Region -> Text
$ctoText :: Region -> Text
ToText,
      Text -> Either String Region
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String Region
$cfromText :: Text -> Either String Region
FromText,
      Region -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: Region -> QueryString
$ctoQuery :: Region -> QueryString
ToQuery,
      Region -> XML
forall a. (a -> XML) -> ToXML a
toXML :: Region -> XML
$ctoXML :: Region -> XML
ToXML,
      [Node] -> Either String Region
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String Region
$cparseXML :: [Node] -> Either String Region
FromXML,
      [Region] -> Encoding
[Region] -> Value
Region -> Encoding
Region -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Region] -> Encoding
$ctoEncodingList :: [Region] -> Encoding
toJSONList :: [Region] -> Value
$ctoJSONList :: [Region] -> Value
toEncoding :: Region -> Encoding
$ctoEncoding :: Region -> Encoding
toJSON :: Region -> Value
$ctoJSON :: Region -> Value
ToJSON,
      Value -> Parser [Region]
Value -> Parser Region
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Region]
$cparseJSONList :: Value -> Parser [Region]
parseJSON :: Value -> Parser Region
$cparseJSON :: Value -> Parser Region
FromJSON,
      Region -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: Region -> ByteString
$ctoBS :: Region -> ByteString
ToByteString,
      Region -> ByteStringBuilder
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: Region -> ByteStringBuilder
$cbuild :: Region -> ByteStringBuilder
ToLog
    )

{-# INLINE _Region #-}
_Region :: Iso' Region Text
_Region :: Iso' Region Text
_Region = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- Patterns for Regions - keep in sync with
-- https://docs.aws.amazon.com/general/latest/gr/rande.html#regional-endpoints

-- United States

pattern Ohio :: Region
pattern $bOhio :: Region
$mOhio :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Ohio = Region' "us-east-2"

pattern NorthVirginia :: Region
pattern $bNorthVirginia :: Region
$mNorthVirginia :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
NorthVirginia = Region' "us-east-1"

pattern NorthCalifornia :: Region
pattern $bNorthCalifornia :: Region
$mNorthCalifornia :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
NorthCalifornia = Region' "us-west-1"

pattern Oregon :: Region
pattern $bOregon :: Region
$mOregon :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Oregon = Region' "us-west-2"

-- Africa

pattern CapeTown :: Region
pattern $bCapeTown :: Region
$mCapeTown :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
CapeTown = Region' "af-south-1"

-- Asia Pacific

pattern HongKong :: Region
pattern $bHongKong :: Region
$mHongKong :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
HongKong = Region' "ap-east-1"

pattern Hyderabad :: Region
pattern $bHyderabad :: Region
$mHyderabad :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Hyderabad = Region' "ap-south-2"

pattern Jakarta :: Region
pattern $bJakarta :: Region
$mJakarta :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Jakarta = Region' "ap-southeast-3"

pattern Melbourne :: Region
pattern $bMelbourne :: Region
$mMelbourne :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Melbourne = Region' "ap-southeast-4"

pattern Mumbai :: Region
pattern $bMumbai :: Region
$mMumbai :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Mumbai = Region' "ap-south-1"

pattern Osaka :: Region
pattern $bOsaka :: Region
$mOsaka :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Osaka = Region' "ap-northeast-3"

pattern Seoul :: Region
pattern $bSeoul :: Region
$mSeoul :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Seoul = Region' "ap-northeast-2"

pattern Singapore :: Region
pattern $bSingapore :: Region
$mSingapore :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Singapore = Region' "ap-southeast-1"

pattern Sydney :: Region
pattern $bSydney :: Region
$mSydney :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Sydney = Region' "ap-southeast-2"

pattern Tokyo :: Region
pattern $bTokyo :: Region
$mTokyo :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Tokyo = Region' "ap-northeast-1"

-- Canada

pattern Montreal :: Region
pattern $bMontreal :: Region
$mMontreal :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Montreal = Region' "ca-central-1"

-- Europe

pattern Frankfurt :: Region
pattern $bFrankfurt :: Region
$mFrankfurt :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Frankfurt = Region' "eu-central-1"

pattern Ireland :: Region
pattern $bIreland :: Region
$mIreland :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Ireland = Region' "eu-west-1"

pattern London :: Region
pattern $bLondon :: Region
$mLondon :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
London = Region' "eu-west-2"

pattern Milan :: Region
pattern $bMilan :: Region
$mMilan :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Milan = Region' "eu-south-1"

pattern Paris :: Region
pattern $bParis :: Region
$mParis :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Paris = Region' "eu-west-3"

pattern Spain :: Region
pattern $bSpain :: Region
$mSpain :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Spain = Region' "eu-south-2"

pattern Stockholm :: Region
pattern $bStockholm :: Region
$mStockholm :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Stockholm = Region' "eu-north-1"

pattern Zurich :: Region
pattern $bZurich :: Region
$mZurich :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Zurich = Region' "eu-central-2"

-- Middle East

pattern Bahrain :: Region
pattern $bBahrain :: Region
$mBahrain :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Bahrain = Region' "me-south-1"

pattern UAE :: Region
pattern $bUAE :: Region
$mUAE :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
UAE = Region' "me-central-1"

-- South America

pattern SaoPaulo :: Region
pattern $bSaoPaulo :: Region
$mSaoPaulo :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
SaoPaulo = Region' "sa-east-1"

-- GovCloud

pattern GovCloudEast :: Region
pattern $bGovCloudEast :: Region
$mGovCloudEast :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
GovCloudEast = Region' "us-gov-east-1"

pattern GovCloudWest :: Region
pattern $bGovCloudWest :: Region
$mGovCloudWest :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
GovCloudWest = Region' "us-gov-west-1"

-- China

pattern Beijing :: Region
pattern $bBeijing :: Region
$mBeijing :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Beijing = Region' "cn-north-1"

pattern Ningxia :: Region
pattern $bNingxia :: Region
$mNingxia :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
Ningxia = Region' "cn-northwest-1"

{-# COMPLETE
  Ohio,
  NorthVirginia,
  NorthCalifornia,
  Oregon,
  CapeTown,
  HongKong,
  Hyderabad,
  Jakarta,
  Melbourne,
  Mumbai,
  Osaka,
  Seoul,
  Singapore,
  Sydney,
  Tokyo,
  Montreal,
  Frankfurt,
  Ireland,
  London,
  Milan,
  Paris,
  Spain,
  Stockholm,
  Zurich,
  Bahrain,
  UAE,
  SaoPaulo,
  GovCloudEast,
  GovCloudWest,
  Beijing,
  Ningxia,
  Region'
  #-}

-- | A numeric value representing seconds.
newtype Seconds = Seconds DiffTime
  deriving stock (Seconds -> Seconds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq, Eq Seconds
Seconds -> Seconds -> Bool
Seconds -> Seconds -> Ordering
Seconds -> Seconds -> Seconds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmax :: Seconds -> Seconds -> Seconds
>= :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c< :: Seconds -> Seconds -> Bool
compare :: Seconds -> Seconds -> Ordering
$ccompare :: Seconds -> Seconds -> Ordering
Ord, ReadPrec [Seconds]
ReadPrec Seconds
Int -> ReadS Seconds
ReadS [Seconds]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Seconds]
$creadListPrec :: ReadPrec [Seconds]
readPrec :: ReadPrec Seconds
$creadPrec :: ReadPrec Seconds
readList :: ReadS [Seconds]
$creadList :: ReadS [Seconds]
readsPrec :: Int -> ReadS Seconds
$creadsPrec :: Int -> ReadS Seconds
Read, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show, forall x. Rep Seconds x -> Seconds
forall x. Seconds -> Rep Seconds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Seconds x -> Seconds
$cfrom :: forall x. Seconds -> Rep Seconds x
Generic)
  deriving newtype (Int -> Seconds
Seconds -> Int
Seconds -> [Seconds]
Seconds -> Seconds
Seconds -> Seconds -> [Seconds]
Seconds -> Seconds -> Seconds -> [Seconds]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Seconds -> Seconds -> Seconds -> [Seconds]
$cenumFromThenTo :: Seconds -> Seconds -> Seconds -> [Seconds]
enumFromTo :: Seconds -> Seconds -> [Seconds]
$cenumFromTo :: Seconds -> Seconds -> [Seconds]
enumFromThen :: Seconds -> Seconds -> [Seconds]
$cenumFromThen :: Seconds -> Seconds -> [Seconds]
enumFrom :: Seconds -> [Seconds]
$cenumFrom :: Seconds -> [Seconds]
fromEnum :: Seconds -> Int
$cfromEnum :: Seconds -> Int
toEnum :: Int -> Seconds
$ctoEnum :: Int -> Seconds
pred :: Seconds -> Seconds
$cpred :: Seconds -> Seconds
succ :: Seconds -> Seconds
$csucc :: Seconds -> Seconds
Enum, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num, Num Seconds
Ord Seconds
Seconds -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Seconds -> Rational
$ctoRational :: Seconds -> Rational
Real, Seconds -> ()
forall a. (a -> ()) -> NFData a
rnf :: Seconds -> ()
$crnf :: Seconds -> ()
NFData)

instance Hashable Seconds where
  hashWithSalt :: Int -> Seconds -> Int
hashWithSalt Int
salt = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> DiffTime
toSeconds

instance FromText Seconds where
  fromText :: Text -> Either String Seconds
fromText Text
t =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
err) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Seconds
Seconds) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
diffTimeFormatString String
str
    where
      str :: String
str = Text -> String
Text.unpack Text
t
      err :: String
err =
        String
"Seconds value failed to parse as expected format ("
          forall a. Semigroup a => a -> a -> a
<> String
diffTimeFormatString
          forall a. Semigroup a => a -> a -> a
<> String
"): "
          forall a. Semigroup a => a -> a -> a
<> String
str

instance ToText Seconds where
  toText :: Seconds -> Text
toText =
    String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
diffTimeFormatString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> DiffTime
toSeconds

_Seconds :: Iso' Seconds DiffTime
_Seconds :: Iso' Seconds DiffTime
_Seconds = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Format string used in parse/format options
--
-- Currently @%Es@, which is "total seconds, with decimal point and up to
-- <width> (default 12) decimal places, without trailing zeros. For a whole
-- number of seconds, %Es omits the decimal point unless padding is specified."
--
-- We also use 'defaultTimeLocale', which means @0.1@ and not @0,1@.
diffTimeFormatString :: String
diffTimeFormatString :: String
diffTimeFormatString = String
"%Es"

instance ToByteString Seconds

instance ToQuery Seconds

instance ToLog Seconds where
  build :: Seconds -> ByteStringBuilder
build Seconds
s = forall a. ToLog a => a -> ByteStringBuilder
build (forall a. ToText a => a -> Text
toText Seconds
s) forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"s"

toSeconds :: Seconds -> DiffTime
toSeconds :: Seconds -> DiffTime
toSeconds (Seconds DiffTime
n)
  | DiffTime
n forall a. Ord a => a -> a -> Bool
< DiffTime
0 = DiffTime
0
  | Bool
otherwise = DiffTime
n

toMicroseconds :: Seconds -> Int
toMicroseconds :: Seconds -> Int
toMicroseconds = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime
1000000 forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> DiffTime
toSeconds