-- |
-- Module      : Amazonka.Waiter
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : This Source Code Form is subject to the terms of
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Waiter
  ( -- * Types
    Acceptor,
    Accept (..),
    Wait (..),

    -- * Acceptors
    accept,

    -- * Matchers
    matchAll,
    matchAny,
    matchNonEmpty,
    matchError,
    matchStatus,

    -- * Util
    nonEmptyText,
  )
where

import Amazonka.Data
import Amazonka.Error (_HttpStatus)
import Amazonka.Lens
  ( Fold,
    allOf,
    anyOf,
    to,
    (^..),
    (^?),
  )
import Amazonka.Prelude
import Amazonka.Types
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Client

type Acceptor a = Request a -> Either Error (ClientResponse (AWSResponse a)) -> Maybe Accept

data Accept
  = AcceptSuccess
  | AcceptFailure
  | AcceptRetry
  deriving stock (Accept -> Accept -> Bool
(Accept -> Accept -> Bool)
-> (Accept -> Accept -> Bool) -> Eq Accept
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accept -> Accept -> Bool
$c/= :: Accept -> Accept -> Bool
== :: Accept -> Accept -> Bool
$c== :: Accept -> Accept -> Bool
Eq, Int -> Accept -> ShowS
[Accept] -> ShowS
Accept -> String
(Int -> Accept -> ShowS)
-> (Accept -> String) -> ([Accept] -> ShowS) -> Show Accept
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accept] -> ShowS
$cshowList :: [Accept] -> ShowS
show :: Accept -> String
$cshow :: Accept -> String
showsPrec :: Int -> Accept -> ShowS
$cshowsPrec :: Int -> Accept -> ShowS
Show)

instance ToLog Accept where
  build :: Accept -> ByteStringBuilder
build = \case
    Accept
AcceptSuccess -> ByteStringBuilder
"Success"
    Accept
AcceptFailure -> ByteStringBuilder
"Failure"
    Accept
AcceptRetry -> ByteStringBuilder
"Retry"

-- | Timing and acceptance criteria to check fulfillment of a remote operation.
data Wait a = Wait
  { Wait a -> ByteString
_waitName :: ByteString,
    Wait a -> Int
_waitAttempts :: Int,
    Wait a -> Seconds
_waitDelay :: Seconds,
    Wait a -> [Acceptor a]
_waitAcceptors :: [Acceptor a]
  }

accept :: Wait a -> Acceptor a
accept :: Wait a -> Acceptor a
accept Wait a
w Request a
rq Either Error (ClientResponse (AWSResponse a))
rs = [Accept] -> Maybe Accept
forall a. [a] -> Maybe a
listToMaybe ([Accept] -> Maybe Accept)
-> ([Acceptor a] -> [Accept]) -> [Acceptor a] -> Maybe Accept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Acceptor a -> Maybe Accept) -> [Acceptor a] -> [Accept]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Acceptor a
f -> Acceptor a
f Request a
rq Either Error (ClientResponse (AWSResponse a))
rs) ([Acceptor a] -> Maybe Accept) -> [Acceptor a] -> Maybe Accept
forall a b. (a -> b) -> a -> b
$ Wait a -> [Acceptor a]
forall a. Wait a -> [Acceptor a]
_waitAcceptors Wait a
w

matchAll :: Eq b => b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
matchAll :: b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
matchAll b
x Accept
a Fold (AWSResponse a) b
l = (AWSResponse a -> Bool) -> Accept -> Acceptor a
forall a. (AWSResponse a -> Bool) -> Accept -> Acceptor a
match (Getting All (AWSResponse a) b
-> (b -> Bool) -> AWSResponse a -> Bool
forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf Getting All (AWSResponse a) b
Fold (AWSResponse a) b
l (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x)) Accept
a

matchAny :: Eq b => b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
matchAny :: b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
matchAny b
x Accept
a Fold (AWSResponse a) b
l = (AWSResponse a -> Bool) -> Accept -> Acceptor a
forall a. (AWSResponse a -> Bool) -> Accept -> Acceptor a
match (Getting Any (AWSResponse a) b
-> (b -> Bool) -> AWSResponse a -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting Any (AWSResponse a) b
Fold (AWSResponse a) b
l (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x)) Accept
a

