{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

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

-- |
-- Module      : Amazonka.SSMContacts.AcceptPage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Used to acknowledge an engagement to a contact channel during an
-- incident.
module Amazonka.SSMContacts.AcceptPage
  ( -- * Creating a Request
    AcceptPage (..),
    newAcceptPage,

    -- * Request Lenses
    acceptPage_acceptCodeValidation,
    acceptPage_contactChannelId,
    acceptPage_note,
    acceptPage_pageId,
    acceptPage_acceptType,
    acceptPage_acceptCode,

    -- * Destructuring the Response
    AcceptPageResponse (..),
    newAcceptPageResponse,

    -- * Response Lenses
    acceptPageResponse_httpStatus,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SSMContacts.Types

-- | /See:/ 'newAcceptPage' smart constructor.
data AcceptPage = AcceptPage'
  { -- | An optional field that Incident Manager uses to @ENFORCE@ @AcceptCode@
    -- validation when acknowledging an page. Acknowledgement can occur by
    -- replying to a page, or when entering the AcceptCode in the console.
    -- Enforcing AcceptCode validation causes Incident Manager to verify that
    -- the code entered by the user matches the code sent by Incident Manager
    -- with the page.
    --
    -- Incident Manager can also @IGNORE@ @AcceptCode@ validation. Ignoring
    -- @AcceptCode@ validation causes Incident Manager to accept any value
    -- entered for the @AcceptCode@.
    AcceptPage -> Maybe AcceptCodeValidation
acceptCodeValidation :: Prelude.Maybe AcceptCodeValidation,
    -- | The ARN of the contact channel.
    AcceptPage -> Maybe Text
contactChannelId :: Prelude.Maybe Prelude.Text,
    -- | Information provided by the user when the user acknowledges the page.
    AcceptPage -> Maybe Text
note :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the engagement to a contact channel.
    AcceptPage -> Text
pageId :: Prelude.Text,
    -- | The type indicates if the page was @DELIVERED@ or @READ@.
    AcceptPage -> AcceptType
acceptType :: AcceptType,
    -- | The accept code is a 6-digit code used to acknowledge the page.
    AcceptPage -> Text
acceptCode :: Prelude.Text
  }
  deriving (AcceptPage -> AcceptPage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptPage -> AcceptPage -> Bool
$c/= :: AcceptPage -> AcceptPage -> Bool
== :: AcceptPage -> AcceptPage -> Bool
$c== :: AcceptPage -> AcceptPage -> Bool
Prelude.Eq, ReadPrec [AcceptPage]
ReadPrec AcceptPage
Int -> ReadS AcceptPage
ReadS [AcceptPage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptPage]
$creadListPrec :: ReadPrec [AcceptPage]
readPrec :: ReadPrec AcceptPage
$creadPrec :: ReadPrec AcceptPage
readList :: ReadS [AcceptPage]
$creadList :: ReadS [AcceptPage]
readsPrec :: Int -> ReadS AcceptPage
$creadsPrec :: Int -> ReadS AcceptPage
Prelude.Read, Int -> AcceptPage -> ShowS
[AcceptPage] -> ShowS
AcceptPage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptPage] -> ShowS
$cshowList :: [AcceptPage] -> ShowS
show :: AcceptPage -> String
$cshow :: AcceptPage -> String
showsPrec :: Int -> AcceptPage -> ShowS
$cshowsPrec :: Int -> AcceptPage -> ShowS
Prelude.Show, forall x. Rep AcceptPage x -> AcceptPage
forall x. AcceptPage -> Rep AcceptPage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptPage x -> AcceptPage
$cfrom :: forall x. AcceptPage -> Rep AcceptPage x
Prelude.Generic)

-- |
-- Create a value of 'AcceptPage' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'acceptCodeValidation', 'acceptPage_acceptCodeValidation' - An optional field that Incident Manager uses to @ENFORCE@ @AcceptCode@
-- validation when acknowledging an page. Acknowledgement can occur by
-- replying to a page, or when entering the AcceptCode in the console.
-- Enforcing AcceptCode validation causes Incident Manager to verify that
-- the code entered by the user matches the code sent by Incident Manager
-- with the page.
--
-- Incident Manager can also @IGNORE@ @AcceptCode@ validation. Ignoring
-- @AcceptCode@ validation causes Incident Manager to accept any value
-- entered for the @AcceptCode@.
--
-- 'contactChannelId', 'acceptPage_contactChannelId' - The ARN of the contact channel.
--
-- 'note', 'acceptPage_note' - Information provided by the user when the user acknowledges the page.
--
-- 'pageId', 'acceptPage_pageId' - The Amazon Resource Name (ARN) of the engagement to a contact channel.
--
-- 'acceptType', 'acceptPage_acceptType' - The type indicates if the page was @DELIVERED@ or @READ@.
--
-- 'acceptCode', 'acceptPage_acceptCode' - The accept code is a 6-digit code used to acknowledge the page.
newAcceptPage ::
  -- | 'pageId'
  Prelude.Text ->
  -- | 'acceptType'
  AcceptType ->
  -- | 'acceptCode'
  Prelude.Text ->
  AcceptPage
newAcceptPage :: Text -> AcceptType -> Text -> AcceptPage
newAcceptPage Text
pPageId_ AcceptType
pAcceptType_ Text
pAcceptCode_ =
  AcceptPage'
    { $sel:acceptCodeValidation:AcceptPage' :: Maybe AcceptCodeValidation
acceptCodeValidation = forall a. Maybe a
Prelude.Nothing,
      $sel:contactChannelId:AcceptPage' :: Maybe Text
contactChannelId = forall a. Maybe a
Prelude.Nothing,
      $sel:note:AcceptPage' :: Maybe Text
note = forall a. Maybe a
Prelude.Nothing,
      $sel:pageId:AcceptPage' :: Text
pageId = Text
pPageId_,
      $sel:acceptType:AcceptPage' :: AcceptType
acceptType = AcceptType
pAcceptType_,
      $sel:acceptCode:AcceptPage' :: Text
acceptCode = Text
pAcceptCode_
    }

-- | An optional field that Incident Manager uses to @ENFORCE@ @AcceptCode@
-- validation when acknowledging an page. Acknowledgement can occur by
-- replying to a page, or when entering the AcceptCode in the console.
-- Enforcing AcceptCode validation causes Incident Manager to verify that
-- the code entered by the user matches the code sent by Incident Manager
-- with the page.
--
-- Incident Manager can also @IGNORE@ @AcceptCode@ validation. Ignoring
-- @AcceptCode@ validation causes Incident Manager to accept any value
-- entered for the @AcceptCode@.
acceptPage_acceptCodeValidation :: Lens.Lens' AcceptPage (Prelude.Maybe AcceptCodeValidation)
acceptPage_acceptCodeValidation :: Lens' AcceptPage (Maybe AcceptCodeValidation)
acceptPage_acceptCodeValidation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPage' {Maybe AcceptCodeValidation
acceptCodeValidation :: Maybe AcceptCodeValidation
$sel:acceptCodeValidation:AcceptPage' :: AcceptPage -> Maybe AcceptCodeValidation
acceptCodeValidation} -> Maybe AcceptCodeValidation
acceptCodeValidation) (\s :: AcceptPage
s@AcceptPage' {} Maybe AcceptCodeValidation
a -> AcceptPage
s {$sel:acceptCodeValidation:AcceptPage' :: Maybe AcceptCodeValidation
acceptCodeValidation = Maybe AcceptCodeValidation
a} :: AcceptPage)

