{-# 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.WorkMail.DescribeInboundDmarcSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the settings in a DMARC policy for a specified organization.
module Amazonka.WorkMail.DescribeInboundDmarcSettings
  ( -- * Creating a Request
    DescribeInboundDmarcSettings (..),
    newDescribeInboundDmarcSettings,

    -- * Request Lenses
    describeInboundDmarcSettings_organizationId,

    -- * Destructuring the Response
    DescribeInboundDmarcSettingsResponse (..),
    newDescribeInboundDmarcSettingsResponse,

    -- * Response Lenses
    describeInboundDmarcSettingsResponse_enforced,
    describeInboundDmarcSettingsResponse_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.WorkMail.Types

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

-- |
-- Create a value of 'DescribeInboundDmarcSettings' 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:
--
-- 'organizationId', 'describeInboundDmarcSettings_organizationId' - Lists the ID of the given organization.
newDescribeInboundDmarcSettings ::
  -- | 'organizationId'
  Prelude.Text ->
  DescribeInboundDmarcSettings
newDescribeInboundDmarcSettings :: Text -> DescribeInboundDmarcSettings
newDescribeInboundDmarcSettings Text
pOrganizationId_ =
  DescribeInboundDmarcSettings'
    { $sel:organizationId:DescribeInboundDmarcSettings' :: Text
organizationId =
        Text
pOrganizationId_
    }

-- | Lists the ID of the given organization.
describeInboundDmarcSettings_organizationId :: Lens.Lens' DescribeInboundDmarcSettings Prelude.Text
describeInboundDmarcSettings_organizationId :: Lens' DescribeInboundDmarcSettings Text
describeInboundDmarcSettings_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundDmarcSettings' {Text
organizationId :: Text
$sel:organizationId:DescribeInboundDmarcSettings' :: DescribeInboundDmarcSettings -> Text
organizationId} -> Text
organizationId) (\s :: DescribeInboundDmarcSettings
s@DescribeInboundDmarcSettings' {} Text
a -> DescribeInboundDmarcSettings
s {$sel:organizationId:DescribeInboundDmarcSettings' :: Text
organizationId = Text
a} :: DescribeInboundDmarcSettings)

instance Core.AWSRequest DescribeInboundDmarcSettings where
  type
    AWSResponse DescribeInboundDmarcSettings =
      DescribeInboundDmarcSettingsResponse
  request :: (Service -> Service)
-> DescribeInboundDmarcSettings
-> Request DescribeInboundDmarcSettings
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 DescribeInboundDmarcSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeInboundDmarcSettings)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Bool -> Int -> DescribeInboundDmarcSettingsResponse
DescribeInboundDmarcSettingsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Enforced")
            forall (f :: * -> *) a b. Applicative f => 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
    DescribeInboundDmarcSettings
  where
  hashWithSalt :: Int -> DescribeInboundDmarcSettings -> Int
hashWithSalt Int
_salt DescribeInboundDmarcSettings' {Text
organizationId :: Text
$sel:organizationId:DescribeInboundDmarcSettings' :: DescribeInboundDmarcSettings -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationId

instance Prelude.NFData DescribeInboundDmarcSettings where
  rnf :: DescribeInboundDmarcSettings -> ()
rnf DescribeInboundDmarcSettings' {Text
organizationId :: Text
$sel:organizationId:DescribeInboundDmarcSettings' :: DescribeInboundDmarcSettings -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId

instance Data.ToHeaders DescribeInboundDmarcSettings where
  toHeaders :: DescribeInboundDmarcSettings -> 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
"WorkMailService.DescribeInboundDmarcSettings" ::
                          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 DescribeInboundDmarcSettings where
  toJSON :: DescribeInboundDmarcSettings -> Value
toJSON DescribeInboundDmarcSettings' {Text
organizationId :: Text
$sel:organizationId:DescribeInboundDmarcSettings' :: DescribeInboundDmarcSettings -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId)
          ]
      )

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

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

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

-- |
-- Create a value of 'DescribeInboundDmarcSettingsResponse' 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:
--
-- 'enforced', 'describeInboundDmarcSettingsResponse_enforced' - Lists the enforcement setting of the applied policy.
--
-- 'httpStatus', 'describeInboundDmarcSettingsResponse_httpStatus' - The response's http status code.
newDescribeInboundDmarcSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeInboundDmarcSettingsResponse
newDescribeInboundDmarcSettingsResponse :: Int -> DescribeInboundDmarcSettingsResponse
newDescribeInboundDmarcSettingsResponse Int
pHttpStatus_ =
  DescribeInboundDmarcSettingsResponse'
    { $sel:enforced:DescribeInboundDmarcSettingsResponse' :: Maybe Bool
enforced =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeInboundDmarcSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Lists the enforcement setting of the applied policy.
describeInboundDmarcSettingsResponse_enforced :: Lens.Lens' DescribeInboundDmarcSettingsResponse (Prelude.Maybe Prelude.Bool)
describeInboundDmarcSettingsResponse_enforced :: Lens' DescribeInboundDmarcSettingsResponse (Maybe Bool)
describeInboundDmarcSettingsResponse_enforced = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundDmarcSettingsResponse' {Maybe Bool
enforced :: Maybe Bool
$sel:enforced:DescribeInboundDmarcSettingsResponse' :: DescribeInboundDmarcSettingsResponse -> Maybe Bool
enforced} -> Maybe Bool
enforced) (\s :: DescribeInboundDmarcSettingsResponse
s@DescribeInboundDmarcSettingsResponse' {} Maybe Bool
a -> DescribeInboundDmarcSettingsResponse
s {$sel:enforced:DescribeInboundDmarcSettingsResponse' :: Maybe Bool
enforced = Maybe Bool
a} :: DescribeInboundDmarcSettingsResponse)

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

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