-- |
-- 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
host :: ByteString
$sel:host:Endpoint :: Endpoint -> ByteString
host, Bool
secure :: Bool
$sel:secure:Endpoint :: Endpoint -> Bool
secure, Int
port :: Int
$sel:port:Endpoint :: Endpoint -> 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
(Abbrev -> Abbrev -> Bool)
-> (Abbrev -> Abbrev -> Bool) -> Eq Abbrev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Abbrev -> Abbrev -> Bool
== :: Abbrev -> Abbrev -> Bool
$c/= :: Abbrev -> Abbrev -> Bool
/= :: Abbrev -> Abbrev -> Bool
Eq, Eq Abbrev
Eq Abbrev
-> (Abbrev -> Abbrev -> Ordering)
-> (Abbrev -> Abbrev -> Bool)
-> (Abbrev -> Abbrev -> Bool)
-> (Abbrev -> Abbrev -> Bool)
-> (Abbrev -> Abbrev -> Bool)
-> (Abbrev -> Abbrev -> Abbrev)
-> (Abbrev -> Abbrev -> Abbrev)
-> Ord 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
$ccompare :: Abbrev -> Abbrev -> Ordering
compare :: Abbrev -> Abbrev -> Ordering
$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
>= :: Abbrev -> Abbrev -> Bool
$cmax :: Abbrev -> Abbrev -> Abbrev
max :: Abbrev -> Abbrev -> Abbrev
$cmin :: Abbrev -> Abbrev -> Abbrev
min :: Abbrev -> Abbrev -> Abbrev
Ord, Int -> Abbrev -> ShowS
[Abbrev] -> ShowS
Abbrev -> String
(Int -> Abbrev -> ShowS)
-> (Abbrev -> String) -> ([Abbrev] -> ShowS) -> Show Abbrev
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Abbrev -> ShowS
showsPrec :: Int -> Abbrev -> ShowS
$cshow :: Abbrev -> String
show :: Abbrev -> String
$cshowList :: [Abbrev] -> ShowS
showList :: [Abbrev] -> ShowS
Show, (forall x. Abbrev -> Rep Abbrev x)
-> (forall x. Rep Abbrev x -> Abbrev) -> Generic Abbrev
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
$cfrom :: forall x. Abbrev -> Rep Abbrev x
from :: forall x. Abbrev -> Rep Abbrev x
$cto :: forall x. Rep Abbrev x -> Abbrev
to :: forall x. Rep Abbrev x -> Abbrev
Generic)
  deriving newtype (String -> Abbrev
(String -> Abbrev) -> IsString Abbrev
forall a. (String -> a) -> IsString a
$cfromString :: String -> Abbrev
fromString :: String -> Abbrev
IsString, [Node] -> Either String Abbrev
([Node] -> Either String Abbrev) -> FromXML Abbrev
forall a. ([Node] -> Either String a) -> FromXML a
$cparseXML :: [Node] -> Either String Abbrev
parseXML :: [Node] -> Either String Abbrev
FromXML, Value -> Parser [Abbrev]
Value -> Parser Abbrev
(Value -> Parser Abbrev)
-> (Value -> Parser [Abbrev]) -> FromJSON Abbrev
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Abbrev
parseJSON :: Value -> Parser Abbrev
$cparseJSONList :: Value -> Parser [Abbrev]
parseJSONList :: Value -> Parser [Abbrev]
FromJSON, Text -> Either String Abbrev
(Text -> Either String Abbrev) -> FromText Abbrev
forall a. (Text -> Either String a) -> FromText a
$cfromText :: Text -> Either String Abbrev
fromText :: Text -> Either String Abbrev
FromText, Abbrev -> Text
(Abbrev -> Text) -> ToText Abbrev
forall a. (a -> Text) -> ToText a
$ctoText :: Abbrev -> Text
toText :: Abbrev -> Text
ToText, Abbrev -> ByteStringBuilder
(Abbrev -> ByteStringBuilder) -> ToLog Abbrev
forall a. (a -> ByteStringBuilder) -> ToLog a
$cbuild :: Abbrev -> ByteStringBuilder
build :: Abbrev -> ByteStringBuilder
ToLog)

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

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

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

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

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

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

instance FromText ErrorCode where
  fromText :: Text -> Either String ErrorCode
fromText = ErrorCode -> Either String ErrorCode
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorCode -> Either String ErrorCode)
-> (Text -> ErrorCode) -> Text -> Either String ErrorCode
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 (Text -> ErrorCode) -> (Text -> Text) -> Text -> ErrorCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> Text) -> (Text -> Text) -> Text -> Text
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 =
      Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
