{-# 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.SNS.GetSMSSandboxAccountStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the SMS sandbox status for the calling Amazon Web Services
-- account in the target Amazon Web Services Region.
--
-- When you start using Amazon SNS to send SMS messages, your Amazon Web
-- Services account is in the /SMS sandbox/. The SMS sandbox provides a
-- safe environment for you to try Amazon SNS features without risking your
-- reputation as an SMS sender. While your Amazon Web Services account is
-- in the SMS sandbox, you can use all of the features of Amazon SNS.
-- However, you can send SMS messages only to verified destination phone
-- numbers. For more information, including how to move out of the sandbox
-- to send messages without restrictions, see
-- <https://docs.aws.amazon.com/sns/latest/dg/sns-sms-sandbox.html SMS sandbox>
-- in the /Amazon SNS Developer Guide/.
module Amazonka.SNS.GetSMSSandboxAccountStatus
  ( -- * Creating a Request
    GetSMSSandboxAccountStatus (..),
    newGetSMSSandboxAccountStatus,

    -- * Destructuring the Response
    GetSMSSandboxAccountStatusResponse (..),
    newGetSMSSandboxAccountStatusResponse,

    -- * Response Lenses
    getSMSSandboxAccountStatusResponse_httpStatus,
    getSMSSandboxAccountStatusResponse_isInSandbox,
  )
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.SNS.Types

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

-- |
-- Create a value of 'GetSMSSandboxAccountStatus' 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.
newGetSMSSandboxAccountStatus ::
  GetSMSSandboxAccountStatus
newGetSMSSandboxAccountStatus :: GetSMSSandboxAccountStatus
newGetSMSSandboxAccountStatus =
  GetSMSSandboxAccountStatus
GetSMSSandboxAccountStatus'

instance Core.AWSRequest GetSMSSandboxAccountStatus where
  type
    AWSResponse GetSMSSandboxAccountStatus =
      GetSMSSandboxAccountStatusResponse
  request :: (Service -> Service)
-> GetSMSSandboxAccountStatus -> Request GetSMSSandboxAccountStatus
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSMSSandboxAccountStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetSMSSandboxAccountStatus)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetSMSSandboxAccountStatusResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> Bool -> GetSMSSandboxAccountStatusResponse
GetSMSSandboxAccountStatusResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"IsInSandbox")
      )

instance Prelude.Hashable GetSMSSandboxAccountStatus where
  hashWithSalt :: Int -> GetSMSSandboxAccountStatus -> Int
hashWithSalt Int
_salt GetSMSSandboxAccountStatus
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData GetSMSSandboxAccountStatus where
  rnf :: GetSMSSandboxAccountStatus -> ()
rnf GetSMSSandboxAccountStatus
_ = ()

instance Data.ToHeaders GetSMSSandboxAccountStatus where
  toHeaders :: GetSMSSandboxAccountStatus -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetSMSSandboxAccountStatus where
  toQuery :: GetSMSSandboxAccountStatus -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ ByteString
"Action"
              forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetSMSSandboxAccountStatus" :: Prelude.ByteString),
            ByteString
"Version"
              forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString)
          ]
      )

-- | /See:/ 'newGetSMSSandboxAccountStatusResponse' smart constructor.
data GetSMSSandboxAccountStatusResponse = GetSMSSandboxAccountStatusResponse'
  { -- | The response's http status code.
    GetSMSSandboxAccountStatusResponse -> Int
httpStatus :: Prelude.Int,
    -- | Indicates whether the calling Amazon Web Services account is in the SMS
    -- sandbox.
    GetSMSSandboxAccountStatusResponse -> Bool
isInSandbox :: Prelude.Bool
  }
  deriving (GetSMSSandboxAccountStatusResponse
-> GetSMSSandboxAccountStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSMSSandboxAccountStatusResponse
-> GetSMSSandboxAccountStatusResponse -> Bool
$c/= :: GetSMSSandboxAccountStatusResponse
-> GetSMSSandboxAccountStatusResponse -> Bool
== :: GetSMSSandboxAccountStatusResponse
-> GetSMSSandboxAccountStatusResponse -> Bool
$c== :: GetSMSSandboxAccountStatusResponse
-> GetSMSSandboxAccountStatusResponse -> Bool
Prelude.Eq, ReadPrec [GetSMSSandboxAccountStatusResponse]
ReadPrec GetSMSSandboxAccountStatusResponse
Int -> ReadS GetSMSSandboxAccountStatusResponse
ReadS [GetSMSSandboxAccountStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSMSSandboxAccountStatusResponse]
$creadListPrec :: ReadPrec [GetSMSSandboxAccountStatusResponse]
readPrec :: ReadPrec GetSMSSandboxAccountStatusResponse
$creadPrec :: ReadPrec GetSMSSandboxAccountStatusResponse
readList :: ReadS [GetSMSSandboxAccountStatusResponse]
$creadList :: ReadS [GetSMSSandboxAccountStatusResponse]
readsPrec :: Int -> ReadS GetSMSSandboxAccountStatusResponse
$creadsPrec :: Int -> ReadS GetSMSSandboxAccountStatusResponse
Prelude.Read, Int -> GetSMSSandboxAccountStatusResponse -> ShowS
[GetSMSSandboxAccountStatusResponse] -> ShowS
GetSMSSandboxAccountStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSMSSandboxAccountStatusResponse] -> ShowS
$cshowList :: [GetSMSSandboxAccountStatusResponse] -> ShowS
show :: GetSMSSandboxAccountStatusResponse -> String
$cshow :: GetSMSSandboxAccountStatusResponse -> String
showsPrec :: Int -> GetSMSSandboxAccountStatusResponse -> ShowS
$cshowsPrec :: Int -> GetSMSSandboxAccountStatusResponse -> ShowS
Prelude.Show, forall x.
Rep GetSMSSandboxAccountStatusResponse x
-> GetSMSSandboxAccountStatusResponse
forall x.
GetSMSSandboxAccountStatusResponse
-> Rep GetSMSSandboxAccountStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetSMSSandboxAccountStatusResponse x
-> GetSMSSandboxAccountStatusResponse
$cfrom :: forall x.
GetSMSSandboxAccountStatusResponse
-> Rep GetSMSSandboxAccountStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSMSSandboxAccountStatusResponse' 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', 'getSMSSandboxAccountStatusResponse_httpStatus' - The response's http status code.
--
-- 'isInSandbox', 'getSMSSandboxAccountStatusResponse_isInSandbox' - Indicates whether the calling Amazon Web Services account is in the SMS
-- sandbox.
newGetSMSSandboxAccountStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'isInSandbox'
  Prelude.Bool ->
  GetSMSSandboxAccountStatusResponse
newGetSMSSandboxAccountStatusResponse :: Int -> Bool -> GetSMSSandboxAccountStatusResponse
newGetSMSSandboxAccountStatusResponse
  Int
pHttpStatus_
  Bool
pIsInSandbox_ =
    GetSMSSandboxAccountStatusResponse'
      { $sel:httpStatus:GetSMSSandboxAccountStatusResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:isInSandbox:GetSMSSandboxAccountStatusResponse' :: Bool
isInSandbox = Bool
pIsInSandbox_
      }

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

-- | Indicates whether the calling Amazon Web Services account is in the SMS
-- sandbox.
getSMSSandboxAccountStatusResponse_isInSandbox :: Lens.Lens' GetSMSSandboxAccountStatusResponse Prelude.Bool
getSMSSandboxAccountStatusResponse_isInSandbox :: Lens' GetSMSSandboxAccountStatusResponse Bool
getSMSSandboxAccountStatusResponse_isInSandbox = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSMSSandboxAccountStatusResponse' {Bool
isInSandbox :: Bool
$sel:isInSandbox:GetSMSSandboxAccountStatusResponse' :: GetSMSSandboxAccountStatusResponse -> Bool
isInSandbox} -> Bool
isInSandbox) (\s :: GetSMSSandboxAccountStatusResponse
s@GetSMSSandboxAccountStatusResponse' {} Bool
a -> GetSMSSandboxAccountStatusResponse
s {$sel:isInSandbox:GetSMSSandboxAccountStatusResponse' :: Bool
isInSandbox = Bool
a} :: GetSMSSandboxAccountStatusResponse)

instance
  Prelude.NFData
    GetSMSSandboxAccountStatusResponse
  where
  rnf :: GetSMSSandboxAccountStatusResponse -> ()
rnf GetSMSSandboxAccountStatusResponse' {Bool
Int
isInSandbox :: Bool
httpStatus :: Int
$sel:isInSandbox:GetSMSSandboxAccountStatusResponse' :: GetSMSSandboxAccountStatusResponse -> Bool
$sel:httpStatus:GetSMSSandboxAccountStatusResponse' :: GetSMSSandboxAccountStatusResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
isInSandbox