-- | The ARN of the contact channel.
acceptPage_contactChannelId :: Lens.Lens' AcceptPage (Prelude.Maybe Prelude.Text)
acceptPage_contactChannelId :: Lens' AcceptPage (Maybe Text)
acceptPage_contactChannelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPage' {Maybe Text
contactChannelId :: Maybe Text
$sel:contactChannelId:AcceptPage' :: AcceptPage -> Maybe Text
contactChannelId} -> Maybe Text
contactChannelId) (\s :: AcceptPage
s@AcceptPage' {} Maybe Text
a -> AcceptPage
s {$sel:contactChannelId:AcceptPage' :: Maybe Text
contactChannelId = Maybe Text
a} :: AcceptPage)

-- | Information provided by the user when the user acknowledges the page.
acceptPage_note :: Lens.Lens' AcceptPage (Prelude.Maybe Prelude.Text)
acceptPage_note :: Lens' AcceptPage (Maybe Text)
acceptPage_note = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPage' {Maybe Text
note :: Maybe Text
$sel:note:AcceptPage' :: AcceptPage -> Maybe Text
note} -> Maybe Text
note) (\s :: AcceptPage
s@AcceptPage' {} Maybe Text
a -> AcceptPage
s {$sel:note:AcceptPage' :: Maybe Text
note = Maybe Text
a} :: AcceptPage)