x (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Maybe Text
Text.stripSuffix Text
"Exception" Text
x Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
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 (Char -> Char -> Bool
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
(ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> Bool) -> Eq ErrorMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrorMessage -> ErrorMessage -> Bool
== :: ErrorMessage -> ErrorMessage -> Bool
$c/= :: ErrorMessage -> ErrorMessage -> Bool
/= :: ErrorMessage -> ErrorMessage -> Bool
Eq, Eq ErrorMessage
Eq ErrorMessage
-> (ErrorMessage -> ErrorMessage -> Ordering)
-> (ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> ErrorMessage)
-> (ErrorMessage -> ErrorMessage -> ErrorMessage)
-> Ord 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
$ccompare :: ErrorMessage -> ErrorMessage -> Ordering
compare :: ErrorMessage -> ErrorMessage -> Ordering
$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
>= :: ErrorMessage -> ErrorMessage -> Bool
$cmax :: ErrorMessage -> ErrorMessage -> ErrorMessage
max :: ErrorMessage -> ErrorMessage -> ErrorMessage
$cmin :: ErrorMessage -> ErrorMessage -> ErrorMessage
min :: ErrorMessage -> ErrorMessage -> ErrorMessage
Ord, Int -> ErrorMessage -> ShowS
[ErrorMessage] -> ShowS
ErrorMessage -> String
(Int -> ErrorMessage -> ShowS)
-> (ErrorMessage -> String)
-> ([ErrorMessage] -> ShowS)
-> Show ErrorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrorMessage -> ShowS
showsPrec :: Int -> ErrorMessage -> ShowS
$cshow :: ErrorMessage -> String
show :: ErrorMessage -> String
$cshowList :: [ErrorMessage] -> ShowS
showList :: [ErrorMessage] -> ShowS
Show, (forall x. ErrorMessage -> Rep ErrorMessage x)
-> (forall x. Rep ErrorMessage x -> ErrorMessage)
-> Generic ErrorMessage
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
$cfrom :: forall x. ErrorMessage -> Rep ErrorMessage x
from :: forall x. ErrorMessage -> Rep ErrorMessage x
$cto :: forall x. Rep ErrorMessage x -> ErrorMessage
to :: forall x. Rep ErrorMessage x -> ErrorMessage
Generic)
  deriving newtype (String -> ErrorMessage
(String -> ErrorMessage) -> IsString ErrorMessage
forall a. (String -> a) -> IsString a
$cfromString :: String -> ErrorMessage
fromString :: String -> ErrorMessage
IsString, [Node] -> Either String ErrorMessage
([Node] -> Either String ErrorMessage) -> FromXML ErrorMessage
forall a. ([Node] -> Either String a) -> FromXML a
$cparseXML :: [Node] -> Either String ErrorMessage
parseXML :: [Node] -> Either String ErrorMessage
FromXML, Value -> Parser [ErrorMessage]
Value -> Parser ErrorMessage
(Value -> Parser ErrorMessage)
-> (Value -> Parser [ErrorMessage]) -> FromJSON ErrorMessage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ErrorMessage
parseJSON :: Value -> Parser ErrorMessage
$cparseJSONList :: Value -> Parser [ErrorMessage]
parseJSONList :: Value -> Parser [ErrorMessage]
FromJSON, Text -> Either String ErrorMessage
(Text -> Either String ErrorMessage) -> FromText ErrorMessage
forall a. (Text -> Either String a) -> FromText a
$cfromText :: Text -> Either String ErrorMessage
fromText :: Text -> Either String ErrorMessage
FromText, ErrorMessage -> Text
(ErrorMessage -> Text) -> ToText ErrorMessage
forall a. (a -> Text) -> ToText a
$ctoText :: ErrorMessage -> Text
toText :: ErrorMessage -> Text
ToText, ErrorMessage -> ByteStringBuilder
(ErrorMessage -> ByteStringBuilder) -> ToLog ErrorMessage
forall a. (a -> ByteStringBuilder) -> ToLog a
$cbuild :: ErrorMessage -> ByteStringBuilder
build :: ErrorMessage -> ByteStringBuilder
ToLog)

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

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

{-# INLINE _RequestId #-}
_RequestId :: Iso' RequestId Text
_RequestId :: Iso' RequestId Text
_RequestId = p Text (f Text) -> p RequestId (f RequestId)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' RequestId Text
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
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show, (forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
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
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic)

instance Exception Error

instance ToLog Error where
  build :: Error -> ByteStringBuilder
build = \case
    TransportError HttpException
e -> HttpException -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build HttpException
e
    SerializeError SerializeError
e -> SerializeError -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build SerializeError
e
    ServiceError ServiceError
e -> ServiceError -> ByteStringBuilder
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
(SerializeError -> SerializeError -> Bool)
-> (SerializeError -> SerializeError -> Bool) -> Eq SerializeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SerializeError -> SerializeError -> Bool
== :: SerializeError -> SerializeError -> Bool
$c/= :: SerializeError -> SerializeError -> Bool
/= :: SerializeError -> SerializeError -> Bool
Eq, Int -> SerializeError -> ShowS
[SerializeError] -> ShowS
SerializeError -> String
(Int -> SerializeError -> ShowS)
-> (SerializeError -> String)
-> ([SerializeError] -> ShowS)
-> Show SerializeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SerializeError -> ShowS
showsPrec :: Int -> SerializeError -> ShowS
$cshow :: SerializeError -> String
show :: SerializeError -> String
$cshowList :: [SerializeError] -> ShowS
showList :: [SerializeError] -> ShowS
Show, (forall x. SerializeError -> Rep SerializeError x)
-> (forall x. Rep SerializeError x -> SerializeError)
-> Generic SerializeError
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
$cfrom :: forall x. SerializeError -> Rep SerializeError x
from :: forall x. SerializeError -> Rep SerializeError x
$cto :: forall x. Rep SerializeError x -> SerializeError
to :: forall x. Rep SerializeError x -> SerializeError
Generic)

instance ToLog SerializeError where
  build :: SerializeError -> ByteStringBuilder
build SerializeError' {String
Maybe ByteStringLazy
Status
Abbrev
$sel:abbrev:SerializeError' :: SerializeError -> Abbrev
$sel:status:SerializeError' :: SerializeError -> Status
$sel:body:SerializeError' :: SerializeError -> Maybe ByteStringLazy
$sel:message:SerializeError' :: SerializeError -> String
abbrev :: Abbrev
status :: Status
body :: Maybe ByteStringLazy
message :: String
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[SerializeError] {",
        ByteStringBuilder
"  service = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Abbrev -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Abbrev
abbrev,
        ByteStringBuilder
"  status  = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Status -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Status
status,
        ByteStringBuilder
"  message = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> String -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build String
message,
        ByteStringBuilder
"  body    = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe ByteStringLazy -> ByteStringBuilder
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
$sel:abbrev:SerializeError' :: SerializeError -> Abbrev
abbrev :: Abbrev
abbrev} = Abbrev -> f Abbrev
f Abbrev
abbrev f Abbrev -> (Abbrev -> SerializeError) -> f SerializeError
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
$sel:status:SerializeError' :: SerializeError -> Status
status :: Status
status} = Status -> f Status
f Status
status f Status -> (Status -> SerializeError) -> f SerializeError
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
$sel:body:SerializeError' :: SerializeError -> Maybe ByteStringLazy
body :: Maybe ByteStringLazy
body} = Maybe ByteStringLazy -> f (Maybe ByteStringLazy)
f Maybe ByteStringLazy
body f (Maybe ByteStringLazy)
-> (Maybe ByteStringLazy -> SerializeError) -> f SerializeError
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
$sel:message:SerializeError' :: SerializeError -> String
message :: String
message} = String -> f String
f String
message f String -> (String -> SerializeError) -> f SerializeError
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
(ServiceError -> ServiceError -> Bool)
-> (ServiceError -> ServiceError -> Bool) -> Eq ServiceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServiceError -> ServiceError -> Bool
== :: ServiceError -> ServiceError -> Bool
$c/= :: ServiceError -> ServiceError -> Bool
/= :: ServiceError -> ServiceError -> Bool
Eq, Int -> ServiceError -> ShowS
[ServiceError] -> ShowS
ServiceError -> String
(Int -> ServiceError -> ShowS)
-> (ServiceError -> String)
-> ([ServiceError] -> ShowS)
-> Show ServiceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServiceError -> ShowS
showsPrec :: Int -> ServiceError -> ShowS
$cshow :: ServiceError -> String
show :: ServiceError -> String
$cshowList :: [ServiceError] -> ShowS
showList :: [ServiceError] -> ShowS
Show, (forall x. ServiceError -> Rep ServiceError x)
-> (forall x. Rep ServiceError x -> ServiceError)
-> Generic ServiceError
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
$cfrom :: forall x. ServiceError -> Rep ServiceError x
from :: forall x. ServiceError -> Rep ServiceError x
$cto :: forall x. Rep ServiceError x -> ServiceError
to :: forall x. Rep ServiceError x -> ServiceError
Generic)

instance ToLog ServiceError where
  build :: ServiceError -> ByteStringBuilder
build ServiceError' {[Header]
Maybe RequestId
Maybe ErrorMessage
Status
ErrorCode
Abbrev
$sel:abbrev:ServiceError' :: ServiceError -> Abbrev
$sel:status:ServiceError' :: ServiceError -> Status
$sel:headers:ServiceError' :: ServiceError -> [Header]
$sel:code:ServiceError' :: ServiceError -> ErrorCode
$sel:message:ServiceError' :: ServiceError -> Maybe ErrorMessage
$sel:requestId:ServiceError' :: ServiceError -> Maybe RequestId
abbrev :: Abbrev
status :: Status
headers :: [Header]
code :: ErrorCode
message :: Maybe ErrorMessage
requestId :: Maybe RequestId
..} =
    [ByteStringBuilder] -> ByteStringBuilder
buildLines
      [ ByteStringBuilder
"[ServiceError] {",
        ByteStringBuilder
"  service    = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Abbrev -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Abbrev
abbrev,
        ByteStringBuilder
"  status     = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Status -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Status
status,
        ByteStringBuilder
"  code       = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ErrorCode -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build ErrorCode
code,
        ByteStringBuilder
"  message    = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe ErrorMessage -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Maybe ErrorMessage
message,
        ByteStringBuilder
"  request-id = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe RequestId -> ByteStringBuilder
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
$sel:abbrev:ServiceError' :: ServiceError -> Abbrev
abbrev :: Abbrev
abbrev} = Abbrev -> f Abbrev
f Abbrev
abbrev f Abbrev -> (Abbrev -> ServiceError) -> f ServiceError
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
$sel:status:ServiceError' :: ServiceError -> Status
status :: Status
status} = Status -> f Status
f Status
status f Status -> (Status -> ServiceError) -> f ServiceError
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]
$sel:headers:ServiceError' :: ServiceError -> [Header]
headers :: [Header]
headers} = [Header] -> f [Header]
f [Header]
headers f [Header] -> ([Header] -> ServiceError) -> f ServiceError
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
$sel:code:ServiceError' :: ServiceError -> ErrorCode
code :: ErrorCode
code} = ErrorCode -> f ErrorCode
f ErrorCode
code f ErrorCode -> (ErrorCode -> ServiceError) -> f ServiceError
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
$sel:message:ServiceError' :: ServiceError -> Maybe ErrorMessage
message :: Maybe ErrorMessage
message} = Maybe ErrorMessage -> f (Maybe ErrorMessage)
f Maybe ErrorMessage
message f (Maybe ErrorMessage)
-> (Maybe ErrorMessage -> ServiceError) -> f ServiceError
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
$sel:requestId:ServiceError' :: ServiceError -> Maybe RequestId
requestId :: Maybe RequestId
requestId} = Maybe RequestId -> f (Maybe RequestId)
f Maybe RequestId
requestId f (Maybe RequestId)
-> (Maybe RequestId -> ServiceError) -> f ServiceError
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 = p Error (f Error) -> p a (f a)
forall a. AsError a => Prism' a Error
Prism' a Error
_Error (p Error (f Error) -> p a (f a))
-> (p HttpException (f HttpException) -> p Error (f Error))
-> p HttpException (f HttpException)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p HttpException (f HttpException) -> p Error (f Error)
forall a. AsError a => Prism' a HttpException
Prism' Error HttpException
_TransportError
  _SerializeError = p Error (f Error) -> p a (f a)
forall a. AsError a => Prism' a Error
Prism' a Error
_Error (p Error (f Error) -> p a (f a))
-> (p SerializeError (f SerializeError) -> p Error (f Error))
-> p SerializeError (f SerializeError)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p SerializeError (f SerializeError) -> p Error (f Error)
forall a. AsError a => Prism' a SerializeError
Prism' Error SerializeError
_SerializeError
  _ServiceError = p Error (f Error) -> p a (f a)
forall a. AsError a => Prism' a Error
Prism' a Error
_Error (p Error (f Error) -> p a (f a))
-> (p ServiceError (f ServiceError) -> p Error (f Error))
-> p ServiceError (f ServiceError)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ServiceError (f ServiceError) -> p Error (f Error)
forall a. AsError a => Prism' a ServiceError
Prism' Error ServiceError
_ServiceError

instance AsError SomeException where
  _Error :: Prism' SomeException Error
_Error = p Error (f Error) -> p SomeException (f SomeException)
forall a. Exception a => Prism' SomeException a
Prism' SomeException Error
Lens.exception

instance AsError Error where
  _Error :: Prism' Error Error
_Error = p Error (f Error) -> p Error (f Error)
forall a. a -> a
id

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

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

  _ServiceError :: Prism' Error ServiceError
