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

    -- ** Lenses
    wait_name,
    wait_attempts,
    wait_delay,
    wait_acceptors,

    -- * Acceptors
    accept,

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

    -- * Util
    nonEmptyText,
  )
where

import Amazonka.Core.Lens.Internal
  ( Fold,
    Lens,
    allOf,
    anyOf,
    to,
    (^..),
    (^?),
  )
import Amazonka.Data
import Amazonka.Error (_HttpStatus)
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
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
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
  { forall a. Wait a -> ByteString
name :: ByteString,
    forall a. Wait a -> Int
attempts :: Int,
    forall a. Wait a -> Seconds
delay :: Seconds,
    forall a. Wait a -> [Acceptor a]
acceptors :: [Acceptor a]
  }

{-# INLINE wait_name #-}
wait_name :: Lens' (Wait a) ByteString
wait_name :: forall a. Lens' (Wait a) ByteString
wait_name ByteString -> f ByteString
f w :: Wait a
w@Wait {ByteString
name :: ByteString
$sel:name:Wait :: forall a. Wait a -> ByteString
name} = ByteString -> f ByteString
f ByteString
name forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
name' -> Wait a
w {$sel:name:Wait :: ByteString
name = ByteString
name'}

{-# INLINE wait_attempts #-}
wait_attempts :: forall a. Lens' (Wait a) Int
wait_attempts :: forall a. Lens' (Wait a) Int
wait_attempts Int -> f Int
f w :: Wait a
w@Wait {Int
attempts :: Int
$sel:attempts:Wait :: forall a. Wait a -> Int
attempts} = Int -> f Int
f Int
attempts forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
attempts' -> (Wait a
w :: Wait a) {$sel:attempts:Wait :: Int
attempts = Int
attempts'}

{-# INLINE wait_delay #-}
wait_delay :: Lens' (Wait a) Seconds
wait_delay :: forall a. Lens' (Wait a) Seconds
wait_delay Seconds -> f Seconds
f w :: Wait a
w@Wait {Seconds
delay :: Seconds
$sel:delay:Wait :: forall a. Wait a -> Seconds
delay} = Seconds -> f Seconds
f Seconds
delay forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Seconds
delay' -> Wait a
w {$sel:delay:Wait :: Seconds
delay = Seconds
delay'}

{-# INLINE wait_acceptors #-}
wait_acceptors :: Lens (Wait a) (Wait b) [Acceptor a] [Acceptor b]
wait_acceptors :: forall a b. Lens (Wait a) (Wait b) [Acceptor a] [Acceptor b]
wait_acceptors [Acceptor a] -> f [Acceptor b]
f w :: Wait a
w@Wait {[Acceptor a]
acceptors :: [Acceptor a]
$sel:acceptors:Wait :: forall a. Wait a -> [Acceptor a]
acceptors} = [Acceptor a] -> f [Acceptor b]
f [Acceptor a]
acceptors forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Acceptor b]
acceptors' -> Wait a
w {$sel:acceptors:Wait :: [Acceptor b]
acceptors = [Acceptor b]
acceptors'}

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

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

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

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

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

matchError :: ErrorCode -> Accept -> Acceptor a
matchError :: forall a. ErrorCode -> Accept -> Acceptor a
matchError ErrorCode
c Accept
a Request a
_ = \case
  Left Error
e | forall a. a -> Maybe a
Just ErrorCode
c forall a. Eq a => a -> a -> Bool
== Error
e forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a. AsError a => Prism' a ServiceError
_ServiceError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ServiceError -> ErrorCode
code -> forall a. a -> Maybe a
Just Accept
a
  Either Error (ClientResponse (AWSResponse a))
_ -> forall a. Maybe a
Nothing

match :: (AWSResponse a -> Bool) -> Accept -> Acceptor a
match :: forall a. (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 (forall body. Response body -> body
Client.responseBody ClientResponse (AWSResponse a)
rs) -> forall a. a -> Maybe a
Just Accept
a
  Either Error (ClientResponse (AWSResponse a))
_ -> forall a. Maybe a
Nothing

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