-- |
-- Module      : Amazonka.Types
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Types
  ( -- * Authentication

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

    -- ** Environment
    Auth (..),
    withAuth,
    AuthEnv (..),
    authAccessKeyId,
    authSecretAccessKey,
    authSessionToken,
    authExpiration,

    -- * Logging
    LogLevel (..),
    Logger,

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

    -- * Service
    Abbrev,
    Service (..),
    serviceSigner,
    serviceEndpoint,
    serviceTimeout,
    serviceCheck,
    serviceRetry,

    -- * Requests
    AWSRequest (..),
    Request (..),
    requestService,
    requestMethod,
    requestHeaders,
    requestPath,
    requestQuery,
    requestBody,
    requestSign,
    requestPresign,
    requestUnsigned,

    -- * Retries
    Retry (..),
    exponentBase,
    exponentGrowth,
    retryAttempts,
    retryCheck,

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

    -- ** HTTP Errors
    Client.HttpException,

    -- ** Serialize Errors
    SerializeError (..),
    serializeAbbrev,
    serializeStatus,
    serializeMessage,

    -- ** Service Errors
    ServiceError (..),
    serviceAbbrev,
    serviceStatus,
    serviceHeaders,
    serviceCode,
    serviceMessage,
    serviceRequestId,

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

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

    -- * Endpoints
    Endpoint (..),
    endpointHost,
    endpointPort,
    endpointSecure,
    endpointScope,

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

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

import Amazonka.Data
import qualified Amazonka.Lens as Lens
import Amazonka.Prelude
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 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
endpoint Maybe Seconds
timeout =
  ClientRequest
Client.defaultRequest
    { secure :: Bool
Client.secure = Endpoint -> Bool
_endpointSecure Endpoint
endpoint,
      host :: ByteString
Client.host = Endpoint -> ByteString
_endpointHost Endpoint
endpoint,
      port :: Int
Client.port = Endpoint -> Int
_endpointPort Endpoint
endpoint,
      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
/= :: Abbrev -> Abbrev -> Bool
$c/= :: Abbrev -> Abbrev -> Bool
== :: Abbrev -> Abbrev -> Bool
$c== :: 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
min :: Abbrev -> Abbrev -> Abbrev
$cmin :: Abbrev -> Abbrev -> Abbrev
max :: Abbrev -> Abbrev -> Abbrev
$cmax :: Abbrev -> Abbrev -> Abbrev
>= :: Abbrev -> Abbrev -> Bool
$c>= :: Abbrev -> Abbrev -> Bool
> :: Abbrev -> Abbrev -> Bool
$c> :: Abbrev -> Abbrev -> Bool
<= :: Abbrev -> Abbrev -> Bool
$c<= :: Abbrev -> Abbrev -> Bool
< :: Abbrev -> Abbrev -> Bool
$c< :: Abbrev -> Abbrev -> Bool
compare :: Abbrev -> Abbrev -> Ordering
$ccompare :: Abbrev -> Abbrev -> Ordering
$cp1Ord :: Eq 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
showList :: [Abbrev] -> ShowS
$cshowList :: [Abbrev] -> ShowS
show :: Abbrev -> String
$cshow :: Abbrev -> String
showsPrec :: Int -> Abbrev -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Abbrev x -> Abbrev
$cfrom :: forall x. Abbrev -> Rep Abbrev x
Generic)
  deriving newtype (String -> Abbrev
(String -> Abbrev) -> IsString Abbrev
forall a. (String -> a) -> IsString a
fromString :: String -> Abbrev
$cfromString :: String -> Abbrev
IsString, [Node] -> Either String Abbrev
([Node] -> Either String Abbrev) -> FromXML Abbrev
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String Abbrev
$cparseXML :: [Node] -> Either String Abbrev
FromXML, Value -> Parser [Abbrev]
Value -> Parser Abbrev
(Value -> Parser Abbrev)
-> (Value -> Parser [Abbrev]) -> FromJSON Abbrev
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Abbrev]
$cparseJSONList :: Value -> Parser [Abbrev]
parseJSON :: Value -> Parser Abbrev
$cparseJSON :: Value -> Parser Abbrev
FromJSON, Text -> Either String Abbrev
(Text -> Either String Abbrev) -> FromText Abbrev
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String Abbrev
$cfromText :: Text -> Either String Abbrev
FromText, Abbrev -> Text
(Abbrev -> Text) -> ToText Abbrev
forall a. (a -> Text) -> ToText a
toText :: Abbrev -> Text
$ctoText :: Abbrev -> Text
ToText, Abbrev -> ByteStringBuilder
(Abbrev -> ByteStringBuilder) -> ToLog Abbrev
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: Abbrev -> ByteStringBuilder
$cbuild :: Abbrev -> ByteStringBuilder
ToLog)

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

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

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

-- | 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
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic)

instance Exception Error

instance ToLog Error where
  build :: Error -> ByteStringBuilder
build = \case
    TransportError HttpException
e -> 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
_serializeErrorAbbrev :: Abbrev,
    SerializeError -> Status
_serializeErrorStatus :: Status,
    -- | The response body, if the response was not streaming.
    SerializeError -> Maybe ByteStringLazy
_serializeErrorBody :: Maybe ByteStringLazy,
    SerializeError -> String
_serializeErrorMessage :: String
  }
  deriving stock (SerializeError -> SerializeError -> Bool
(SerializeError -> SerializeError -> Bool)
-> (SerializeError -> SerializeError -> Bool) -> Eq SerializeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerializeError -> SerializeError -> Bool
$c/= :: SerializeError -> SerializeError -> Bool
== :: SerializeError -> SerializeError -> Bool
$c== :: SerializeError -> SerializeError -> Bool
Eq, Int -> SerializeError -> ShowS
[SerializeError] -> ShowS
SerializeError -> String
(Int -> SerializeError -> ShowS)
-> (SerializeError -> String)
-> ([SerializeError] -> ShowS)
-> Show SerializeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerializeError] -> ShowS
$cshowList :: [SerializeError] -> ShowS
show :: SerializeError -> String
$cshow :: SerializeError -> String
showsPrec :: Int -> SerializeError -> ShowS
$cshowsPrec :: Int -> SerializeError -> ShowS
Show, (forall x. 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
$cto :: forall x. Rep SerializeError x -> SerializeError
$cfrom :: forall x. SerializeError -> Rep SerializeError x
Generic)

instance ToLog SerializeError where
  build :: SerializeError -> ByteStringBuilder