_ServiceError = (ServiceError -> Error)
-> (Error -> Either Error ServiceError)
-> Prism' Error ServiceError
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
Lens.prism ServiceError -> Error
ServiceError ((Error -> Either Error ServiceError) -> Prism' Error ServiceError)
-> (Error -> Either Error ServiceError)
-> Prism' Error ServiceError
forall a b. (a -> b) -> a -> b
$ \case
    ServiceError ServiceError
e -> ServiceError -> Either Error ServiceError
forall a b. b -> Either a b
Right ServiceError
e
    Error
x -> Error -> Either Error ServiceError
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
(Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool) -> Eq Endpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
/= :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Endpoint -> ShowS
showsPrec :: Int -> Endpoint -> ShowS
$cshow :: Endpoint -> String
show :: Endpoint -> String
$cshowList :: [Endpoint] -> ShowS
showList :: [Endpoint] -> ShowS
Show, (forall x. Endpoint -> Rep Endpoint x)
-> (forall x. Rep Endpoint x -> Endpoint) -> Generic Endpoint
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
$cfrom :: forall x. Endpoint -> Rep Endpoint x
from :: forall x. Endpoint -> Rep Endpoint x
$cto :: forall x. Rep Endpoint x -> Endpoint
to :: forall x. Rep Endpoint x -> Endpoint
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
$sel:host:Endpoint :: Endpoint -> ByteString
host :: ByteString
host} = ByteString -> f ByteString
f ByteString
host f ByteString -> (ByteString -> Endpoint) -> f Endpoint
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
$sel:basePath:Endpoint :: Endpoint -> RawPath
basePath :: RawPath
basePath} = RawPath -> f RawPath
f RawPath
basePath f RawPath -> (RawPath -> Endpoint) -> f Endpoint
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
$sel:secure:Endpoint :: Endpoint -> Bool
secure :: Bool
secure} = Bool -> f Bool
f Bool
secure f Bool -> (Bool -> Endpoint) -> f Endpoint
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
$sel:port:Endpoint :: Endpoint -> Int
port :: Int
port} = Int -> f Int
f Int
port f Int -> (Int -> Endpoint) -> f Endpoint
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
$sel:scope:Endpoint :: Endpoint -> ByteString
scope :: ByteString
scope} = ByteString -> f ByteString
f ByteString
scope f ByteString -> (ByteString -> Endpoint) -> f Endpoint
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. Retry -> Rep Retry x)
-> (forall x. Rep Retry x -> Retry) -> Generic Retry
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
$cfrom :: forall x. Retry -> Rep Retry x
from :: forall x. Retry -> Rep Retry x
$cto :: forall x. Rep Retry x -> Retry
to :: forall x. Rep Retry x -> Retry
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
$sel:base:Exponential :: Retry -> Double
base :: Double
base} = Double -> f Double
f Double
base f Double -> (Double -> Retry) -> f Retry
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
$sel:growth:Exponential :: Retry -> Int
growth :: Int
growth} = Int -> f Int
f Int
growth f Int -> (Int -> Retry) -> f Retry
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
$sel:attempts:Exponential :: Retry -> Int
attempts :: Int
attempts} = Int -> f Int
f Int
attempts f Int -> (Int -> Retry) -> f Retry
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
$sel:check:Exponential :: Retry -> ServiceError -> Maybe Text
check :: ServiceError -> Maybe Text
check} = (ServiceError -> Maybe Text) -> f (ServiceError -> Maybe Text)
f ServiceError -> Maybe Text
check f (ServiceError -> Maybe Text)
-> ((ServiceError -> Maybe Text) -> Retry) -> f Retry
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) = a -> ByteStringBuilder
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 (f :: * -> *).
Functor f =>
(Meta -> f Meta) -> Signed a -> f (Signed a)
signed_signedMeta Meta -> f Meta
f s :: Signed a
s@Signed {Meta
$sel:signedMeta:Signed :: forall a. Signed a -> Meta
signedMeta :: Meta
signedMeta} = Meta -> f Meta
f Meta
signedMeta f Meta -> (Meta -> Signed a) -> f (Signed a)
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 (f :: * -> *).
Functor f =>
(ClientRequest -> f ClientRequest) -> Signed a -> f (Signed a)
signed_signedRequest ClientRequest -> f ClientRequest
f s :: Signed a
s@Signed {ClientRequest
$sel:signedRequest:Signed :: forall a. Signed a -> ClientRequest
signedRequest :: ClientRequest
signedRequest} = ClientRequest -> f ClientRequest
f ClientRequest
signedRequest f ClientRequest -> (ClientRequest -> Signed a) -> f (Signed a)
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. Service -> Rep Service x)
-> (forall x. Rep Service x -> Service) -> Generic Service
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
$cfrom :: forall x. Service -> Rep Service x
from :: forall x. Service -> Rep Service x
$cto :: forall x. Rep Service x -> Service
to :: forall x. Rep Service x -> Service
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
$sel:abbrev:Service :: Service -> Abbrev
abbrev :: Abbrev
abbrev} = Abbrev -> f Abbrev
f Abbrev
abbrev f Abbrev -> (Abbrev -> Service) -> f Service
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
$sel:signer:Service :: Service -> Signer
signer :: Signer
signer} = Signer -> f Signer
f Signer
signer f Signer -> (Signer -> Service) -> f Service
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
$sel:signingName:Service :: Service -> ByteString
signingName :: ByteString
signingName} = ByteString -> f ByteString
f ByteString
signingName f ByteString -> (ByteString -> Service) -> f Service
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
$sel:version:Service :: Service -> ByteString
version :: ByteString
version} = ByteString -> f ByteString
f ByteString
version f ByteString -> (ByteString -> Service) -> f Service
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
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
s3AddressingStyle :: S3AddressingStyle
s3AddressingStyle} = S3AddressingStyle -> f S3AddressingStyle
f S3AddressingStyle
s3AddressingStyle f S3AddressingStyle -> (S3AddressingStyle -> Service) -> f Service
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
$sel:endpointPrefix:Service :: Service -> ByteString
endpointPrefix :: ByteString
endpointPrefix} = ByteString -> f ByteString
f ByteString
endpointPrefix f ByteString -> (ByteString -> Service) -> f Service
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
$sel:endpoint:Service :: Service -> Region -> Endpoint
endpoint :: Region -> Endpoint
endpoint} = (Region -> Endpoint) -> f (Region -> Endpoint)
f Region -> Endpoint
endpoint f (Region -> Endpoint)
-> ((Region -> Endpoint) -> Service) -> f Service
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
$sel:timeout:Service :: Service -> Maybe Seconds
timeout :: Maybe Seconds
timeout} = Maybe Seconds -> f (Maybe Seconds)
f Maybe Seconds
timeout f (Maybe Seconds) -> (Maybe Seconds -> Service) -> f Service
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
$sel:check:Service :: Service -> Status -> Bool
check :: Status -> Bool
check} = (Status -> Bool) -> f (Status -> Bool)
f Status -> Bool
check f (Status -> Bool) -> ((Status -> Bool) -> Service) -> f Service
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
$sel:error:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
error :: Status -> [Header] -> ByteStringLazy -> Error
error} = (Status -> [Header] -> ByteStringLazy -> Error)
-> f (Status -> [Header] -> ByteStringLazy -> Error)
f Status -> [Header] -> ByteStringLazy -> Error
error f (Status -> [Header] -> ByteStringLazy -> Error)
-> ((Status -> [Header] -> ByteStringLazy -> Error) -> Service)
-> f Service
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
$sel:retry:Service :: Service -> Retry
retry :: Retry
retry} = Retry -> f Retry
f Retry
retry f Retry -> (Retry -> Service) -> f Service
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
(S3AddressingStyle -> S3AddressingStyle -> Bool)
-> (S3AddressingStyle -> S3AddressingStyle -> Bool)
-> Eq S3AddressingStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: S3AddressingStyle -> S3AddressingStyle -> Bool
== :: S3AddressingStyle -> S3AddressingStyle -> Bool
$c/= :: S3AddressingStyle -> S3AddressingStyle -> Bool
/= :: S3AddressingStyle -> S3AddressingStyle -> Bool
Eq, Int -> S3AddressingStyle -> ShowS
[S3AddressingStyle] -> ShowS
S3AddressingStyle -> String
(Int -> S3AddressingStyle -> ShowS)
-> (S3AddressingStyle -> String)
-> ([S3AddressingStyle] -> ShowS)
-> Show S3AddressingStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> S3AddressingStyle -> ShowS
showsPrec :: Int -> S3AddressingStyle -> ShowS
$cshow :: S3AddressingStyle -> String
show :: S3AddressingStyle -> String
$cshowList :: [S3AddressingStyle] -> ShowS
showList :: [S3AddressingStyle] -> ShowS
Show, (forall x. S3AddressingStyle -> Rep S3AddressingStyle x)
-> (forall x. Rep S3AddressingStyle x -> S3AddressingStyle)
-> Generic S3AddressingStyle
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
$cfrom :: forall x. S3AddressingStyle -> Rep S3AddressingStyle x
from :: forall x. S3AddressingStyle -> Rep S3AddressingStyle x
$cto :: forall x. Rep S3AddressingStyle x -> S3AddressingStyle
to :: forall x. Rep S3AddressingStyle x -> S3AddressingStyle
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 x. Request a -> Rep (Request a) x)
-> (forall x. Rep (Request a) x -> Request a)
-> Generic (Request a)
forall x. Rep (Request a) x -> Request a
forall x. Request a -> Rep (Request a) x
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
$cfrom :: forall a x. Request a -> Rep (Request a) x
from :: forall x. Request a -> Rep (Request a) x
$cto :: forall a x. Rep (Request a) x -> Request a
to :: forall x. Rep (Request a) x -> Request a
Generic)

