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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTSiteWise.DescribeAsset
import Amazonka.IoTSiteWise.DescribeAssetModel
import Amazonka.IoTSiteWise.DescribePortal
import Amazonka.IoTSiteWise.Lens
import Amazonka.IoTSiteWise.Types
import qualified Amazonka.Prelude as Prelude

-- | Polls 'Amazonka.IoTSiteWise.DescribeAsset' every 3 seconds until a successful state is reached. An error is returned after 20 failed checks.
newAssetActive :: Core.Wait DescribeAsset
newAssetActive :: Wait DescribeAsset
newAssetActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"AssetActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
20,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
3,
      $sel:acceptors:Wait :: [Acceptor DescribeAsset]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribeAssetResponse AssetStatus
describeAssetResponse_assetStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' AssetStatus AssetState
assetStatus_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.matchAll
            CI Text
"FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeAssetResponse AssetStatus
describeAssetResponse_assetStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' AssetStatus AssetState
assetStatus_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.IoTSiteWise.DescribeAssetModel' every 3 seconds until a successful state is reached. An error is returned after 20 failed checks.
newAssetModelActive :: Core.Wait DescribeAssetModel
newAssetModelActive :: Wait DescribeAssetModel
newAssetModelActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"AssetModelActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
20,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
3,
      $sel:acceptors:Wait :: [Acceptor DescribeAssetModel]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribeAssetModelResponse AssetModelStatus
describeAssetModelResponse_assetModelStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' AssetModelStatus AssetModelState
assetModelStatus_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.matchAll
            CI Text
"FAILED"
            Accept
Core.AcceptFailure
            ( Lens' DescribeAssetModelResponse AssetModelStatus
describeAssetModelResponse_assetModelStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' AssetModelStatus AssetModelState
assetModelStatus_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.IoTSiteWise.DescribeAssetModel' every 3 seconds until a successful state is reached. An error is returned after 20 failed checks.
newAssetModelNotExists :: Core.Wait DescribeAssetModel
newAssetModelNotExists :: Wait DescribeAssetModel
newAssetModelNotExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"AssetModelNotExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
20,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
3,
      $sel:acceptors:Wait :: [Acceptor DescribeAssetModel]
Core.acceptors =
        [ forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.IoTSiteWise.DescribeAsset' every 3 seconds until a successful state is reached. An error is returned after 20 failed checks.
newAssetNotExists :: Core.Wait DescribeAsset
newAssetNotExists :: Wait DescribeAsset
newAssetNotExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"AssetNotExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
20,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
3,
      $sel:acceptors:Wait :: [Acceptor DescribeAsset]
Core.acceptors =
        [ forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }

-- | Polls 'Amazonka.IoTSiteWise.DescribePortal' every 3 seconds until a successful state is reached. An error is returned after 20 failed checks.
newPortalActive :: Core.Wait DescribePortal
newPortalActive :: Wait DescribePortal
newPortalActive =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"PortalActive",
      $sel:attempts:Wait :: Int
Core.attempts = Int
20,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
3,
      $sel:acceptors:Wait :: [Acceptor DescribePortal]
Core.acceptors =
        [ forall b a.
Eq b =>
b -> Accept -> Fold (AWSResponse a) b -> Acceptor a
Core.matchAll
            CI Text
"ACTIVE"
            Accept
Core.AcceptSuccess
            ( Lens' DescribePortalResponse PortalStatus
describePortalResponse_portalStatus
                forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Lens' PortalStatus PortalState
portalStatus_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.IoTSiteWise.DescribePortal' every 3 seconds until a successful state is reached. An error is returned after 20 failed checks.
newPortalNotExists :: Core.Wait DescribePortal
newPortalNotExists :: Wait DescribePortal
newPortalNotExists =
  Core.Wait
    { $sel:name:Wait :: ByteString
Core.name = ByteString
"PortalNotExists",
      $sel:attempts:Wait :: Int
Core.attempts = Int
20,
      $sel:delay:Wait :: Seconds
Core.delay = Seconds
3,
      $sel:acceptors:Wait :: [Acceptor DescribePortal]
Core.acceptors =
        [ forall a. ErrorCode -> Accept -> Acceptor a
Core.matchError
            ErrorCode
"ResourceNotFoundException"
            Accept
Core.AcceptSuccess
        ]
    }