build SerializeError' {String
Maybe ByteStringLazy
Status
Abbrev
_serializeErrorMessage :: String
_serializeErrorBody :: Maybe ByteStringLazy
_serializeErrorStatus :: Status
_serializeErrorAbbrev :: Abbrev
$sel:_serializeErrorMessage:SerializeError' :: SerializeError -> String
$sel:_serializeErrorBody:SerializeError' :: SerializeError -> Maybe ByteStringLazy
$sel:_serializeErrorStatus:SerializeError' :: SerializeError -> Status
$sel:_serializeErrorAbbrev:SerializeError' :: SerializeError -> Abbrev
..} =
    [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
_serializeErrorAbbrev,
        ByteStringBuilder
"  status  = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Status -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Status
_serializeErrorStatus,
        ByteStringBuilder
"  message = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> String -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build String
_serializeErrorMessage,
        ByteStringBuilder
"  body    = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe ByteStringLazy -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Maybe ByteStringLazy
_serializeErrorBody,
        ByteStringBuilder
"}"
      ]

serializeAbbrev :: Lens' SerializeError Abbrev
serializeAbbrev :: (Abbrev -> f Abbrev) -> SerializeError -> f SerializeError
serializeAbbrev = (SerializeError -> Abbrev)
-> (SerializeError -> Abbrev -> SerializeError)
-> Lens SerializeError SerializeError Abbrev Abbrev
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens SerializeError -> Abbrev
_serializeErrorAbbrev (\SerializeError
s Abbrev
a -> SerializeError
s {$sel:_serializeErrorAbbrev:SerializeError' :: Abbrev
_serializeErrorAbbrev = Abbrev
a})

serializeStatus :: Lens' SerializeError Status
serializeStatus :: (Status -> f Status) -> SerializeError -> f SerializeError
serializeStatus = (SerializeError -> Status)
-> (SerializeError -> Status -> SerializeError)
-> Lens SerializeError SerializeError Status Status
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens SerializeError -> Status
_serializeErrorStatus (\SerializeError
s Status
a -> SerializeError
s {$sel:_serializeErrorStatus:SerializeError' :: Status
_serializeErrorStatus = Status
a})

serializeMessage :: Lens' SerializeError String
serializeMessage :: (String -> f String) -> SerializeError -> f SerializeError
serializeMessage = (SerializeError -> String)
-> (SerializeError -> String -> SerializeError)
-> Lens SerializeError SerializeError String String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens SerializeError -> String
_serializeErrorMessage (\SerializeError
s String
a -> SerializeError
s {$sel:_serializeErrorMessage:SerializeError' :: String
_serializeErrorMessage = String
a})

data ServiceError = ServiceError'
  { ServiceError -> Abbrev
_serviceErrorAbbrev :: Abbrev,
    ServiceError -> Status
_serviceErrorStatus :: Status,
    ServiceError -> [Header]
_serviceErrorHeaders :: [Header],
    ServiceError -> ErrorCode
_serviceErrorCode :: ErrorCode,
    ServiceError -> Maybe ErrorMessage
_serviceErrorMessage :: Maybe ErrorMessage,
    ServiceError -> Maybe RequestId
_serviceErrorRequestId :: 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
/= :: ServiceError -> ServiceError -> Bool
$c/= :: ServiceError -> ServiceError -> Bool
== :: ServiceError -> ServiceError -> Bool
$c== :: 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
showList :: [ServiceError] -> ShowS
$cshowList :: [ServiceError] -> ShowS
show :: ServiceError -> String
$cshow :: ServiceError -> String
showsPrec :: Int -> ServiceError -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ServiceError x -> ServiceError
$cfrom :: forall x. ServiceError -> Rep ServiceError x
Generic)

instance ToLog ServiceError where
  build :: ServiceError -> ByteStringBuilder
build ServiceError' {[Header]
Maybe RequestId
Maybe ErrorMessage
Status
ErrorCode
Abbrev
_serviceErrorRequestId :: Maybe RequestId
_serviceErrorMessage :: Maybe ErrorMessage
_serviceErrorCode :: ErrorCode
_serviceErrorHeaders :: [Header]
_serviceErrorStatus :: Status
_serviceErrorAbbrev :: Abbrev
$sel:_serviceErrorRequestId:ServiceError' :: ServiceError -> Maybe RequestId
$sel:_serviceErrorMessage:ServiceError' :: ServiceError -> Maybe ErrorMessage
$sel:_serviceErrorCode:ServiceError' :: ServiceError -> ErrorCode
$sel:_serviceErrorHeaders:ServiceError' :: ServiceError -> [Header]
$sel:_serviceErrorStatus:ServiceError' :: ServiceError -> Status
$sel:_serviceErrorAbbrev:ServiceError' :: ServiceError -> Abbrev
..} =
    [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
_serviceErrorAbbrev,
        ByteStringBuilder
"  status     = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Status -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Status
_serviceErrorStatus,
        ByteStringBuilder
"  code       = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ErrorCode -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build ErrorCode
_serviceErrorCode,
        ByteStringBuilder
"  message    = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe ErrorMessage -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Maybe ErrorMessage
_serviceErrorMessage,
        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
_serviceErrorRequestId,
        ByteStringBuilder
"}"
      ]

serviceAbbrev :: Lens' ServiceError Abbrev
serviceAbbrev :: (Abbrev -> f Abbrev) -> ServiceError -> f ServiceError
serviceAbbrev = (ServiceError -> Abbrev)
-> (ServiceError -> Abbrev -> ServiceError)
-> Lens ServiceError ServiceError Abbrev Abbrev
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens ServiceError -> Abbrev
_serviceErrorAbbrev (\ServiceError
s Abbrev
a -> ServiceError
s {$sel:_serviceErrorAbbrev:ServiceError' :: Abbrev
_serviceErrorAbbrev = Abbrev
a})

serviceStatus :: Lens' ServiceError Status
serviceStatus :: (Status -> f Status) -> ServiceError -> f ServiceError
serviceStatus = (ServiceError -> Status)
-> (ServiceError -> Status -> ServiceError)
-> Lens ServiceError ServiceError Status Status
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens ServiceError -> Status
_serviceErrorStatus (\ServiceError
s Status
a -> ServiceError
s {$sel:_serviceErrorStatus:ServiceError' :: Status
_serviceErrorStatus = Status
a})