{-# INLINE request_service #-}
request_service :: Lens' (Request a) Service
request_service :: forall a (f :: * -> *).
Functor f =>
(Service -> f Service) -> Request a -> f (Request a)
request_service Service -> f Service
f rq :: Request a
rq@Request {Service
$sel:service:Request :: forall a. Request a -> Service
service :: Service
service} = Service -> f Service
f Service
service f Service -> (Service -> Request a) -> f (Request a)
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 (f :: * -> *).
Functor f =>
(StdMethod -> f StdMethod) -> Request a -> f (Request a)
request_method StdMethod -> f StdMethod
f rq :: Request a
rq@Request {StdMethod
$sel:method:Request :: forall a. Request a -> StdMethod
method :: StdMethod
method} = StdMethod -> f StdMethod
f StdMethod
method f StdMethod -> (StdMethod -> Request a) -> f (Request a)
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 (f :: * -> *).
Functor f =>
(RawPath -> f RawPath) -> Request a -> f (Request a)
request_path RawPath -> f RawPath
f rq :: Request a
rq@Request {RawPath
$sel:path:Request :: forall a. Request a -> RawPath
path :: RawPath
path} = RawPath -> f RawPath
f RawPath
path f RawPath -> (RawPath -> Request a) -> f (Request a)
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 (f :: * -> *).
Functor f =>
(QueryString -> f QueryString) -> Request a -> f (Request a)
request_query QueryString -> f QueryString
f rq :: Request a
rq@Request {QueryString
$sel:query:Request :: forall a. Request a -> QueryString
query :: QueryString
query} = QueryString -> f QueryString
f QueryString
query f QueryString -> (QueryString -> Request a) -> f (Request a)
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 (f :: * -> *).
Functor f =>
([Header] -> f [Header]) -> Request a -> f (Request a)
request_headers [Header] -> f [Header]
f rq :: Request a
rq@Request {[Header]
$sel:headers:Request :: forall a. Request a -> [Header]
headers :: [Header]
headers} = [Header] -> f [Header]
f [Header]
headers f [Header] -> ([Header] -> Request a) -> f (Request a)
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 (f :: * -> *).
Functor f =>
(RequestBody -> f RequestBody) -> Request a -> f (Request a)
request_body RequestBody -> f RequestBody
f rq :: Request a
rq@Request {RequestBody
$sel:body:Request :: forall a. Request a -> RequestBody
body :: RequestBody
body} = RequestBody -> f RequestBody
f RequestBody
body f RequestBody -> (RequestBody -> Request a) -> f (Request a)
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
$sel:sign:Signer :: Signer -> forall a. Algorithm a
sign :: forall a. Algorithm a
sign}}} = Algorithm a
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
$sel:presign:Signer :: Signer -> forall a. Seconds -> Algorithm a
presign :: forall a. Seconds -> Algorithm a
presign}}} =
  Seconds -> Algorithm a
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
$sel:abbrev:Service :: Service -> Abbrev
$sel:signer:Service :: Service -> Signer
$sel:signingName:Service :: Service -> ByteString
$sel:version:Service :: Service -> ByteString
$sel:s3AddressingStyle:Service :: Service -> S3AddressingStyle
$sel:endpointPrefix:Service :: Service -> ByteString
$sel:endpoint:Service :: Service -> Region -> Endpoint
$sel:timeout:Service :: Service -> Maybe Seconds
$sel:check:Service :: Service -> Status -> Bool
$sel:error:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
$sel:retry:Service :: Service -> Retry
abbrev :: Abbrev
signer :: Signer
signingName :: ByteString
version :: ByteString
s3AddressingStyle :: S3AddressingStyle
endpointPrefix :: ByteString
endpoint :: Region -> Endpoint
timeout :: Maybe Seconds
check :: Status -> Bool
error :: Status -> [Header] -> ByteStringLazy -> Error
retry :: Retry
..}, [Header]
StdMethod
QueryString
RawPath
RequestBody
$sel:method:Request :: forall a. Request a -> StdMethod
$sel:path:Request :: forall a. Request a -> RawPath
$sel:query:Request :: forall a. Request a -> QueryString
$sel:headers:Request :: forall a. Request a -> [Header]
$sel:body:Request :: forall a. Request a -> RequestBody
method :: StdMethod
path :: RawPath
query :: QueryString
headers :: [Header]
body :: RequestBody
..} Region
r =
  (Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest Endpoint
end Maybe Seconds
timeout)
    { method :: ByteString
Client.method = StdMethod -> ByteString
forall a. ToByteString a => a -> ByteString
toBS StdMethod
method,
      path :: ByteString
Client.path = EscapedPath -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (RawPath -> EscapedPath
forall (a :: Encoding). Path a -> EscapedPath
escapePath RawPath
path),
      queryString :: ByteString
Client.queryString = QueryString -> ByteString
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
(AccessKey -> AccessKey -> Bool)
-> (AccessKey -> AccessKey -> Bool) -> Eq AccessKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessKey -> AccessKey -> Bool
== :: AccessKey -> AccessKey -> Bool
$c/= :: AccessKey -> AccessKey -> Bool
/= :: AccessKey -> AccessKey -> Bool
Eq, Int -> AccessKey -> ShowS
[AccessKey] -> ShowS
AccessKey -> String
(Int -> AccessKey -> ShowS)
-> (AccessKey -> String)
-> ([AccessKey] -> ShowS)
-> Show AccessKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessKey -> ShowS
showsPrec :: Int -> AccessKey -> ShowS
$cshow :: AccessKey -> String
show :: AccessKey -> String
$cshowList :: [AccessKey] -> ShowS
showList :: [AccessKey] -> ShowS
Show, ReadPrec [AccessKey]
ReadPrec AccessKey
Int -> ReadS AccessKey
ReadS [AccessKey]
(Int -> ReadS AccessKey)
-> ReadS [AccessKey]
-> ReadPrec AccessKey
-> ReadPrec [AccessKey]
-> Read AccessKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AccessKey
readsPrec :: Int -> ReadS AccessKey
$creadList :: ReadS [AccessKey]
readList :: ReadS [AccessKey]
$creadPrec :: ReadPrec AccessKey
readPrec :: ReadPrec AccessKey
$creadListPrec :: ReadPrec [AccessKey]
readListPrec :: ReadPrec [AccessKey]
Read, (forall x. AccessKey -> Rep AccessKey x)
-> (forall x. Rep AccessKey x -> AccessKey) -> Generic AccessKey
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
$cfrom :: forall x. AccessKey -> Rep AccessKey x
from :: forall x. AccessKey -> Rep AccessKey x
$cto :: forall x. Rep AccessKey x -> AccessKey
to :: forall x. Rep AccessKey x -> AccessKey
Generic)
  deriving newtype
    ( String -> AccessKey
(String -> AccessKey) -> IsString AccessKey
forall a. (String -> a) -> IsString a
$cfromString :: String -> AccessKey
fromString :: String -> AccessKey
IsString,
      AccessKey -> Text
(AccessKey -> Text) -> ToText AccessKey
forall a. (a -> Text) -> ToText a
$ctoText :: AccessKey -> Text
toText :: AccessKey -> Text
ToText,
      Text -> Either String AccessKey
(Text -> Either String AccessKey) -> FromText AccessKey
forall a. (Text -> Either String a) -> FromText a
$cfromText :: Text -> Either String AccessKey
fromText :: Text -> Either String AccessKey
FromText,
      AccessKey -> ByteStringBuilder
(AccessKey -> ByteStringBuilder) -> ToLog AccessKey
forall a. (a -> ByteStringBuilder) -> ToLog a
$cbuild :: AccessKey -> ByteStringBuilder
build :: AccessKey -> ByteStringBuilder
ToLog,
      AccessKey -> ByteString
(AccessKey -> ByteString) -> ToByteString AccessKey
forall a. (a -> ByteString) -> ToByteString a
$ctoBS :: AccessKey -> ByteString
toBS :: AccessKey -> ByteString
ToByteString,
      AccessKey -> QueryString
(AccessKey -> QueryString) -> ToQuery AccessKey
forall a. (a -> QueryString) -> ToQuery a
$ctoQuery :: AccessKey -> QueryString
toQuery :: AccessKey -> QueryString
ToQuery,
      [Node] -> Either String AccessKey
([Node] -> Either String AccessKey) -> FromXML AccessKey
forall a. ([Node] -> Either String a) -> FromXML a
$cparseXML :: [Node] -> Either String AccessKey
parseXML :: [Node] -> Either String AccessKey
FromXML,
      AccessKey -> XML
(AccessKey -> XML) -> ToXML AccessKey
forall a. (a -> XML) -> ToXML a
$ctoXML :: AccessKey -> XML
toXML :: AccessKey -> XML
ToXML,
      Eq AccessKey
Eq AccessKey
-> (Int -> AccessKey -> Int)
-> (AccessKey -> Int)
-> Hashable AccessKey
Int -> AccessKey -> Int
AccessKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AccessKey -> Int
hashWithSalt :: Int -> AccessKey -> Int
$chash :: AccessKey -> Int
hash :: AccessKey -> Int
Hashable,
      AccessKey -> ()
(AccessKey -> ()) -> NFData AccessKey
forall a. (a -> ()) -> NFData a
$crnf :: AccessKey -> ()
rnf :: AccessKey -> ()
NFData
    )

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

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

