{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.EC2.Waiters
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Waiters where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.DescribeBundleTasks
import Amazonka.EC2.DescribeConversionTasks
import Amazonka.EC2.DescribeCustomerGateways
import Amazonka.EC2.DescribeExportTasks
import Amazonka.EC2.DescribeImages
import Amazonka.EC2.DescribeInstanceStatus
import Amazonka.EC2.DescribeInstances
import Amazonka.EC2.DescribeInternetGateways
import Amazonka.EC2.DescribeKeyPairs
import Amazonka.EC2.DescribeNatGateways
import Amazonka.EC2.DescribeNetworkInterfaces
import Amazonka.EC2.DescribeSecurityGroups
import Amazonka.EC2.DescribeSnapshots
import Amazonka.EC2.DescribeSpotInstanceRequests
import Amazonka.EC2.DescribeSubnets
import Amazonka.EC2.DescribeVolumes
import Amazonka.EC2.DescribeVpcPeeringConnections
import Amazonka.EC2.DescribeVpcs
import Amazonka.EC2.DescribeVpnConnections
import Amazonka.EC2.GetPasswordData
import Amazonka.EC2.Lens
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude

-- | Polls 'Amazonka.EC2.DescribeBundleTasks' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newBundleTaskComplete :: Core.Wait DescribeBundleTasks
newBundleTaskComplete :: Wait DescribeBundleTasks
newBundleTaskComplete =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"BundleTaskComplete",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeBundleTasks]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"complete"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeBundleTasksResponse (Maybe [BundleTask])
describeBundleTasksResponse_bundleTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' BundleTask BundleTaskState
bundleTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"failed"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeBundleTasksResponse (Maybe [BundleTask])
describeBundleTasksResponse_bundleTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' BundleTask BundleTaskState
bundleTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeConversionTasks' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newConversionTaskCancelled :: Core.Wait DescribeConversionTasks
newConversionTaskCancelled :: Wait DescribeConversionTasks
newConversionTaskCancelled =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ConversionTaskCancelled",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeConversionTasks]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"cancelled"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeConversionTasksResponse (Maybe [ConversionTask])
describeConversionTasksResponse_conversionTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ConversionTask (Maybe ConversionTaskState)
conversionTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeConversionTasks' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newConversionTaskCompleted :: Core.Wait DescribeConversionTasks
newConversionTaskCompleted :: Wait DescribeConversionTasks
newConversionTaskCompleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ConversionTaskCompleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeConversionTasks]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"completed"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeConversionTasksResponse (Maybe [ConversionTask])
describeConversionTasksResponse_conversionTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ConversionTask (Maybe ConversionTaskState)
conversionTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"cancelled"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeConversionTasksResponse (Maybe [ConversionTask])
describeConversionTasksResponse_conversionTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ConversionTask (Maybe ConversionTaskState)
conversionTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"cancelling"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeConversionTasksResponse (Maybe [ConversionTask])
describeConversionTasksResponse_conversionTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ConversionTask (Maybe ConversionTaskState)
conversionTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeConversionTasks' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newConversionTaskDeleted :: Core.Wait DescribeConversionTasks
newConversionTaskDeleted :: Wait DescribeConversionTasks
newConversionTaskDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ConversionTaskDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeConversionTasks]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"deleted"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeConversionTasksResponse (Maybe [ConversionTask])
describeConversionTasksResponse_conversionTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ConversionTask (Maybe ConversionTaskState)
conversionTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeCustomerGateways' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newCustomerGatewayAvailable :: Core.Wait DescribeCustomerGateways
newCustomerGatewayAvailable :: Wait DescribeCustomerGateways
newCustomerGatewayAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"CustomerGatewayAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeCustomerGateways]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeCustomerGatewaysResponse (Maybe [CustomerGateway])
describeCustomerGatewaysResponse_customerGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' CustomerGateway Text
customerGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleted"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeCustomerGatewaysResponse (Maybe [CustomerGateway])
describeCustomerGatewaysResponse_customerGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' CustomerGateway Text
customerGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleting"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeCustomerGatewaysResponse (Maybe [CustomerGateway])
describeCustomerGatewaysResponse_customerGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' CustomerGateway Text
customerGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeExportTasks' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newExportTaskCancelled :: Core.Wait DescribeExportTasks
newExportTaskCancelled :: Wait DescribeExportTasks
newExportTaskCancelled =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ExportTaskCancelled",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeExportTasks]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"cancelled"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeExportTasksResponse (Maybe [ExportTask])
describeExportTasksResponse_exportTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ExportTask ExportTaskState
exportTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeExportTasks' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newExportTaskCompleted :: Core.Wait DescribeExportTasks
newExportTaskCompleted :: Wait DescribeExportTasks
newExportTaskCompleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ExportTaskCompleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeExportTasks]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"completed"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeExportTasksResponse (Maybe [ExportTask])
describeExportTasksResponse_exportTasks
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ExportTask ExportTaskState
exportTask_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeImages' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newImageAvailable :: Core.Wait DescribeImages
newImageAvailable :: Wait DescribeImages
newImageAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ImageAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeImages]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    (Lens' DescribeImagesResponse (Maybe [Image])
describeImagesResponse_images forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Image ImageState
image_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deregistered"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    (Lens' DescribeImagesResponse (Maybe [Image])
describeImagesResponse_images forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Image ImageState
image_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeImages' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newImageExists :: Core.Wait DescribeImages
newImageExists :: Wait DescribeImages
newImageExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ImageExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeImages]
Core.acceptors =
        [ forall a b. Bool -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchNonEmpty
            Bool
Prelude.True
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeImagesResponse (Maybe [Image])
describeImagesResponse_images
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidAMIID.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInstances' every 5 seconds until a successful state is reached. An error is returned after 40 failed checks.
newInstanceExists :: Core.Wait DescribeInstances
newInstanceExists :: Wait DescribeInstances
newInstanceExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"InstanceExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor DescribeInstances]
Core.acceptors =
        [ forall a. Int -> Accept -> Acceptor a
Core.matchStatus Int
200 Accept
Core.AcceptSuccess,
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidInstanceIDNotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInstances' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newInstanceRunning :: Core.Wait DescribeInstances
newInstanceRunning :: Wait DescribeInstances
newInstanceRunning =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"InstanceRunning",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeInstances]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"running"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"shutting-down"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"terminated"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"stopping"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidInstanceID.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInstanceStatus' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newInstanceStatusOk :: Core.Wait DescribeInstanceStatus
newInstanceStatusOk :: Wait DescribeInstanceStatus
newInstanceStatusOk =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"InstanceStatusOk",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeInstanceStatus]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ok"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstanceStatusResponse (Maybe [InstanceStatus])
describeInstanceStatusResponse_instanceStatuses
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceStatus (Maybe InstanceStatusSummary)
instanceStatus_instanceStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceStatusSummary SummaryStatus
instanceStatusSummary_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidInstanceID.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInstances' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newInstanceStopped :: Core.Wait DescribeInstances
newInstanceStopped :: Wait DescribeInstances
newInstanceStopped =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"InstanceStopped",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeInstances]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"stopped"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"pending"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"terminated"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInstances' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newInstanceTerminated :: Core.Wait DescribeInstances
newInstanceTerminated :: Wait DescribeInstances
newInstanceTerminated =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"InstanceTerminated",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeInstances]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"terminated"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"pending"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"stopping"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstancesResponse (Maybe [Reservation])
describeInstancesResponse_reservations
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                  ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                      (Lens' Reservation (Maybe [Instance])
reservation_instances forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Instance InstanceState
instance_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceState InstanceStateName
instanceState_name
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInternetGateways' every 5 seconds until a successful state is reached. An error is returned after 6 failed checks.
newInternetGatewayExists :: Core.Wait DescribeInternetGateways
newInternetGatewayExists :: Wait DescribeInternetGateways
newInternetGatewayExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"InternetGatewayExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
6,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor DescribeInternetGateways]
Core.acceptors =
        [ forall a b. Bool -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchNonEmpty
            Bool
Prelude.True
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInternetGatewaysResponse (Maybe [InternetGateway])
describeInternetGatewaysResponse_internetGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InternetGateway Text
internetGateway_internetGatewayId
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidInternetGateway.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeKeyPairs' every 5 seconds until a successful state is reached. An error is returned after 6 failed checks.
newKeyPairExists :: Core.Wait DescribeKeyPairs
newKeyPairExists :: Wait DescribeKeyPairs
newKeyPairExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"KeyPairExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
6,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor DescribeKeyPairs]
Core.acceptors =
        [ forall a b. Bool -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchNonEmpty
            Bool
Prelude.True
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeKeyPairsResponse (Maybe [KeyPairInfo])
describeKeyPairsResponse_keyPairs
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' KeyPairInfo (Maybe Text)
keyPairInfo_keyName
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidKeyPair.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeNatGateways' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newNatGatewayAvailable :: Core.Wait DescribeNatGateways
newNatGatewayAvailable :: Wait DescribeNatGateways
newNatGatewayAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"NatGatewayAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeNatGateways]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeNatGatewaysResponse (Maybe [NatGateway])
describeNatGatewaysResponse_natGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' NatGateway (Maybe NatGatewayState)
natGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"failed"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeNatGatewaysResponse (Maybe [NatGateway])
describeNatGatewaysResponse_natGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' NatGateway (Maybe NatGatewayState)
natGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleting"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeNatGatewaysResponse (Maybe [NatGateway])
describeNatGatewaysResponse_natGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' NatGateway (Maybe NatGatewayState)
natGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleted"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeNatGatewaysResponse (Maybe [NatGateway])
describeNatGatewaysResponse_natGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' NatGateway (Maybe NatGatewayState)
natGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"NatGatewayNotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeNatGateways' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newNatGatewayDeleted :: Core.Wait DescribeNatGateways
newNatGatewayDeleted :: Wait DescribeNatGateways
newNatGatewayDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"NatGatewayDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeNatGateways]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"deleted"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeNatGatewaysResponse (Maybe [NatGateway])
describeNatGatewaysResponse_natGateways
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' NatGateway (Maybe NatGatewayState)
natGateway_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"NatGatewayNotFound"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeNetworkInterfaces' every 20 seconds until a successful state is reached. An error is returned after 10 failed checks.
newNetworkInterfaceAvailable :: Core.Wait DescribeNetworkInterfaces
newNetworkInterfaceAvailable :: Wait DescribeNetworkInterfaces
newNetworkInterfaceAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"NetworkInterfaceAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
10,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
20,
      $sel:acceptors:Wait :: [Acceptor DescribeNetworkInterfaces]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeNetworkInterfacesResponse (Maybe [NetworkInterface])
describeNetworkInterfacesResponse_networkInterfaces
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' NetworkInterface (Maybe NetworkInterfaceStatus)
networkInterface_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidNetworkInterfaceID.NotFound"
            Accept
Core.AcceptFailure
        ]
    }

