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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Proton.GetComponent
import Amazonka.Proton.GetEnvironment
import Amazonka.Proton.GetEnvironmentTemplateVersion
import Amazonka.Proton.GetService
import Amazonka.Proton.GetServiceInstance
import Amazonka.Proton.GetServiceTemplateVersion
import Amazonka.Proton.Lens
import Amazonka.Proton.Types

-- | Polls 'Amazonka.Proton.GetComponent' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newComponentDeleted :: Core.Wait GetComponent
newComponentDeleted :: Wait GetComponent
newComponentDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ComponentDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetComponent]
Core.acceptors =
        [ forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess,
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DELETE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetComponentResponse (Maybe Component)
getComponentResponse_component
                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' Component DeploymentStatus
component_deploymentStatus
                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.Proton.GetComponent' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newComponentDeployed :: Core.Wait GetComponent
newComponentDeployed :: Wait GetComponent
newComponentDeployed =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ComponentDeployed",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetComponent]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"SUCCEEDED"
            Accept
Core.AcceptSuccess
            ( Lens' GetComponentResponse (Maybe Component)
getComponentResponse_component
                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' Component DeploymentStatus
component_deploymentStatus
                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' GetComponentResponse (Maybe Component)
getComponentResponse_component
                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' Component DeploymentStatus
component_deploymentStatus
                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.Proton.GetEnvironment' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newEnvironmentDeployed :: Core.Wait GetEnvironment
newEnvironmentDeployed :: Wait GetEnvironment
newEnvironmentDeployed =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"EnvironmentDeployed",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetEnvironment]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"SUCCEEDED"
            Accept
Core.AcceptSuccess
            ( Lens' GetEnvironmentResponse Environment
getEnvironmentResponse_environment
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Environment DeploymentStatus
environment_deploymentStatus
                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' GetEnvironmentResponse Environment
getEnvironmentResponse_environment
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' Environment DeploymentStatus
environment_deploymentStatus
                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.Proton.GetEnvironmentTemplateVersion' every 2 seconds until a successful state is reached. An error is returned after 150 failed checks.
newEnvironmentTemplateVersionRegistered :: Core.Wait GetEnvironmentTemplateVersion
newEnvironmentTemplateVersionRegistered :: Wait GetEnvironmentTemplateVersion
newEnvironmentTemplateVersionRegistered =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name =
        ByteString
"EnvironmentTemplateVersionRegistered",
      $sel:attempts:Wait :: Int
Core.attempts = Int
150,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
2,
      $sel:acceptors:Wait :: [Acceptor GetEnvironmentTemplateVersion]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DRAFT"
            Accept
Core.AcceptSuccess
            ( Lens'
  GetEnvironmentTemplateVersionResponse EnvironmentTemplateVersion
getEnvironmentTemplateVersionResponse_environmentTemplateVersion
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' EnvironmentTemplateVersion TemplateVersionStatus
environmentTemplateVersion_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"PUBLISHED"
            Accept
Core.AcceptSuccess
            ( Lens'
  GetEnvironmentTemplateVersionResponse EnvironmentTemplateVersion
getEnvironmentTemplateVersionResponse_environmentTemplateVersion
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' EnvironmentTemplateVersion TemplateVersionStatus
environmentTemplateVersion_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"REGISTRATION_FAILED"
            Accept
Core.AcceptFailure
            ( Lens'
  GetEnvironmentTemplateVersionResponse EnvironmentTemplateVersion
getEnvironmentTemplateVersionResponse_environmentTemplateVersion
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' EnvironmentTemplateVersion TemplateVersionStatus
environmentTemplateVersion_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.Proton.GetService' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newServiceCreated :: Core.Wait GetService
newServiceCreated :: Wait GetService
newServiceCreated =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ServiceCreated",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetService]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATE_FAILED_CLEANUP_COMPLETE"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATE_FAILED_CLEANUP_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"CREATE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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.Proton.GetService' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newServiceDeleted :: Core.Wait GetService
newServiceDeleted :: Wait GetService
newServiceDeleted =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ServiceDeleted",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetService]
Core.acceptors =
        [ forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess,
          forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DELETE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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.Proton.GetServiceInstance' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newServiceInstanceDeployed :: Core.Wait GetServiceInstance
newServiceInstanceDeployed :: Wait GetServiceInstance
newServiceInstanceDeployed =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ServiceInstanceDeployed",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetServiceInstance]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"SUCCEEDED"
            Accept
Core.AcceptSuccess
            ( Lens' GetServiceInstanceResponse ServiceInstance
getServiceInstanceResponse_serviceInstance
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ServiceInstance DeploymentStatus
serviceInstance_deploymentStatus
                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' GetServiceInstanceResponse ServiceInstance
getServiceInstanceResponse_serviceInstance
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ServiceInstance DeploymentStatus
serviceInstance_deploymentStatus
                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.Proton.GetService' every 10 seconds until a successful state is reached. An error is returned after 360 failed checks.
newServicePipelineDeployed :: Core.Wait GetService
newServicePipelineDeployed :: Wait GetService
newServicePipelineDeployed =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ServicePipelineDeployed",
      $sel:attempts:Wait :: Int
Core.attempts = Int
360,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
10,
      $sel:acceptors:Wait :: [Acceptor GetService]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"SUCCEEDED"
            Accept
Core.AcceptSuccess
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service (Maybe ServicePipeline)
service_pipeline
                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' ServicePipeline DeploymentStatus
servicePipeline_deploymentStatus
                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' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service (Maybe ServicePipeline)
service_pipeline
                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' ServicePipeline DeploymentStatus
servicePipeline_deploymentStatus
                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.Proton.GetServiceTemplateVersion' every 2 seconds until a successful state is reached. An error is returned after 150 failed checks.
newServiceTemplateVersionRegistered :: Core.Wait GetServiceTemplateVersion
newServiceTemplateVersionRegistered :: Wait GetServiceTemplateVersion
newServiceTemplateVersionRegistered =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name =
        ByteString
"ServiceTemplateVersionRegistered",
      $sel:attempts:Wait :: Int
Core.attempts = Int
150,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
2,
      $sel:acceptors:Wait :: [Acceptor GetServiceTemplateVersion]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"DRAFT"
            Accept
Core.AcceptSuccess
            ( Lens' GetServiceTemplateVersionResponse ServiceTemplateVersion
getServiceTemplateVersionResponse_serviceTemplateVersion
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ServiceTemplateVersion TemplateVersionStatus
serviceTemplateVersion_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"PUBLISHED"
            Accept
Core.AcceptSuccess
            ( Lens' GetServiceTemplateVersionResponse ServiceTemplateVersion
getServiceTemplateVersionResponse_serviceTemplateVersion
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ServiceTemplateVersion TemplateVersionStatus
serviceTemplateVersion_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"REGISTRATION_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceTemplateVersionResponse ServiceTemplateVersion
getServiceTemplateVersionResponse_serviceTemplateVersion
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' ServiceTemplateVersion TemplateVersionStatus
serviceTemplateVersion_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.Proton.GetService' every 5 seconds until a successful state is reached. An error is returned after 999 failed checks.
newServiceUpdated :: Core.Wait GetService
newServiceUpdated :: Wait GetService
newServiceUpdated =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"ServiceUpdated",
      $sel:attempts:Wait :: Int
Core.attempts = Int
999,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
5,
      $sel:acceptors:Wait :: [Acceptor GetService]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"UPDATE_FAILED_CLEANUP_COMPLETE"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"UPDATE_FAILED_CLEANUP_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"UPDATE_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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 b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"UPDATE_COMPLETE_CLEANUP_FAILED"
            Accept
Core.AcceptFailure
            ( Lens' GetServiceResponse (Maybe Service)
getServiceResponse_service
                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' Service ServiceStatus
service_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
            )
        ]
    }