-- | The Amazon Resource Name (ARN) of the engagement to a contact channel.
acceptPage_pageId :: Lens.Lens' AcceptPage Prelude.Text
acceptPage_pageId :: Lens' AcceptPage Text
acceptPage_pageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPage' {Text
pageId :: Text
$sel:pageId:AcceptPage' :: AcceptPage -> Text
pageId} -> Text
pageId) (\s :: AcceptPage
s@AcceptPage' {} Text
a -> AcceptPage
s {$sel:pageId:AcceptPage' :: Text
pageId = Text
a} :: AcceptPage)

-- | The type indicates if the page was @DELIVERED@ or @READ@.
acceptPage_acceptType :: Lens.Lens' AcceptPage AcceptType
acceptPage_acceptType :: Lens' AcceptPage AcceptType
acceptPage_acceptType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPage' {AcceptType
acceptType :: AcceptType
$sel:acceptType:AcceptPage' :: AcceptPage -> AcceptType
acceptType} -> AcceptType
acceptType) (\s :: AcceptPage
s@AcceptPage' {} AcceptType
a -> AcceptPage
s {$sel:acceptType:AcceptPage' :: AcceptType
acceptType = AcceptType
a} :: AcceptPage)

-- | The accept code is a 6-digit code used to acknowledge the page.
acceptPage_acceptCode :: Lens.Lens' AcceptPage Prelude.Text
acceptPage_acceptCode :: Lens' AcceptPage Text
acceptPage_acceptCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPage' {Text
acceptCode :: Text
$sel:acceptCode:AcceptPage' :: AcceptPage -> Text
acceptCode} -> Text
acceptCode) (\s :: AcceptPage
s@AcceptPage' {} Text
a -> AcceptPage
s {$sel:acceptCode:AcceptPage' :: Text
acceptCode = Text
a} :: AcceptPage)

instance Core.AWSRequest AcceptPage where
  type AWSResponse AcceptPage = AcceptPageResponse
  request :: (Service -> Service) -> AcceptPage -> Request AcceptPage
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AcceptPage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AcceptPage)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AcceptPageResponse
AcceptPageResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable AcceptPage where
  hashWithSalt :: Int -> AcceptPage -> Int
hashWithSalt Int
_salt AcceptPage' {Maybe Text
Maybe AcceptCodeValidation
Text
AcceptType
acceptCode :: Text
acceptType :: AcceptType
pageId :: Text
note :: Maybe Text
contactChannelId :: Maybe Text
acceptCodeValidation :: Maybe AcceptCodeValidation
$sel:acceptCode:AcceptPage' :: AcceptPage -> Text
$sel:acceptType:AcceptPage' :: AcceptPage -> AcceptType
$sel:pageId:AcceptPage' :: AcceptPage -> Text
$sel:note:AcceptPage' :: AcceptPage -> Maybe Text
$sel:contactChannelId:AcceptPage' :: AcceptPage -> Maybe Text
$sel:acceptCodeValidation:AcceptPage' :: AcceptPage -> Maybe AcceptCodeValidation
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AcceptCodeValidation
acceptCodeValidation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contactChannelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
note
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AcceptType
acceptType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
acceptCode

instance Prelude.NFData AcceptPage where
  rnf :: AcceptPage -> ()
rnf AcceptPage' {Maybe Text
Maybe AcceptCodeValidation
Text
AcceptType
acceptCode :: Text
acceptType :: AcceptType
pageId :: Text
note :: Maybe Text
contactChannelId :: Maybe Text
acceptCodeValidation :: Maybe AcceptCodeValidation
$sel:acceptCode:AcceptPage' :: AcceptPage -> Text
$sel:acceptType:AcceptPage' :: AcceptPage -> AcceptType
$sel:pageId:AcceptPage' :: AcceptPage -> Text
$sel:note:AcceptPage' :: AcceptPage -> Maybe Text
$sel:contactChannelId:AcceptPage' :: AcceptPage -> Maybe Text
$sel:acceptCodeValidation:AcceptPage' :: AcceptPage -> Maybe AcceptCodeValidation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AcceptCodeValidation
acceptCodeValidation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contactChannelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
note
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AcceptType
acceptType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
acceptCode

instance Data.ToHeaders AcceptPage where
  toHeaders :: AcceptPage -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"SSMContacts.AcceptPage" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AcceptPage where
  toJSON :: AcceptPage -> Value