_AccessKey :: Iso' AccessKey ByteString
_AccessKey :: Iso' AccessKey ByteString
_AccessKey = p ByteString (f ByteString) -> p AccessKey (f AccessKey)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' AccessKey ByteString
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
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, (forall x. SecretKey -> Rep SecretKey x)
-> (forall x. Rep SecretKey x -> SecretKey) -> Generic SecretKey
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
$cfrom :: forall x. SecretKey -> Rep SecretKey x
from :: forall x. SecretKey -> Rep SecretKey x
$cto :: forall x. Rep SecretKey x -> SecretKey
to :: forall x. Rep SecretKey x -> SecretKey
Generic)
  deriving newtype
    ( String -> SecretKey
(String -> SecretKey) -> IsString SecretKey
forall a. (String -> a) -> IsString a
$cfromString :: String -> SecretKey
fromString :: String -> SecretKey
IsString,
      SecretKey -> Text
(SecretKey -> Text) -> ToText SecretKey
forall a. (a -> Text) -> ToText a
$ctoText :: SecretKey -> Text
toText :: SecretKey -> Text
ToText,
      Text -> Either String SecretKey
(Text -> Either String SecretKey) -> FromText SecretKey
forall a. (Text -> Either String a) -> FromText a
$cfromText :: Text -> Either String SecretKey
fromText :: Text -> Either String SecretKey
FromText,
      SecretKey -> ByteString
(SecretKey -> ByteString) -> ToByteString SecretKey
forall a. (a -> ByteString) -> ToByteString a
$ctoBS :: SecretKey -> ByteString
toBS :: SecretKey -> ByteString
ToByteString,
      [Node] -> Either String SecretKey
([Node] -> Either String SecretKey) -> FromXML SecretKey
forall a. ([Node] -> Either String a) -> FromXML a
$cparseXML :: [Node] -> Either String SecretKey
parseXML :: [Node] -> Either String SecretKey
FromXML,
      SecretKey -> XML
(SecretKey -> XML) -> ToXML SecretKey
forall a. (a -> XML) -> ToXML a
$ctoXML :: SecretKey -> XML
toXML :: SecretKey -> XML
ToXML,
      Eq SecretKey
Eq SecretKey
-> (Int -> SecretKey -> Int)
-> (SecretKey -> Int)
-> Hashable SecretKey
Int -> SecretKey -> Int
SecretKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SecretKey -> Int
hashWithSalt :: Int -> SecretKey -> Int
$chash :: SecretKey -> Int
hash :: SecretKey -> Int
Hashable,
      SecretKey -> ()
(SecretKey -> ()) -> NFData SecretKey
forall a. (a -> ()) -> NFData a
$crnf :: SecretKey -> ()
rnf :: SecretKey -> ()
NFData
    )

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

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

_SecretKey :: Iso' SecretKey ByteString
_SecretKey :: Iso' SecretKey ByteString
_SecretKey = p ByteString (f ByteString) -> p SecretKey (f SecretKey)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' SecretKey ByteString
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
(SessionToken -> SessionToken -> Bool)
-> (SessionToken -> SessionToken -> Bool) -> Eq SessionToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionToken -> SessionToken -> Bool
== :: SessionToken -> SessionToken -> Bool
$c/= :: SessionToken -> SessionToken -> Bool
/= :: SessionToken -> SessionToken -> Bool
Eq, (forall x. SessionToken -> Rep SessionToken x)
-> (forall x. Rep SessionToken x -> SessionToken)
-> Generic SessionToken
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
$cfrom :: forall x. SessionToken -> Rep SessionToken x
from :: forall x. SessionToken -> Rep SessionToken x
$cto :: forall x. Rep SessionToken x -> SessionToken
to :: forall x. Rep SessionToken x -> SessionToken
Generic)
  deriving newtype
    ( String -> SessionToken
(String -> SessionToken) -> IsString SessionToken
forall a. (String -> a) -> IsString a
$cfromString :: String -> SessionToken
fromString :: String -> SessionToken
IsString,
      SessionToken -> Text
(SessionToken -> Text) -> ToText SessionToken
forall a. (a -> Text) -> ToText a
$ctoText :: SessionToken -> Text
toText :: SessionToken -> Text
ToText,
      Text -> Either String SessionToken
(Text -> Either String SessionToken) -> FromText SessionToken
forall a. (Text -> Either String a) -> FromText a
$cfromText :: Text -> Either String SessionToken
fromText :: Text -> Either String SessionToken
FromText,
      SessionToken -> ByteString
(SessionToken -> ByteString) -> ToByteString SessionToken
forall a. (a -> ByteString) -> ToByteString a
$ctoBS :: SessionToken -> ByteString
toBS :: SessionToken -> ByteString
ToByteString,
      [Node] -> Either String SessionToken
([Node] -> Either String SessionToken) -> FromXML SessionToken
forall a. ([Node] -> Either String a) -> FromXML a
$cparseXML :: [Node] -> Either String SessionToken
parseXML :: [Node] -> Either String SessionToken
FromXML,
      SessionToken -> XML
(SessionToken -> XML) -> ToXML SessionToken
forall a. (a -> XML) -> ToXML a
$ctoXML :: SessionToken -> XML
toXML :: SessionToken -> XML
ToXML,
      Eq SessionToken
Eq SessionToken
-> (Int -> SessionToken -> Int)
-> (SessionToken -> Int)
-> Hashable SessionToken
Int -> SessionToken -> Int
SessionToken -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SessionToken -> Int
hashWithSalt :: Int -> SessionToken -> Int
$chash :: SessionToken -> Int
hash :: SessionToken -> Int
Hashable,
      SessionToken -> ()
(SessionToken -> ()) -> NFData SessionToken
forall a. (a -> ()) -> NFData a
$crnf :: SessionToken -> ()
rnf :: SessionToken -> ()
NFData
    )

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

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

_SessionToken :: Iso' SessionToken ByteString
_SessionToken :: Iso' SessionToken ByteString
_SessionToken = p ByteString (f ByteString) -> p SessionToken (f SessionToken)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' SessionToken ByteString
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
(AuthEnv -> AuthEnv -> Bool)
-> (AuthEnv -> AuthEnv -> Bool) -> Eq AuthEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthEnv -> AuthEnv -> Bool
== :: AuthEnv -> AuthEnv -> Bool
$c/= :: AuthEnv -> AuthEnv -> Bool
/= :: AuthEnv -> AuthEnv -> Bool
Eq, Int -> AuthEnv -> ShowS
[AuthEnv] -> ShowS
AuthEnv -> String
(Int -> AuthEnv -> ShowS)
-> (AuthEnv -> String) -> ([AuthEnv] -> ShowS) -> Show AuthEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthEnv -> ShowS
showsPrec :: Int -> AuthEnv -> ShowS
$cshow :: AuthEnv -> String
show :: AuthEnv -> String
$cshowList :: [AuthEnv] -> ShowS
showList :: [AuthEnv] -> ShowS
Show, (forall x. AuthEnv -> Rep AuthEnv x)
-> (forall x. Rep AuthEnv x -> AuthEnv) -> Generic AuthEnv
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
$cfrom :: forall x. AuthEnv -> Rep AuthEnv x
from :: forall x. AuthEnv -> Rep AuthEnv x
$cto :: forall x. Rep AuthEnv x -> AuthEnv
to :: forall x. Rep AuthEnv x -> AuthEnv
Generic)
  deriving anyclass (AuthEnv -> ()
(AuthEnv -> ()) -> NFData AuthEnv
forall a. (a -> ()) -> NFData a
$crnf :: AuthEnv -> ()
rnf :: AuthEnv -> ()
NFData)

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

instance FromJSON AuthEnv where
  parseJSON :: Value -> Parser AuthEnv
parseJSON = String -> (Object -> Parser AuthEnv) -> Value -> Parser AuthEnv
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AuthEnv" ((Object -> Parser AuthEnv) -> Value -> Parser AuthEnv)
-> (Object -> Parser AuthEnv) -> Value -> Parser AuthEnv
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
      (AccessKey
 -> Sensitive SecretKey
 -> Maybe (Sensitive SessionToken)
 -> Maybe ISO8601
 -> AuthEnv)
-> Parser AccessKey
-> Parser
     (Sensitive SecretKey
      -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser AccessKey
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"AccessKeyId"
      Parser
  (Sensitive SecretKey
   -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Parser (Sensitive SecretKey)
-> Parser
     (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Sensitive SecretKey)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"SecretAccessKey"
      Parser (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Parser (Maybe (Sensitive SessionToken))
-> Parser (Maybe ISO8601 -> AuthEnv)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Sensitive SessionToken))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Token"
      Parser (Maybe ISO8601 -> AuthEnv)
-> Parser (Maybe ISO8601) -> Parser AuthEnv
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ISO8601)
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
      (AccessKey
 -> Sensitive SecretKey
 -> Maybe (Sensitive SessionToken)
 -> Maybe ISO8601
 -> AuthEnv)
-> Either String AccessKey
-> Either
     String
     (Sensitive SecretKey
      -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node]