-- | Polls 'Amazonka.EC2.GetPasswordData' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newPasswordDataAvailable :: Core.Wait GetPasswordData
newPasswordDataAvailable :: Wait GetPasswordData
newPasswordDataAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"PasswordDataAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor GetPasswordData]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            Bool
Prelude.True
            Accept
Core.AcceptSuccess
            ( forall a. Fold a Text -> Fold a Bool
Core.nonEmptyText
                Lens' GetPasswordDataResponse Text
getPasswordDataResponse_passwordData
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeSecurityGroups' every 5 seconds until a successful state is reached. An error is returned after 6 failed checks.
newSecurityGroupExists :: Core.Wait DescribeSecurityGroups
newSecurityGroupExists :: Wait DescribeSecurityGroups
newSecurityGroupExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"SecurityGroupExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
6,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor DescribeSecurityGroups]
Core.acceptors =
        [ forall a b. Bool -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchNonEmpty
            Bool
Prelude.True
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeSecurityGroupsResponse (Maybe [SecurityGroup])
describeSecurityGroupsResponse_securityGroups
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SecurityGroup Text
securityGroup_groupId
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidGroup.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeSnapshots' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newSnapshotCompleted :: Core.Wait DescribeSnapshots
newSnapshotCompleted :: Wait DescribeSnapshots
newSnapshotCompleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"SnapshotCompleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeSnapshots]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"completed"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeSnapshotsResponse (Maybe [Snapshot])
describeSnapshotsResponse_snapshots
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Snapshot SnapshotState
snapshot_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"error"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeSnapshotsResponse (Maybe [Snapshot])
describeSnapshotsResponse_snapshots
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Snapshot SnapshotState
snapshot_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeSpotInstanceRequests' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newSpotInstanceRequestFulfilled :: Core.Wait DescribeSpotInstanceRequests
newSpotInstanceRequestFulfilled :: Wait DescribeSpotInstanceRequests
newSpotInstanceRequestFulfilled =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name =
        ByteString
"SpotInstanceRequestFulfilled",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeSpotInstanceRequests]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"fulfilled"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeSpotInstanceRequestsResponse (Maybe [SpotInstanceRequest])
describeSpotInstanceRequestsResponse_spotInstanceRequests
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceStatus (Maybe Text)
spotInstanceStatus_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"request-canceled-and-instance-running"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeSpotInstanceRequestsResponse (Maybe [SpotInstanceRequest])
describeSpotInstanceRequestsResponse_spotInstanceRequests
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceStatus (Maybe Text)
spotInstanceStatus_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"schedule-expired"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeSpotInstanceRequestsResponse (Maybe [SpotInstanceRequest])
describeSpotInstanceRequestsResponse_spotInstanceRequests
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceStatus (Maybe Text)
spotInstanceStatus_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"canceled-before-fulfillment"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeSpotInstanceRequestsResponse (Maybe [SpotInstanceRequest])
describeSpotInstanceRequestsResponse_spotInstanceRequests
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceStatus (Maybe Text)
spotInstanceStatus_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"bad-parameters"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeSpotInstanceRequestsResponse (Maybe [SpotInstanceRequest])
describeSpotInstanceRequestsResponse_spotInstanceRequests
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceStatus (Maybe Text)
spotInstanceStatus_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"system-error"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeSpotInstanceRequestsResponse (Maybe [SpotInstanceRequest])
describeSpotInstanceRequestsResponse_spotInstanceRequests
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' SpotInstanceStatus (Maybe Text)
spotInstanceStatus_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidSpotInstanceRequestID.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeSubnets' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newSubnetAvailable :: Core.Wait DescribeSubnets
newSubnetAvailable :: Wait DescribeSubnets
newSubnetAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"SubnetAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeSubnets]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeSubnetsResponse (Maybe [Subnet])
describeSubnetsResponse_subnets
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Subnet SubnetState
subnet_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeInstanceStatus' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newSystemStatusOk :: Core.Wait DescribeInstanceStatus
newSystemStatusOk :: Wait DescribeInstanceStatus
newSystemStatusOk =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"SystemStatusOk",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeInstanceStatus]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ok"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeInstanceStatusResponse (Maybe [InstanceStatus])
describeInstanceStatusResponse_instanceStatuses
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceStatus (Maybe InstanceStatusSummary)
instanceStatus_systemStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' InstanceStatusSummary SummaryStatus
instanceStatusSummary_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVolumes' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVolumeAvailable :: Core.Wait DescribeVolumes
newVolumeAvailable :: Wait DescribeVolumes
newVolumeAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VolumeAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVolumes]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Volume VolumeState
volume_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleted"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Volume VolumeState
volume_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVolumes' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVolumeDeleted :: Core.Wait DescribeVolumes
newVolumeDeleted :: Wait DescribeVolumes
newVolumeDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VolumeDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVolumes]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"deleted"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Volume VolumeState
volume_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidVolume.NotFound"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVolumes' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVolumeInUse :: Core.Wait DescribeVolumes
newVolumeInUse :: Wait DescribeVolumes
newVolumeInUse =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VolumeInUse",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVolumes]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"in-use"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Volume VolumeState
volume_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleted"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVolumesResponse (Maybe [Volume])
describeVolumesResponse_volumes
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Volume VolumeState
volume_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVpcs' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVpcAvailable :: Core.Wait DescribeVpcs
newVpcAvailable :: Wait DescribeVpcs
newVpcAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VpcAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVpcs]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    (Lens' DescribeVpcsResponse (Maybe [Vpc])
describeVpcsResponse_vpcs forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just)
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Vpc VpcState
vpc_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVpcs' every 1 seconds until a successful state is reached. An error is returned after 5 failed checks.
newVpcExists :: Core.Wait DescribeVpcs
newVpcExists :: Wait DescribeVpcs
newVpcExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VpcExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
5,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
1,
      $sel:acceptors:Wait :: [Acceptor DescribeVpcs]
Core.acceptors =
        [ forall a. Int -> Accept -> Acceptor a
Core.matchStatus Int
200 Accept
Core.AcceptSuccess,
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidVpcID.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVpcPeeringConnections' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVpcPeeringConnectionDeleted :: Core.Wait DescribeVpcPeeringConnections
newVpcPeeringConnectionDeleted :: Wait DescribeVpcPeeringConnections
newVpcPeeringConnectionDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name =
        ByteString
"VpcPeeringConnectionDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVpcPeeringConnections]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"deleted"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens'
  DescribeVpcPeeringConnectionsResponse
  (Maybe [VpcPeeringConnection])
describeVpcPeeringConnectionsResponse_vpcPeeringConnections
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' VpcPeeringConnection (Maybe VpcPeeringConnectionStateReason)
vpcPeeringConnection_status
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens'
  VpcPeeringConnectionStateReason
  (Maybe VpcPeeringConnectionStateReasonCode)
vpcPeeringConnectionStateReason_code
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidVpcPeeringConnectionID.NotFound"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVpcPeeringConnections' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVpcPeeringConnectionExists :: Core.Wait DescribeVpcPeeringConnections
newVpcPeeringConnectionExists :: Wait DescribeVpcPeeringConnections
newVpcPeeringConnectionExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VpcPeeringConnectionExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVpcPeeringConnections]
Core.acceptors =
        [ forall a. Int -> Accept -> Acceptor a
Core.matchStatus Int
200 Accept
Core.AcceptSuccess,
          forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"InvalidVpcPeeringConnectionID.NotFound"
            Accept
Core.AcceptRetry
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVpnConnections' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVpnConnectionAvailable :: Core.Wait DescribeVpnConnections
newVpnConnectionAvailable :: Wait DescribeVpnConnections
newVpnConnectionAvailable =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VpnConnectionAvailable",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVpnConnections]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"available"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVpnConnectionsResponse (Maybe [VpnConnection])
describeVpnConnectionsResponse_vpnConnections
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' VpnConnection VpnState
vpnConnection_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleting"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVpnConnectionsResponse (Maybe [VpnConnection])
describeVpnConnectionsResponse_vpnConnections
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' VpnConnection VpnState
vpnConnection_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"deleted"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVpnConnectionsResponse (Maybe [VpnConnection])
describeVpnConnectionsResponse_vpnConnections
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' VpnConnection VpnState
vpnConnection_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }

-- | Polls 'Amazonka.EC2.DescribeVpnConnections' every 15 seconds until a successful state is reached. An error is returned after 40 failed checks.
newVpnConnectionDeleted :: Core.Wait DescribeVpnConnections
newVpnConnectionDeleted :: Wait DescribeVpnConnections
newVpnConnectionDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"VpnConnectionDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
15,
      $sel:acceptors:Wait :: [Acceptor DescribeVpnConnections]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"deleted"
            Accept
Core.AcceptSuccess
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVpnConnectionsResponse (Maybe [VpnConnection])
describeVpnConnectionsResponse_vpnConnections
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' VpnConnection VpnState
vpnConnection_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            ),
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAny
            CI Text
"pending"
            Accept
Core.AcceptFailure
            ( forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
Lens.folding
                ( forall r s. Getting [r] s [r] -> s -> [r]
Lens.concatOf
                    ( Lens' DescribeVpnConnectionsResponse (Maybe [VpnConnection])
describeVpnConnectionsResponse_vpnConnections
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
                    )
                )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' VpnConnection VpnState
vpnConnection_state
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall a. ToText a => a -> CI Text
Data.toTextCI
            )
        ]
    }