matchNonEmpty :: Bool -> Accept -> Fold (AWSResponse a) b -> Acceptor a
matchNonEmpty :: Bool -> Accept -> Fold (AWSResponse a) b -> Acceptor a
matchNonEmpty Bool
x Accept
a Fold (AWSResponse a) b
l = (AWSResponse a -> Bool) -> Accept -> Acceptor a
forall a. (AWSResponse a -> Bool) -> Accept -> Acceptor a
match (\AWSResponse a
rs -> [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (AWSResponse a
rs AWSResponse a -> Getting (Endo [b]) (AWSResponse a) b -> [b]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [b]) (AWSResponse a) b
Fold (AWSResponse a) b
l) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
x) Accept
a

matchStatus :: Int -> Accept -> Acceptor a
matchStatus :: Int -> Accept -> Acceptor a
matchStatus Int
x Accept
a Request a
_ = \case
  Right ClientResponse (AWSResponse a)
rs | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Status -> Int
forall a. Enum a => a -> Int
fromEnum (ClientResponse (AWSResponse a) -> Status
forall body. Response body -> Status
Client.responseStatus ClientResponse (AWSResponse a)
rs) -> Accept -> Maybe Accept
forall a. a -> Maybe a
Just Accept
a
  Left Error
e | Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Status -> Int
forall a. Enum a => a -> Int
fromEnum (Status -> Int) -> Maybe Status -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Error
e Error -> Getting (First Status) Error Status -> Maybe Status
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Status) Error Status
forall a. AsError a => Getting (First Status) a Status
_HttpStatus) -> Accept -> Maybe Accept
forall a. a -> Maybe a
Just Accept
a
  Either Error (ClientResponse (AWSResponse a))
_ -> Maybe Accept
forall a. Maybe a
Nothing

matchError :: ErrorCode -> Accept -> Acceptor a
matchError :: ErrorCode -> Accept -> Acceptor a
matchError ErrorCode
c Accept
a Request a
_ = \case
  Left Error
e | ErrorCode -> Maybe ErrorCode
forall a. a -> Maybe a
Just ErrorCode
c Maybe ErrorCode -> Maybe ErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== Error
e Error
-> Getting (First ErrorCode) Error ErrorCode -> Maybe ErrorCode
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ServiceError -> Const (First ErrorCode) ServiceError)
-> Error -> Const (First ErrorCode) Error
forall a. AsError a => Prism' a ServiceError
_ServiceError ((ServiceError -> Const (First ErrorCode) ServiceError)
 -> Error -> Const (First ErrorCode) Error)
-> ((ErrorCode -> Const (First ErrorCode) ErrorCode)
    -> ServiceError -> Const (First ErrorCode) ServiceError)
-> Getting (First ErrorCode) Error ErrorCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ErrorCode -> Const (First ErrorCode) ErrorCode)
-> ServiceError -> Const (First ErrorCode) ServiceError
Lens' ServiceError ErrorCode
serviceCode -> Accept -> Maybe Accept
forall a. a -> Maybe a
Just Accept
a
  Either Error (ClientResponse (AWSResponse a))
_ -> Maybe Accept
forall a. Maybe a
Nothing

match :: (AWSResponse a -> Bool) -> Accept -> Acceptor a
match :: (AWSResponse a -> Bool) -> Accept -> Acceptor a
match AWSResponse a -> Bool
f Accept
a Request a
_ = \case
  Right ClientResponse (AWSResponse a)
rs | AWSResponse a -> Bool
f (ClientResponse (AWSResponse a) -> AWSResponse a
forall body. Response body -> body
Client.responseBody ClientResponse (AWSResponse a)
rs) -> Accept -> Maybe Accept
forall a. a -> Maybe a
Just Accept
a
  Either Error (ClientResponse (AWSResponse a))
_ -> Maybe Accept
forall a. Maybe a
Nothing

nonEmptyText :: Fold a Text -> Fold a Bool
nonEmptyText :: Fold a Text -> Fold a Bool
nonEmptyText Fold a Text
f = (Text -> f Text) -> a -> f a
Fold a Text
f ((Text -> f Text) -> a -> f a)
-> ((Bool -> f Bool) -> Text -> f Text)
-> (Bool -> f Bool)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> (Bool -> f Bool) -> Text -> f Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Bool
Text.null