x [Node] -> Text -> Either String AccessKey
forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
"AccessKeyId"
      Either
  String
  (Sensitive SecretKey
   -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Either String (Sensitive SecretKey)
-> Either
     String (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
x [Node] -> Text -> Either String (Sensitive SecretKey)
forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
"SecretAccessKey"
      Either
  String (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Either String (Maybe (Sensitive SessionToken))
-> Either String (Maybe ISO8601 -> AuthEnv)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
x [Node] -> Text -> Either String (Maybe (Sensitive SessionToken))
forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
.@? Text
"SessionToken"
      Either String (Maybe ISO8601 -> AuthEnv)
-> Either String (Maybe ISO8601) -> Either String AuthEnv
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
x [Node] -> Text -> Either String (Maybe ISO8601)
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
$sel:accessKeyId:AuthEnv :: AuthEnv -> AccessKey
accessKeyId :: AccessKey
accessKeyId} = AccessKey -> f AccessKey
f AccessKey
accessKeyId f AccessKey -> (AccessKey -> AuthEnv) -> f AuthEnv
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
$sel:secretAccessKey:AuthEnv :: AuthEnv -> Sensitive SecretKey
secretAccessKey :: Sensitive SecretKey
secretAccessKey} = Sensitive SecretKey -> f (Sensitive SecretKey)
f Sensitive SecretKey
secretAccessKey f (Sensitive SecretKey)
-> (Sensitive SecretKey -> AuthEnv) -> f AuthEnv
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)
$sel:sessionToken:AuthEnv :: AuthEnv -> Maybe (Sensitive SessionToken)
sessionToken :: Maybe (Sensitive SessionToken)
sessionToken} = Maybe (Sensitive SessionToken)
-> f (Maybe (Sensitive SessionToken))
f Maybe (Sensitive SessionToken)
sessionToken f (Maybe (Sensitive SessionToken))
-> (Maybe (Sensitive SessionToken) -> AuthEnv) -> f AuthEnv
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
$sel:expiration:AuthEnv :: AuthEnv -> Maybe ISO8601
expiration :: Maybe ISO8601
expiration} = Maybe ISO8601 -> f (Maybe ISO8601)
f Maybe ISO8601
expiration f (Maybe ISO8601) -> (Maybe ISO8601 -> AuthEnv) -> f AuthEnv
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:" ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> String -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (ThreadId -> String
forall a. Show a => a -> String
show ThreadId
t) ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"> }"
  build (Auth AuthEnv
e) = AuthEnv -> ByteStringBuilder
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 = IO AuthEnv -> m AuthEnv
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef AuthEnv -> IO AuthEnv
forall a. IORef a -> IO a
readIORef IORef AuthEnv
r) m AuthEnv -> (AuthEnv -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
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
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Region -> ShowS
showsPrec :: Int -> Region -> ShowS
$cshow :: Region -> String
show :: Region -> String
$cshowList :: [Region] -> ShowS
showList :: [Region] -> ShowS
Show, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
(Int -> ReadS Region)
-> ReadS [Region]
-> ReadPrec Region
-> ReadPrec [Region]
-> Read Region
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Region
readsPrec :: Int -> ReadS Region
$creadList :: ReadS [Region]
readList :: ReadS [Region]
$creadPrec :: ReadPrec Region
readPrec :: ReadPrec Region
$creadListPrec :: ReadPrec [Region]
readListPrec :: ReadPrec [Region]
Read, Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
/= :: Region -> Region -> Bool
Eq, Eq Region
Eq Region
-> (Region -> Region -> Ordering)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Region)
-> (Region -> Region -> Region)
-> Ord 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
$ccompare :: Region -> Region -> Ordering
compare :: Region -> Region -> Ordering
$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
>= :: Region -> Region -> Bool
$cmax :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
min :: Region -> Region -> Region
Ord, (forall x. Region -> Rep Region x)
-> (forall x. Rep Region x -> Region) -> Generic Region
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
$cfrom :: forall x. Region -> Rep Region x
from :: forall x. Region -> Rep Region x
$cto :: forall x. Rep Region x -> Region
to :: forall x. Rep Region x -> Region
Generic)
  deriving newtype
    ( String -> Region
(String -> Region) -> IsString Region
forall a. (String -> a) -> IsString a
$cfromString :: String -> Region
fromString :: String -> Region
IsString,
      Eq Region
Eq Region
-> (Int -> Region -> Int) -> (Region -> Int) -> Hashable Region
Int -> Region -> Int
Region -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Region -> Int
hashWithSalt :: Int -> Region -> Int
$chash :: Region -> Int
hash :: Region -> Int
Hashable,
      Region -> ()
(Region -> ()) -> NFData Region
forall a. (a -> ()) -> NFData a
$crnf :: Region -> ()
rnf :: Region -> ()
NFData,
      Region -> Text
(Region -> Text) -> ToText Region
forall a. (a -> Text) -> ToText a
$ctoText :: Region -> Text
toText :: Region -> Text
ToText,
      Text -> Either String Region
(Text -> Either String Region) -> FromText Region
forall a. (Text -> Either String a) -> FromText a
$cfromText :: Text -> Either String Region
fromText :: Text -> Either String Region
FromText,
      Region -> QueryString
(Region -> QueryString) -> ToQuery Region
forall a. (a -> QueryString) -> ToQuery a
$ctoQuery :: Region -> QueryString
toQuery :: Region -> QueryString
ToQuery,
      Region -> XML
(Region -> XML) -> ToXML Region
forall a. (a -> XML) -> ToXML a
$ctoXML :: Region -> XML
toXML :: Region -> XML
ToXML,
      [Node] -> Either String Region
([Node] -> Either String Region) -> FromXML Region
forall a. ([Node] -> Either String a) -> FromXML a
$cparseXML :: [Node] -> Either String Region
parseXML :: [Node] -> Either String Region
FromXML,
      [Region] -> Value
[Region] -> Encoding
Region -> Value
Region -> Encoding
(Region -> Value)
-> (Region -> Encoding)
-> ([Region] -> Value)
-> ([Region] -> Encoding)
-> ToJSON Region
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Region -> Value
toJSON :: Region -> Value
$ctoEncoding :: Region -> Encoding
toEncoding :: Region -> Encoding
$ctoJSONList :: [Region] -> Value
toJSONList :: [Region] -> Value
$ctoEncodingList :: [Region] -> Encoding
toEncodingList :: [Region] -> Encoding
ToJSON,
      Value -> Parser [Region]
Value -> Parser Region
(Value -> Parser Region)
-> (Value -> Parser [Region]) -> FromJSON Region
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Region
parseJSON :: Value -> Parser Region
$cparseJSONList :: Value -> Parser [Region]
parseJSONList :: Value -> Parser [Region]
FromJSON,
      Region -> ByteString
(Region -> ByteString) -> ToByteString Region
forall a. (a -> ByteString) -> ToByteString a
$ctoBS :: Region -> ByteString
toBS :: Region -> ByteString
ToByteString,
      Region -> ByteStringBuilder
(Region -> ByteStringBuilder) -> ToLog Region
forall a. (a -> ByteStringBuilder) -> ToLog a
$cbuild :: Region -> ByteStringBuilder
build :: Region -> ByteStringBuilder
ToLog
    )

{-# INLINE _Region #-}
_Region :: Iso' Region Text
_Region :: Iso' Region Text
_Region = p Text (f Text) -> p Region (f Region)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' Region Text
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 $mOhio :: forall {r}. Region -> ((# #) -> r) -> ((# #) -> r) -> r
$bOhio :: Region
Ohio = Region' "us-east-2"

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

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

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

-- Africa

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

-- Asia Pacific

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

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

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

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

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

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

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

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

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

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

-- Canada

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

-- Europe

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

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

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

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

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

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

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

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

-- Middle East

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

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

-- South America

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

-- GovCloud

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

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

-- China

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

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

instance Hashable Seconds where
  hashWithSalt :: Int -> Seconds -> Int
hashWithSalt Int
salt = Int -> Rational -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Rational -> Int) -> (Seconds -> Rational) -> Seconds -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational (DiffTime -> Rational)
-> (Seconds -> DiffTime) -> Seconds -> Rational
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 =
    Either String Seconds
-> (DiffTime -> Either String Seconds)
-> Maybe DiffTime
-> Either String Seconds
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Seconds
forall a b. a -> Either a b
Left String
err) (Seconds -> Either String Seconds
forall a b. b -> Either a b
Right (Seconds -> Either String Seconds)
-> (DiffTime -> Seconds) -> DiffTime -> Either String Seconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Seconds
Seconds) (Maybe DiffTime -> Either String Seconds)
-> Maybe DiffTime -> Either String Seconds
forall a b. (a -> b) -> a -> b
$
      Bool -> TimeLocale -> String -> String -> Maybe DiffTime
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 ("
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
diffTimeFormatString
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"): "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str

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

_Seconds :: Iso' Seconds DiffTime
_Seconds :: Iso' Seconds DiffTime
_Seconds = p DiffTime (f DiffTime) -> p Seconds (f Seconds)
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Iso' Seconds DiffTime
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 = Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (Seconds -> Text
forall a. ToText a => a -> Text
toText Seconds
s) ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"s"

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

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