serviceHeaders :: Lens' ServiceError [Header]
serviceHeaders :: ([Header] -> f [Header]) -> ServiceError -> f ServiceError
serviceHeaders = (ServiceError -> [Header])
-> (ServiceError -> [Header] -> ServiceError)
-> Lens ServiceError ServiceError [Header] [Header]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens ServiceError -> [Header]
_serviceErrorHeaders (\ServiceError
s [Header]
a -> ServiceError
s {$sel:_serviceErrorHeaders:ServiceError' :: [Header]
_serviceErrorHeaders = [Header]
a})

serviceCode :: Lens' ServiceError ErrorCode
serviceCode :: (ErrorCode -> f ErrorCode) -> ServiceError -> f ServiceError
serviceCode = (ServiceError -> ErrorCode)
-> (ServiceError -> ErrorCode -> ServiceError)
-> Lens ServiceError ServiceError ErrorCode ErrorCode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens ServiceError -> ErrorCode
_serviceErrorCode (\ServiceError
s ErrorCode
a -> ServiceError
s {$sel:_serviceErrorCode:ServiceError' :: ErrorCode
_serviceErrorCode = ErrorCode
a})

serviceMessage :: Lens' ServiceError (Maybe ErrorMessage)
serviceMessage :: (Maybe ErrorMessage -> f (Maybe ErrorMessage))
-> ServiceError -> f ServiceError
serviceMessage = (ServiceError -> Maybe ErrorMessage)
-> (ServiceError -> Maybe ErrorMessage -> ServiceError)
-> Lens
     ServiceError ServiceError (Maybe ErrorMessage) (Maybe ErrorMessage)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens ServiceError -> Maybe ErrorMessage
_serviceErrorMessage (\ServiceError
s Maybe ErrorMessage
a -> ServiceError
s {$sel:_serviceErrorMessage:ServiceError' :: Maybe ErrorMessage
_serviceErrorMessage = Maybe ErrorMessage
a})

serviceRequestId :: Lens' ServiceError (Maybe RequestId)
serviceRequestId :: (Maybe RequestId -> f (Maybe RequestId))
-> ServiceError -> f ServiceError
serviceRequestId = (ServiceError -> Maybe RequestId)
-> (ServiceError -> Maybe RequestId -> ServiceError)
-> Lens
     ServiceError ServiceError (Maybe RequestId) (Maybe RequestId)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens ServiceError -> Maybe RequestId
_serviceErrorRequestId (\ServiceError
s Maybe RequestId
a -> ServiceError
s {$sel:_serviceErrorRequestId:ServiceError' :: Maybe RequestId
_serviceErrorRequestId = Maybe RequestId
a})

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
_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
_TransportError
  _SerializeError = p Error (f Error) -> p a (f a)
forall a. AsError a => 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
_SerializeError
  _ServiceError = p Error (f Error) -> p a (f a)
forall a. AsError a => 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
_ServiceError

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

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

  _TransportError :: p HttpException (f HttpException) -> p Error (f Error)
_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 :: p SerializeError (f SerializeError) -> p Error (f Error)
_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 :: p ServiceError (f ServiceError) -> p Error (f Error)
_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
  { Endpoint -> ByteString
_endpointHost :: ByteString,
    Endpoint -> Bool
_endpointSecure :: Bool,
    Endpoint -> Int
_endpointPort :: Int,
    Endpoint -> ByteString
_endpointScope :: ByteString
  }
  deriving stock (Endpoint -> Endpoint -> Bool
(Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool) -> Eq Endpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show)

endpointHost :: Lens' Endpoint ByteString
endpointHost :: (ByteString -> f ByteString) -> Endpoint -> f Endpoint
endpointHost = (Endpoint -> ByteString)
-> (Endpoint -> ByteString -> Endpoint)
-> Lens Endpoint Endpoint ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Endpoint -> ByteString
_endpointHost (\Endpoint
s ByteString
a -> Endpoint
s {$sel:_endpointHost:Endpoint :: ByteString
_endpointHost = ByteString
a})

endpointSecure :: Lens' Endpoint Bool
endpointSecure :: (Bool -> f Bool) -> Endpoint -> f Endpoint
endpointSecure = (Endpoint -> Bool)
-> (Endpoint -> Bool -> Endpoint)
-> Lens Endpoint Endpoint Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Endpoint -> Bool
_endpointSecure (\Endpoint
s Bool
a -> Endpoint
s {$sel:_endpointSecure:Endpoint :: Bool
_endpointSecure = Bool
a})

endpointPort :: Lens' Endpoint Int
endpointPort :: (Int -> f Int) -> Endpoint -> f Endpoint
endpointPort = (Endpoint -> Int)
-> (Endpoint -> Int -> Endpoint) -> Lens Endpoint Endpoint Int Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Endpoint -> Int
_endpointPort (\Endpoint
s Int
a -> Endpoint
s {$sel:_endpointPort:Endpoint :: Int
_endpointPort = Int
a})

endpointScope :: Lens' Endpoint ByteString
endpointScope :: (ByteString -> f ByteString) -> Endpoint -> f Endpoint
endpointScope = (Endpoint -> ByteString)
-> (Endpoint -> ByteString -> Endpoint)
-> Lens Endpoint Endpoint ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Endpoint -> ByteString
_endpointScope (\Endpoint
s ByteString
a -> Endpoint
s {$sel:_endpointScope:Endpoint :: ByteString
_endpointScope = ByteString
a})

data LogLevel
  = -- | Info messages supplied by the user - this level is not emitted by the library.
    Info
  | -- | Error messages only.
    Error
  | -- | Useful debug information + info + error levels.
    Debug
  | -- | Includes potentially sensitive signing metadata, and non-streaming response bodies.
    Trace
  deriving stock (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, (forall x. LogLevel -> Rep LogLevel x)
-> (forall x. Rep LogLevel x -> LogLevel) -> Generic LogLevel
forall x. Rep LogLevel x -> LogLevel
forall x. LogLevel -> Rep LogLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogLevel x -> LogLevel
$cfrom :: forall x. LogLevel -> Rep LogLevel x
Generic)

instance FromText LogLevel where
  fromText :: Text -> Either String LogLevel
fromText = \case
    Text
"info" -> LogLevel -> Either String LogLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
Info
    Text
"error" -> LogLevel -> Either String LogLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
Error
    Text
"debug" -> LogLevel -> Either String LogLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
Debug
    Text
"trace" -> LogLevel -> Either String LogLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
Trace
    Text
other -> String -> Either String LogLevel
forall a b. a -> Either a b
Left (String
"Failure parsing LogLevel from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
other)

instance ToText LogLevel where
  toText :: LogLevel -> Text
toText = \case
    LogLevel
Info -> Text
"info"
    LogLevel
Error -> Text
"error"
    LogLevel
Debug -> Text
"debug"
    LogLevel
Trace -> Text
"trace"

instance ToByteString LogLevel

-- | A function threaded through various request and serialisation routines
-- to log informational and debug messages.
type Logger = LogLevel -> ByteStringBuilder -> IO ()

-- | Constants and predicates used to create a 'RetryPolicy'.
data Retry = Exponential
  { Retry -> Double
_retryBase :: Double,
    Retry -> Int
_retryGrowth :: Int,
    Retry -> Int
_retryAttempts :: Int,
    -- | Returns a descriptive name for logging
    -- if the request should be retried.
    Retry -> ServiceError -> Maybe Text
_retryCheck :: 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
$cto :: forall x. Rep Retry x -> Retry
$cfrom :: forall x. Retry -> Rep Retry x
Generic)

exponentBase :: Lens' Retry Double
exponentBase :: (Double -> f Double) -> Retry -> f Retry
exponentBase = (Retry -> Double)
-> (Retry -> Double -> Retry) -> Lens Retry Retry Double Double
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Retry -> Double
_retryBase (\Retry
s Double
a -> Retry
s {$sel:_retryBase:Exponential :: Double
_retryBase = Double
a})

exponentGrowth :: Lens' Retry Int
exponentGrowth :: (Int -> f Int) -> Retry -> f Retry
exponentGrowth = (Retry -> Int)
-> (Retry -> Int -> Retry) -> Lens Retry Retry Int Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Retry -> Int
_retryGrowth (\Retry
s Int
a -> Retry
s {$sel:_retryGrowth:Exponential :: Int
_retryGrowth = Int
a})

retryAttempts :: Lens' Retry Int
retryAttempts :: (Int -> f Int) -> Retry -> f Retry
retryAttempts = (Retry -> Int)
-> (Retry -> Int -> Retry) -> Lens Retry Retry Int Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Retry -> Int
_retryAttempts (\Retry
s Int
a -> Retry
s {$sel:_retryAttempts:Exponential :: Int
_retryAttempts = Int
a})

retryCheck :: Lens' Retry (ServiceError -> Maybe Text)
retryCheck :: ((ServiceError -> Maybe Text) -> f (ServiceError -> Maybe Text))
-> Retry -> f Retry
retryCheck = (Retry -> ServiceError -> Maybe Text)
-> (Retry -> (ServiceError -> Maybe Text) -> Retry)
-> Lens
     Retry
     Retry
     (ServiceError -> Maybe Text)
     (ServiceError -> Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Retry -> ServiceError -> Maybe Text
_retryCheck (\Retry
s ServiceError -> Maybe Text
a -> Retry
s {$sel:_retryCheck:Exponential :: ServiceError -> Maybe Text
_retryCheck = ServiceError -> Maybe Text
a})

-- | 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
  { Signed a -> Meta
signedMeta :: Meta,
    Signed a -> ClientRequest
signedRequest :: ClientRequest
  }

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

data Signer = Signer
  { Signer -> forall a. Algorithm a
signerSign :: forall a. Algorithm a,
    Signer -> forall a. Seconds -> Algorithm a
signerPresign :: forall a. Seconds -> Algorithm a
  }

-- | Attributes and functions specific to an AWS service.
data Service = Service
  { Service -> Abbrev
_serviceAbbrev :: Abbrev,
    Service -> Signer
_serviceSigner :: Signer,
    Service -> ByteString
_serviceSigningName :: ByteString,
    Service -> ByteString
_serviceVersion :: ByteString,
    Service -> ByteString
_serviceEndpointPrefix :: ByteString,
    Service -> Region -> Endpoint
_serviceEndpoint :: (Region -> Endpoint),
    Service -> Maybe Seconds
_serviceTimeout :: (Maybe Seconds),
    Service -> Status -> Bool
_serviceCheck :: (Status -> Bool),
    Service -> Status -> [Header] -> ByteStringLazy -> Error
_serviceError :: (Status -> [Header] -> ByteStringLazy -> Error),
    Service -> Retry
_serviceRetry :: 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
$cto :: forall x. Rep Service x -> Service
$cfrom :: forall x. Service -> Rep Service x
Generic)

serviceSigner :: Lens' Service Signer
serviceSigner :: (Signer -> f Signer) -> Service -> f Service
serviceSigner = (Service -> Signer)
-> (Service -> Signer -> Service)
-> Lens Service Service Signer Signer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Service -> Signer
_serviceSigner (\Service
s Signer
a -> Service
s {$sel:_serviceSigner:Service :: Signer
_serviceSigner = Signer
a})

serviceEndpoint :: Setter' Service Endpoint
serviceEndpoint :: (Endpoint -> f Endpoint) -> Service -> f Service
serviceEndpoint = ((Endpoint -> Endpoint) -> Service -> Service)
-> (Endpoint -> f Endpoint) -> Service -> f Service
forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
Lens.sets (\Endpoint -> Endpoint
f Service
s -> Service
s {$sel:_serviceEndpoint:Service :: Region -> Endpoint
_serviceEndpoint = \Region
r -> Endpoint -> Endpoint
f (Service -> Region -> Endpoint
_serviceEndpoint Service
s Region
r)})

serviceTimeout :: Lens' Service (Maybe Seconds)
serviceTimeout :: (Maybe Seconds -> f (Maybe Seconds)) -> Service -> f Service
serviceTimeout = (Service -> Maybe Seconds)
-> (Service -> Maybe Seconds -> Service)
-> Lens Service Service (Maybe Seconds) (Maybe Seconds)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Service -> Maybe Seconds
_serviceTimeout (\Service
s Maybe Seconds
a -> Service
s {$sel:_serviceTimeout:Service :: Maybe Seconds
_serviceTimeout = Maybe Seconds
a})

serviceCheck :: Lens' Service (Status -> Bool)
serviceCheck :: ((Status -> Bool) -> f (Status -> Bool)) -> Service -> f Service
serviceCheck = (Service -> Status -> Bool)
-> (Service -> (Status -> Bool) -> Service)
-> Lens Service Service (Status -> Bool) (Status -> Bool)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Service -> Status -> Bool
_serviceCheck (\Service
s Status -> Bool
a -> Service
s {$sel:_serviceCheck:Service :: Status -> Bool
_serviceCheck = Status -> Bool
a})

serviceRetry :: Lens' Service Retry
serviceRetry :: (Retry -> f Retry) -> Service -> f Service
serviceRetry = (Service -> Retry)
-> (Service -> Retry -> Service)
-> Lens Service Service Retry Retry
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Service -> Retry
_serviceRetry (\Service
s Retry
a -> Service
s {$sel:_serviceRetry:Service :: Retry
_serviceRetry = Retry
a})

-- | An unsigned request.
data Request a = Request
  { Request a -> Service
_requestService :: Service,
    Request a -> StdMethod
_requestMethod :: StdMethod,
    Request a -> RawPath
_requestPath :: RawPath,
    Request a -> QueryString
_requestQuery :: QueryString,
    Request a -> [Header]
_requestHeaders :: [Header],
    Request a -> RequestBody
_requestBody :: 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
$cto :: forall a x. Rep (Request a) x -> Request a
$cfrom :: forall a x. Request a -> Rep (Request a) x
Generic)

requestService :: Lens' (Request a) Service
requestService :: (Service -> f Service) -> Request a -> f (Request a)
requestService = (Request a -> Service)
-> (Request a -> Service -> Request a)
-> Lens (Request a) (Request a) Service Service
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Request a -> Service
forall a. Request a -> Service
_requestService (\Request a
s Service
a -> Request a
s {$sel:_requestService:Request :: Service
_requestService = Service
a})

requestBody :: Lens' (Request a) RequestBody
requestBody :: (RequestBody -> f RequestBody) -> Request a -> f (Request a)
requestBody = (Request a -> RequestBody)
-> (Request a -> RequestBody -> Request a)
-> Lens (Request a) (Request a) RequestBody RequestBody
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Request a -> RequestBody
forall a. Request a -> RequestBody
_requestBody (\Request a
s RequestBody
a -> Request a
s {$sel:_requestBody:Request :: RequestBody
_requestBody = RequestBody
a})

requestHeaders :: Lens' (Request a) [Header]
requestHeaders :: ([Header] -> f [Header]) -> Request a -> f (Request a)
requestHeaders = (Request a -> [Header])
-> (Request a -> [Header] -> Request a)
-> Lens (Request a) (Request a) [Header] [Header]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Request a -> [Header]
forall a. Request a -> [Header]
_requestHeaders (\Request a
s [Header]
a -> Request a
s {$sel:_requestHeaders:Request :: [Header]
_requestHeaders = [Header]
a})

requestMethod :: Lens' (Request a) StdMethod
requestMethod :: (StdMethod -> f StdMethod) -> Request a -> f (Request a)
requestMethod = (Request a -> StdMethod)
-> (Request a -> StdMethod -> Request a)
-> Lens (Request a) (Request a) StdMethod StdMethod
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Request a -> StdMethod
forall a. Request a -> StdMethod
_requestMethod (\Request a
s StdMethod
a -> Request a
s {$sel:_requestMethod:Request :: StdMethod
_requestMethod = StdMethod
a})

requestPath :: Lens' (Request a) RawPath
requestPath :: (RawPath -> f RawPath) -> Request a -> f (Request a)
requestPath = (Request a -> RawPath)
-> (Request a -> RawPath -> Request a)
-> Lens (Request a) (Request a) RawPath RawPath
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Request a -> RawPath
forall a. Request a -> RawPath
_requestPath (\Request a
s RawPath
a -> Request a
s {$sel:_requestPath:Request :: RawPath
_requestPath = RawPath
a})

requestQuery :: Lens' (Request a) QueryString
requestQuery :: (QueryString -> f QueryString) -> Request a -> f (Request a)
requestQuery = (Request a -> QueryString)
-> (Request a -> QueryString -> Request a)
-> Lens (Request a) (Request a) QueryString QueryString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens Request a -> QueryString
forall a. Request a -> QueryString
_requestQuery (\Request a
s QueryString
a -> Request a
s {$sel:_requestQuery:Request :: QueryString
_requestQuery = QueryString
a})

requestSign :: Algorithm a
requestSign :: Algorithm a
requestSign Request a
x = Signer -> Algorithm a
Signer -> forall a. Algorithm a
signerSign (Service -> Signer
_serviceSigner (Request a -> Service
forall a. Request a -> Service
_requestService Request a
x)) Request a
x

requestPresign :: Seconds -> Algorithm a
requestPresign :: Seconds -> Algorithm a
requestPresign Seconds
ex Request a
x = Signer -> Seconds -> Algorithm a
Signer -> forall a. Seconds -> Algorithm a
signerPresign (Service -> Signer
_serviceSigner (Request a -> Service
forall a. Request a -> Service
_requestService Request a
x)) Seconds
ex Request a
x

-- | Create an unsigned 'ClientRequest'. You will almost never need to do this.
requestUnsigned :: Request a -> Region -> ClientRequest
requestUnsigned :: Request a -> Region -> ClientRequest
requestUnsigned Request {[Header]
StdMethod
QueryString
RawPath
RequestBody
Service
_requestBody :: RequestBody
_requestHeaders :: [Header]
_requestQuery :: QueryString
_requestPath :: RawPath
_requestMethod :: StdMethod
_requestService :: Service
$sel:_requestBody:Request :: forall a. Request a -> RequestBody
$sel:_requestHeaders:Request :: forall a. Request a -> [Header]
$sel:_requestQuery:Request :: forall a. Request a -> QueryString
$sel:_requestPath:Request :: forall a. Request a -> RawPath
$sel:_requestMethod:Request :: forall a. Request a -> StdMethod
$sel:_requestService:Request :: forall a. Request a -> Service
..} Region
r =
  (Endpoint -> Maybe Seconds -> ClientRequest
newClientRequest Endpoint
end Maybe Seconds
_serviceTimeout)
    { method :: ByteString
Client.method = StdMethod -> ByteString
forall a. ToByteString a => a -> ByteString
toBS StdMethod
_requestMethod,
      path :: ByteString
Client.path = EscapedPath -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (RawPath -> EscapedPath
forall (a :: Encoding). Path a -> EscapedPath
escapePath RawPath
_requestPath),
      queryString :: ByteString
Client.queryString = QueryString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS QueryString
_requestQuery,
      requestHeaders :: [Header]
Client.requestHeaders = [Header]
_requestHeaders,
      requestBody :: RequestBody
Client.requestBody = RequestBody -> RequestBody
toRequestBody RequestBody
_requestBody
    }
  where
    end :: Endpoint
end = Region -> Endpoint
_serviceEndpoint Region
r
    Service {Maybe Seconds
ByteString
Signer
Retry
Abbrev
Status -> Bool
Status -> [Header] -> ByteStringLazy -> Error
Region -> Endpoint
_serviceRetry :: Retry
_serviceError :: Status -> [Header] -> ByteStringLazy -> Error
_serviceCheck :: Status -> Bool
_serviceEndpointPrefix :: ByteString
_serviceVersion :: ByteString
_serviceSigningName :: ByteString
_serviceSigner :: Signer
_serviceAbbrev :: Abbrev
_serviceEndpoint :: Region -> Endpoint
_serviceTimeout :: Maybe Seconds
$sel:_serviceRetry:Service :: Service -> Retry
$sel:_serviceError:Service :: Service -> Status -> [Header] -> ByteStringLazy -> Error
$sel:_serviceCheck:Service :: Service -> Status -> Bool
$sel:_serviceTimeout:Service :: Service -> Maybe Seconds
$sel:_serviceEndpoint:Service :: Service -> Region -> Endpoint
$sel:_serviceEndpointPrefix:Service :: Service -> ByteString
$sel:_serviceVersion:Service :: Service -> ByteString
$sel:_serviceSigningName:Service :: Service -> ByteString
$sel:_serviceSigner:Service :: Service -> Signer
$sel:_serviceAbbrev:Service :: Service -> Abbrev
..} = Service
_requestService

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

  request :: a -> Request a
  response ::
    MonadResource m =>
    Logger ->
    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
/= :: AccessKey -> AccessKey -> Bool
$c/= :: AccessKey -> AccessKey -> Bool
== :: AccessKey -> AccessKey -> Bool
$c== :: 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
showList :: [AccessKey] -> ShowS
$cshowList :: [AccessKey] -> ShowS
show :: AccessKey -> String
$cshow :: AccessKey -> String
showsPrec :: Int -> AccessKey -> ShowS
$cshowsPrec :: Int -> AccessKey -> ShowS
Show, ReadPrec [AccessKey]
ReadPrec AccessKey
Int -> ReadS AccessKey
ReadS [AccessKey]
(Int -> ReadS AccessKey)
-> ReadS [AccessKey]
-> ReadPrec AccessKey
-> ReadPrec [AccessKey]
-> Read AccessKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AccessKey]
$creadListPrec :: ReadPrec [AccessKey]
readPrec :: ReadPrec AccessKey
$creadPrec :: ReadPrec AccessKey
readList :: ReadS [AccessKey]
$creadList :: ReadS [AccessKey]
readsPrec :: Int -> ReadS AccessKey
$creadsPrec :: Int -> ReadS AccessKey
Read, (forall x. 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
$cto :: forall x. Rep AccessKey x -> AccessKey
$cfrom :: forall x. AccessKey -> Rep AccessKey x
Generic)
  deriving newtype
    ( String -> AccessKey
(String -> AccessKey) -> IsString AccessKey
forall a. (String -> a) -> IsString a
fromString :: String -> AccessKey
$cfromString :: String -> AccessKey
IsString,
      AccessKey -> Text
(AccessKey -> Text) -> ToText AccessKey
forall a. (a -> Text) -> ToText a
toText :: AccessKey -> Text
$ctoText :: AccessKey -> Text
ToText,
      Text -> Either String AccessKey
(Text -> Either String AccessKey) -> FromText AccessKey
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String AccessKey
$cfromText :: Text -> Either String AccessKey
FromText,
      AccessKey -> ByteStringBuilder
(AccessKey -> ByteStringBuilder) -> ToLog AccessKey
forall a. (a -> ByteStringBuilder) -> ToLog a
build :: AccessKey -> ByteStringBuilder
$cbuild :: AccessKey -> ByteStringBuilder
ToLog,
      AccessKey -> ByteString
(AccessKey -> ByteString) -> ToByteString AccessKey
forall a. (a -> ByteString) -> ToByteString a
toBS :: AccessKey -> ByteString
$ctoBS :: AccessKey -> ByteString
ToByteString,
      AccessKey -> QueryString
(AccessKey -> QueryString) -> ToQuery AccessKey
forall a. (a -> QueryString) -> ToQuery a
toQuery :: AccessKey -> QueryString
$ctoQuery :: AccessKey -> QueryString
ToQuery,
      [Node] -> Either String AccessKey
([Node] -> Either String AccessKey) -> FromXML AccessKey
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String AccessKey
$cparseXML :: [Node] -> Either String AccessKey
FromXML,
      AccessKey -> XML
(AccessKey -> XML) -> ToXML AccessKey
forall a. (a -> XML) -> ToXML a
toXML :: AccessKey -> XML
$ctoXML :: AccessKey -> XML
ToXML,
      Int -> AccessKey -> Int
AccessKey -> Int
(Int -> AccessKey -> Int)
-> (AccessKey -> Int) -> Hashable AccessKey
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AccessKey -> Int
$chash :: AccessKey -> Int
hashWithSalt :: Int -> AccessKey -> Int
$chashWithSalt :: Int -> AccessKey -> Int
Hashable,
      AccessKey -> ()
(AccessKey -> ()) -> NFData AccessKey
forall a. (a -> ()) -> NFData a
rnf :: AccessKey -> ()
$crnf :: 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"

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

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

-- | The AuthN/AuthZ credential environment.
data AuthEnv = AuthEnv
  { AuthEnv -> AccessKey
_authAccessKeyId :: AccessKey,
    AuthEnv -> Sensitive SecretKey
_authSecretAccessKey :: (Sensitive SecretKey),
    AuthEnv -> Maybe (Sensitive SessionToken)
_authSessionToken :: Maybe (Sensitive SessionToken),
    AuthEnv -> Maybe ISO8601
_authExpiration :: 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
/= :: AuthEnv -> AuthEnv -> Bool
$c/= :: AuthEnv -> AuthEnv -> Bool
== :: AuthEnv -> AuthEnv -> Bool
$c== :: 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
showList :: [AuthEnv] -> ShowS
$cshowList :: [AuthEnv] -> ShowS
show :: AuthEnv -> String
$cshow :: AuthEnv -> String
showsPrec :: Int -> AuthEnv -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep AuthEnv x -> AuthEnv
$cfrom :: forall x. AuthEnv -> Rep AuthEnv x
Generic)
  deriving anyclass (AuthEnv -> ()
(AuthEnv -> ()) -> NFData AuthEnv
forall a. (a -> ()) -> NFData a
rnf :: AuthEnv -> ()
$crnf :: AuthEnv -> ()
NFData)

instance ToLog AuthEnv where
  build :: AuthEnv -> ByteStringBuilder
build AuthEnv {Maybe ISO8601
Maybe (Sensitive SessionToken)
Sensitive SecretKey
AccessKey
_authExpiration :: Maybe ISO8601
_authSessionToken :: Maybe (Sensitive SessionToken)
_authSecretAccessKey :: Sensitive SecretKey
_authAccessKeyId :: AccessKey
$sel:_authExpiration:AuthEnv :: AuthEnv -> Maybe ISO8601
$sel:_authSessionToken:AuthEnv :: AuthEnv -> Maybe (Sensitive SessionToken)
$sel:_authSecretAccessKey:AuthEnv :: AuthEnv -> Sensitive SecretKey
$sel:_authAccessKeyId:AuthEnv :: AuthEnv -> AccessKey
..} =
    [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
_authAccessKeyId,
        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
_authSecretAccessKey,
        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)
_authSessionToken,
        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 (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). Iso' (Time a) UTCTime
_Time) Maybe ISO8601
_authExpiration),
        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 -> Text -> Parser AccessKey
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"AccessKeyId"
      Parser
  (Sensitive SecretKey
   -> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Parser (Sensitive SecretKey)
-> Parser
     (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Sensitive SecretKey)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"SecretAccessKey"
      Parser (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> Parser (Maybe (Sensitive SessionToken))
-> Parser (Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe (Sensitive SessionToken))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Token"
      Parser (Maybe ISO8601 -> AuthEnv)
-> Parser (Maybe ISO8601) -> Parser AuthEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe ISO8601)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 (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 (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 (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"

-- | The access key ID that identifies the temporary security credentials.
authAccessKeyId :: Lens' AuthEnv AccessKey
authAccessKeyId :: (AccessKey -> f AccessKey) -> AuthEnv -> f AuthEnv
authAccessKeyId =
  (AuthEnv -> AccessKey)
-> (AuthEnv -> AccessKey -> AuthEnv)
-> Lens AuthEnv AuthEnv AccessKey AccessKey
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AuthEnv -> AccessKey
_authAccessKeyId (\AuthEnv
s AccessKey
a -> AuthEnv
s {$sel:_authAccessKeyId:AuthEnv :: AccessKey
_authAccessKeyId = AccessKey
a})

-- | The secret access key that can be used to sign requests.
authSecretAccessKey :: Lens' AuthEnv SecretKey
authSecretAccessKey :: (SecretKey -> f SecretKey) -> AuthEnv -> f AuthEnv
authSecretAccessKey =
  (AuthEnv -> Sensitive SecretKey)
-> (AuthEnv -> Sensitive SecretKey -> AuthEnv)
-> Lens AuthEnv AuthEnv (Sensitive SecretKey) (Sensitive SecretKey)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AuthEnv -> Sensitive SecretKey
_authSecretAccessKey (\AuthEnv
s Sensitive SecretKey
a -> AuthEnv
s {$sel:_authSecretAccessKey:AuthEnv :: Sensitive SecretKey
_authSecretAccessKey = Sensitive SecretKey
a})
    ((Sensitive SecretKey -> f (Sensitive SecretKey))
 -> AuthEnv -> f AuthEnv)
-> ((SecretKey -> f SecretKey)
    -> Sensitive SecretKey -> f (Sensitive SecretKey))
-> (SecretKey -> f SecretKey)
-> AuthEnv
-> f AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SecretKey -> f SecretKey)
-> Sensitive SecretKey -> f (Sensitive SecretKey)
forall a. Iso' (Sensitive a) a
_Sensitive

-- | The token that users must pass to the service API to use the temporary
-- credentials.
authSessionToken :: Lens' AuthEnv (Maybe SessionToken)
authSessionToken :: (Maybe SessionToken -> f (Maybe SessionToken))
-> AuthEnv -> f AuthEnv
authSessionToken =
  (AuthEnv -> Maybe (Sensitive SessionToken))
-> (AuthEnv -> Maybe (Sensitive SessionToken) -> AuthEnv)
-> Lens
     AuthEnv
     AuthEnv
     (Maybe (Sensitive SessionToken))
     (Maybe (Sensitive SessionToken))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AuthEnv -> Maybe (Sensitive SessionToken)
_authSessionToken (\AuthEnv
s Maybe (Sensitive SessionToken)
a -> AuthEnv
s {$sel:_authSessionToken:AuthEnv :: Maybe (Sensitive SessionToken)
_authSessionToken = Maybe (Sensitive SessionToken)
a})
    ((Maybe (Sensitive SessionToken)
  -> f (Maybe (Sensitive SessionToken)))
 -> AuthEnv -> f AuthEnv)
-> ((Maybe SessionToken -> f (Maybe SessionToken))
    -> Maybe (Sensitive SessionToken)
    -> f (Maybe (Sensitive SessionToken)))
-> (Maybe SessionToken -> f (Maybe SessionToken))
-> AuthEnv
-> f AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso
  (Sensitive SessionToken)
  (Sensitive SessionToken)
  SessionToken
  SessionToken
-> Iso
     (Maybe (Sensitive SessionToken))
     (Maybe (Sensitive SessionToken))
     (Maybe SessionToken)
     (Maybe SessionToken)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping AnIso
  (Sensitive SessionToken)
  (Sensitive SessionToken)
  SessionToken
  SessionToken
forall a. Iso' (Sensitive a) a
_Sensitive

-- | The date on which the current credentials expire.
authExpiration :: Lens' AuthEnv (Maybe UTCTime)
authExpiration :: (Maybe UTCTime -> f (Maybe UTCTime)) -> AuthEnv -> f AuthEnv
authExpiration =
  (AuthEnv -> Maybe ISO8601)
-> (AuthEnv -> Maybe ISO8601 -> AuthEnv)
-> Lens AuthEnv AuthEnv (Maybe ISO8601) (Maybe ISO8601)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens AuthEnv -> Maybe ISO8601
_authExpiration (\AuthEnv
s Maybe ISO8601
a -> AuthEnv
s {$sel:_authExpiration:AuthEnv :: Maybe ISO8601
_authExpiration = Maybe ISO8601
a})
    ((Maybe ISO8601 -> f (Maybe ISO8601)) -> AuthEnv -> f AuthEnv)
-> ((Maybe UTCTime -> f (Maybe UTCTime))
    -> Maybe ISO8601 -> f (Maybe ISO8601))
-> (Maybe UTCTime -> f (Maybe UTCTime))
-> AuthEnv
-> f AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso ISO8601 ISO8601 UTCTime UTCTime
-> Iso
     (Maybe ISO8601) (Maybe ISO8601) (Maybe UTCTime) (Maybe UTCTime)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping AnIso ISO8601 ISO8601 UTCTime UTCTime
forall (a :: Format). Iso' (Time a) UTCTime
_Time

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

-- North America

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

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

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

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

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

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

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

-- South America

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

-- Europe

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

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

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

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

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

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

-- Middle East

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

-- Africa

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

-- Asia Pacific

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

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

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

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

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

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

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

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

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

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

-- | An integral value representing seconds.
newtype Seconds = Seconds Int
  deriving stock (Seconds -> Seconds -> Bool
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq, Eq Seconds
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
min :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmax :: Seconds -> Seconds -> Seconds
>= :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c< :: Seconds -> Seconds -> Bool
compare :: Seconds -> Seconds -> Ordering
$ccompare :: Seconds -> Seconds -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [Seconds]
$creadListPrec :: ReadPrec [Seconds]
readPrec :: ReadPrec Seconds
$creadPrec :: ReadPrec Seconds
readList :: ReadS [Seconds]
$creadList :: ReadS [Seconds]
readsPrec :: Int -> ReadS Seconds
$creadsPrec :: Int -> ReadS Seconds
Read, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show, (forall x. 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
$cto :: forall x. Rep Seconds x -> Seconds
$cfrom :: forall x. Seconds -> Rep Seconds x
Generic)
  deriving newtype
    ( Int -> Seconds
Seconds -> Int
Seconds -> [Seconds]
Seconds -> Seconds
Seconds -> Seconds -> [Seconds]
Seconds -> Seconds -> Seconds -> [Seconds]
(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
enumFromThenTo :: Seconds -> Seconds -> Seconds -> [Seconds]
$cenumFromThenTo :: Seconds -> Seconds -> Seconds -> [Seconds]
enumFromTo :: Seconds -> Seconds -> [Seconds]
$cenumFromTo :: Seconds -> Seconds -> [Seconds]
enumFromThen :: Seconds -> Seconds -> [Seconds]
$cenumFromThen :: Seconds -> Seconds -> [Seconds]
enumFrom :: Seconds -> [Seconds]
$cenumFrom :: Seconds -> [Seconds]
fromEnum :: Seconds -> Int
$cfromEnum :: Seconds -> Int
toEnum :: Int -> Seconds
$ctoEnum :: Int -> Seconds
pred :: Seconds -> Seconds
$cpred :: Seconds -> Seconds
succ :: Seconds -> Seconds
$csucc :: Seconds -> Seconds
Enum,
      Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(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
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num,
      Seconds
Seconds -> Seconds -> Bounded Seconds
forall a. a -> a -> Bounded a
maxBound :: Seconds
$cmaxBound :: Seconds
minBound :: Seconds
$cminBound :: Seconds
Bounded,
      Enum Seconds
Real Seconds
Real Seconds
-> Enum Seconds
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> (Seconds, Seconds))
-> (Seconds -> Seconds -> (Seconds, Seconds))
-> (Seconds -> Integer)
-> Integral Seconds
Seconds -> Integer
Seconds -> Seconds -> (Seconds, Seconds)
Seconds -> Seconds -> Seconds
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Seconds -> Integer
$ctoInteger :: Seconds -> Integer
divMod :: Seconds -> Seconds -> (Seconds, Seconds)
$cdivMod :: Seconds -> Seconds -> (Seconds, Seconds)
quotRem :: Seconds -> Seconds -> (Seconds, Seconds)
$cquotRem :: Seconds -> Seconds -> (Seconds, Seconds)
mod :: Seconds -> Seconds -> Seconds
$cmod :: Seconds -> Seconds -> Seconds
div :: Seconds -> Seconds -> Seconds
$cdiv :: Seconds -> Seconds -> Seconds
rem :: Seconds -> Seconds -> Seconds
$crem :: Seconds -> Seconds -> Seconds
quot :: Seconds -> Seconds -> Seconds
$cquot :: Seconds -> Seconds -> Seconds
$cp2Integral :: Enum Seconds
$cp1Integral :: Real Seconds
Integral,
      Num Seconds
Ord Seconds
Num Seconds -> Ord Seconds -> (Seconds -> Rational) -> Real Seconds
Seconds -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Seconds -> Rational
$ctoRational :: Seconds -> Rational
$cp2Real :: Ord Seconds
$cp1Real :: Num Seconds
Real,
      Seconds -> QueryString
(Seconds -> QueryString) -> ToQuery Seconds
forall a. (a -> QueryString) -> ToQuery a
toQuery :: Seconds -> QueryString
$ctoQuery :: Seconds -> QueryString
ToQuery,
      Seconds -> ByteString
(Seconds -> ByteString) -> ToByteString Seconds
forall a. (a -> ByteString) -> ToByteString a
toBS :: Seconds -> ByteString
$ctoBS :: Seconds -> ByteString
ToByteString,
      Seconds -> Text
(Seconds -> Text) -> ToText Seconds
forall a. (a -> Text) -> ToText a
toText :: Seconds -> Text
$ctoText :: Seconds -> Text
ToText,
      Text -> Either String Seconds
(Text -> Either String Seconds) -> FromText Seconds
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String Seconds
$cfromText :: Text -> Either String Seconds
FromText,
      Int -> Seconds -> Int
Seconds -> Int
(Int -> Seconds -> Int) -> (Seconds -> Int) -> Hashable Seconds
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Seconds -> Int
$chash :: Seconds -> Int
hashWithSalt :: Int -> Seconds -> Int
$chashWithSalt :: Int -> Seconds -> Int
Hashable,
      Seconds -> ()
(Seconds -> ()) -> NFData Seconds
forall a. (a -> ()) -> NFData a
rnf :: Seconds -> ()
$crnf :: Seconds -> ()
NFData
    )

instance ToLog Seconds where
  build :: Seconds -> ByteStringBuilder
build Seconds
s = Int -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build (Seconds -> Int
toSeconds Seconds
s) ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"s"

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

toMicroseconds :: Seconds -> Int
toMicroseconds :: Seconds -> Int
toMicroseconds = (Int
1000000 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (Seconds -> Int) -> Seconds -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Int
toSeconds