toJSON AcceptPage' {Maybe Text
Maybe AcceptCodeValidation
Text
AcceptType
acceptCode :: Text
acceptType :: AcceptType
pageId :: Text
note :: Maybe Text
contactChannelId :: Maybe Text
acceptCodeValidation :: Maybe AcceptCodeValidation
$sel:acceptCode:AcceptPage' :: AcceptPage -> Text
$sel:acceptType:AcceptPage' :: AcceptPage -> AcceptType
$sel:pageId:AcceptPage' :: AcceptPage -> Text
$sel:note:AcceptPage' :: AcceptPage -> Maybe Text
$sel:contactChannelId:AcceptPage' :: AcceptPage -> Maybe Text
$sel:acceptCodeValidation:AcceptPage' :: AcceptPage -> Maybe AcceptCodeValidation
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AcceptCodeValidation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AcceptCodeValidation
acceptCodeValidation,
            (Key
"ContactChannelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
contactChannelId,
            (Key
"Note" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
note,
            forall a. a -> Maybe a
Prelude.Just (Key
"PageId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pageId),
            forall a. a -> Maybe a
Prelude.Just (Key
"AcceptType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AcceptType
acceptType),
            forall a. a -> Maybe a
Prelude.Just (Key
"AcceptCode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
acceptCode)
          ]
      )

instance Data.ToPath AcceptPage where
  toPath :: AcceptPage -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery AcceptPage where
  toQuery :: AcceptPage -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newAcceptPageResponse' smart constructor.
data AcceptPageResponse = AcceptPageResponse'
  { -- | The response's http status code.
    AcceptPageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AcceptPageResponse -> AcceptPageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptPageResponse -> AcceptPageResponse -> Bool
$c/= :: AcceptPageResponse -> AcceptPageResponse -> Bool
== :: AcceptPageResponse -> AcceptPageResponse -> Bool
$c== :: AcceptPageResponse -> AcceptPageResponse -> Bool
Prelude.Eq, ReadPrec [AcceptPageResponse]
ReadPrec AcceptPageResponse
Int -> ReadS AcceptPageResponse
ReadS [AcceptPageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptPageResponse]
$creadListPrec :: ReadPrec [AcceptPageResponse]
readPrec :: ReadPrec AcceptPageResponse
$creadPrec :: ReadPrec AcceptPageResponse
readList :: ReadS [AcceptPageResponse]
$creadList :: ReadS [AcceptPageResponse]
readsPrec :: Int -> ReadS AcceptPageResponse
$creadsPrec :: Int -> ReadS AcceptPageResponse
Prelude.Read, Int -> AcceptPageResponse -> ShowS
[AcceptPageResponse] -> ShowS
AcceptPageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptPageResponse] -> ShowS
$cshowList :: [AcceptPageResponse] -> ShowS
show :: AcceptPageResponse -> String
$cshow :: AcceptPageResponse -> String
showsPrec :: Int -> AcceptPageResponse -> ShowS
$cshowsPrec :: Int -> AcceptPageResponse -> ShowS
Prelude.Show, forall x. Rep AcceptPageResponse x -> AcceptPageResponse
forall x. AcceptPageResponse -> Rep AcceptPageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptPageResponse x -> AcceptPageResponse
$cfrom :: forall x. AcceptPageResponse -> Rep AcceptPageResponse x
Prelude.Generic)

-- |
-- Create a value of 'AcceptPageResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'acceptPageResponse_httpStatus' - The response's http status code.
newAcceptPageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AcceptPageResponse
newAcceptPageResponse :: Int -> AcceptPageResponse
newAcceptPageResponse Int
pHttpStatus_ =
  AcceptPageResponse' {$sel:httpStatus:AcceptPageResponse' :: Int
httpStatus = Int
pHttpStatus_}

-- | The response's http status code.
acceptPageResponse_httpStatus :: Lens.Lens' AcceptPageResponse Prelude.Int
acceptPageResponse_httpStatus :: Lens' AcceptPageResponse Int
acceptPageResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptPageResponse' {Int
httpStatus :: Int
$sel:httpStatus:AcceptPageResponse' :: AcceptPageResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: AcceptPageResponse
s@AcceptPageResponse' {} Int
a -> AcceptPageResponse
s {$sel:httpStatus:AcceptPageResponse' :: Int
httpStatus = Int
a} :: AcceptPageResponse)

instance Prelude.NFData AcceptPageResponse where
  rnf :: AcceptPageResponse -> ()
rnf AcceptPageResponse' {Int
httpStatus :: Int
$sel:httpStatus:AcceptPageResponse' :: AcceptPageResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus