{-# 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.EKS.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.EKS.Waiters where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EKS.DescribeAddon
import Amazonka.EKS.DescribeCluster
import Amazonka.EKS.DescribeFargateProfile
import Amazonka.EKS.DescribeNodegroup
import Amazonka.EKS.Lens
import Amazonka.EKS.Types
import qualified Amazonka.Prelude as Prelude

-- | Polls 'Amazonka.EKS.DescribeAddon' every 10 seconds until a successful state is reached. An error is returned after 60 failed checks.
newAddonActive :: Core.Wait DescribeAddon
newAddonActive :: Wait DescribeAddon
newAddonActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"AddonActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
60,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
10,
      $sel:acceptors:Wait :: [Acceptor DescribeAddon]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeAddonResponse (Maybe Addon)
describeAddonResponse_addon
                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' Addon (Maybe AddonStatus)
addon_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DEGRADED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeAddonResponse (Maybe Addon)
describeAddonResponse_addon
                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' Addon (Maybe AddonStatus)
addon_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribeAddonResponse (Maybe Addon)
describeAddonResponse_addon
                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' Addon (Maybe AddonStatus)
addon_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
            )
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeAddon' every 10 seconds until a successful state is reached. An error is returned after 60 failed checks.
newAddonDeleted :: Core.Wait DescribeAddon
newAddonDeleted :: Wait DescribeAddon
newAddonDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"AddonDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
60,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
10,
      $sel:acceptors:Wait :: [Acceptor DescribeAddon]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DELETE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeAddonResponse (Maybe Addon)
describeAddonResponse_addon
                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' Addon (Maybe AddonStatus)
addon_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
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeCluster' every 30 seconds until a successful state is reached. An error is returned after 40 failed checks.
newClusterActive :: Core.Wait DescribeCluster
newClusterActive :: Wait DescribeCluster
newClusterActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ClusterActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
30,
      $sel:acceptors:Wait :: [Acceptor DescribeCluster]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DELETING"
            Accept
Core.AcceptFailure
            ( Lens' DescribeClusterResponse (Maybe Cluster)
describeClusterResponse_cluster
                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' Cluster (Maybe ClusterStatus)
cluster_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeClusterResponse (Maybe Cluster)
describeClusterResponse_cluster
                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' Cluster (Maybe ClusterStatus)
cluster_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribeClusterResponse (Maybe Cluster)
describeClusterResponse_cluster
                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' Cluster (Maybe ClusterStatus)
cluster_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
            )
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeCluster' every 30 seconds until a successful state is reached. An error is returned after 40 failed checks.
newClusterDeleted :: Core.Wait DescribeCluster
newClusterDeleted :: Wait DescribeCluster
newClusterDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ClusterDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
30,
      $sel:acceptors:Wait :: [Acceptor DescribeCluster]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptFailure
            ( Lens' DescribeClusterResponse (Maybe Cluster)
describeClusterResponse_cluster
                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' Cluster (Maybe ClusterStatus)
cluster_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATING"
            Accept
Core.AcceptFailure
            ( Lens' DescribeClusterResponse (Maybe Cluster)
describeClusterResponse_cluster
                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' Cluster (Maybe ClusterStatus)
cluster_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"PENDING"
            Accept
Core.AcceptFailure
            ( Lens' DescribeClusterResponse (Maybe Cluster)
describeClusterResponse_cluster
                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' Cluster (Maybe ClusterStatus)
cluster_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
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeFargateProfile' every 10 seconds until a successful state is reached. An error is returned after 60 failed checks.
newFargateProfileActive :: Core.Wait DescribeFargateProfile
newFargateProfileActive :: Wait DescribeFargateProfile
newFargateProfileActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"FargateProfileActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
60,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
10,
      $sel:acceptors:Wait :: [Acceptor DescribeFargateProfile]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeFargateProfileResponse (Maybe FargateProfile)
describeFargateProfileResponse_fargateProfile
                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' FargateProfile (Maybe FargateProfileStatus)
fargateProfile_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribeFargateProfileResponse (Maybe FargateProfile)
describeFargateProfileResponse_fargateProfile
                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' FargateProfile (Maybe FargateProfileStatus)
fargateProfile_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
            )
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeFargateProfile' every 30 seconds until a successful state is reached. An error is returned after 60 failed checks.
newFargateProfileDeleted :: Core.Wait DescribeFargateProfile
newFargateProfileDeleted :: Wait DescribeFargateProfile
newFargateProfileDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"FargateProfileDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
60,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
30,
      $sel:acceptors:Wait :: [Acceptor DescribeFargateProfile]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DELETE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeFargateProfileResponse (Maybe FargateProfile)
describeFargateProfileResponse_fargateProfile
                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' FargateProfile (Maybe FargateProfileStatus)
fargateProfile_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
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeNodegroup' every 30 seconds until a successful state is reached. An error is returned after 80 failed checks.
newNodegroupActive :: Core.Wait DescribeNodegroup
newNodegroupActive :: Wait DescribeNodegroup
newNodegroupActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"NodegroupActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
80,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
30,
      $sel:acceptors:Wait :: [Acceptor DescribeNodegroup]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeNodegroupResponse (Maybe Nodegroup)
describeNodegroupResponse_nodegroup
                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' Nodegroup (Maybe NodegroupStatus)
nodegroup_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribeNodegroupResponse (Maybe Nodegroup)
describeNodegroupResponse_nodegroup
                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' Nodegroup (Maybe NodegroupStatus)
nodegroup_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
            )
        ]
    }

-- | Polls 'Amazonka.EKS.DescribeNodegroup' every 30 seconds until a successful state is reached. An error is returned after 40 failed checks.
newNodegroupDeleted :: Core.Wait DescribeNodegroup
newNodegroupDeleted :: Wait DescribeNodegroup
newNodegroupDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"NodegroupDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
40,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
30,
      $sel:acceptors:Wait :: [Acceptor DescribeNodegroup]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DELETE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeNodegroupResponse (Maybe Nodegroup)
describeNodegroupResponse_nodegroup
                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' Nodegroup (Maybe NodegroupStatus)
nodegroup_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
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }