{-# 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.IoT.ValidateSecurityProfileBehaviors
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Validates a Device Defender security profile behaviors specification.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions ValidateSecurityProfileBehaviors>
-- action.
module Amazonka.IoT.ValidateSecurityProfileBehaviors
  ( -- * Creating a Request
    ValidateSecurityProfileBehaviors (..),
    newValidateSecurityProfileBehaviors,

    -- * Request Lenses
    validateSecurityProfileBehaviors_behaviors,

    -- * Destructuring the Response
    ValidateSecurityProfileBehaviorsResponse (..),
    newValidateSecurityProfileBehaviorsResponse,

    -- * Response Lenses
    validateSecurityProfileBehaviorsResponse_valid,
    validateSecurityProfileBehaviorsResponse_validationErrors,
    validateSecurityProfileBehaviorsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newValidateSecurityProfileBehaviors' smart constructor.
data ValidateSecurityProfileBehaviors = ValidateSecurityProfileBehaviors'
  { -- | Specifies the behaviors that, when violated by a device (thing), cause
    -- an alert.
    ValidateSecurityProfileBehaviors -> [Behavior]
behaviors :: [Behavior]
  }
  deriving (ValidateSecurityProfileBehaviors
-> ValidateSecurityProfileBehaviors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateSecurityProfileBehaviors
-> ValidateSecurityProfileBehaviors -> Bool
$c/= :: ValidateSecurityProfileBehaviors
-> ValidateSecurityProfileBehaviors -> Bool
== :: ValidateSecurityProfileBehaviors
-> ValidateSecurityProfileBehaviors -> Bool
$c== :: ValidateSecurityProfileBehaviors
-> ValidateSecurityProfileBehaviors -> Bool
Prelude.Eq, ReadPrec [ValidateSecurityProfileBehaviors]
ReadPrec ValidateSecurityProfileBehaviors
Int -> ReadS ValidateSecurityProfileBehaviors
ReadS [ValidateSecurityProfileBehaviors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateSecurityProfileBehaviors]
$creadListPrec :: ReadPrec [ValidateSecurityProfileBehaviors]
readPrec :: ReadPrec ValidateSecurityProfileBehaviors
$creadPrec :: ReadPrec ValidateSecurityProfileBehaviors
readList :: ReadS [ValidateSecurityProfileBehaviors]
$creadList :: ReadS [ValidateSecurityProfileBehaviors]
readsPrec :: Int -> ReadS ValidateSecurityProfileBehaviors
$creadsPrec :: Int -> ReadS ValidateSecurityProfileBehaviors
Prelude.Read, Int -> ValidateSecurityProfileBehaviors -> ShowS
[ValidateSecurityProfileBehaviors] -> ShowS
ValidateSecurityProfileBehaviors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateSecurityProfileBehaviors] -> ShowS
$cshowList :: [ValidateSecurityProfileBehaviors] -> ShowS
show :: ValidateSecurityProfileBehaviors -> String
$cshow :: ValidateSecurityProfileBehaviors -> String
showsPrec :: Int -> ValidateSecurityProfileBehaviors -> ShowS
$cshowsPrec :: Int -> ValidateSecurityProfileBehaviors -> ShowS
Prelude.Show, forall x.
Rep ValidateSecurityProfileBehaviors x
-> ValidateSecurityProfileBehaviors
forall x.
ValidateSecurityProfileBehaviors
-> Rep ValidateSecurityProfileBehaviors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ValidateSecurityProfileBehaviors x
-> ValidateSecurityProfileBehaviors
$cfrom :: forall x.
ValidateSecurityProfileBehaviors
-> Rep ValidateSecurityProfileBehaviors x
Prelude.Generic)

-- |
-- Create a value of 'ValidateSecurityProfileBehaviors' 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:
--
-- 'behaviors', 'validateSecurityProfileBehaviors_behaviors' - Specifies the behaviors that, when violated by a device (thing), cause
-- an alert.
newValidateSecurityProfileBehaviors ::
  ValidateSecurityProfileBehaviors
newValidateSecurityProfileBehaviors :: ValidateSecurityProfileBehaviors
newValidateSecurityProfileBehaviors =
  ValidateSecurityProfileBehaviors'
    { $sel:behaviors:ValidateSecurityProfileBehaviors' :: [Behavior]
behaviors =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | Specifies the behaviors that, when violated by a device (thing), cause
-- an alert.
validateSecurityProfileBehaviors_behaviors :: Lens.Lens' ValidateSecurityProfileBehaviors [Behavior]
validateSecurityProfileBehaviors_behaviors :: Lens' ValidateSecurityProfileBehaviors [Behavior]
validateSecurityProfileBehaviors_behaviors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateSecurityProfileBehaviors' {[Behavior]
behaviors :: [Behavior]
$sel:behaviors:ValidateSecurityProfileBehaviors' :: ValidateSecurityProfileBehaviors -> [Behavior]
behaviors} -> [Behavior]
behaviors) (\s :: ValidateSecurityProfileBehaviors
s@ValidateSecurityProfileBehaviors' {} [Behavior]
a -> ValidateSecurityProfileBehaviors
s {$sel:behaviors:ValidateSecurityProfileBehaviors' :: [Behavior]
behaviors = [Behavior]
a} :: ValidateSecurityProfileBehaviors) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Core.AWSRequest
    ValidateSecurityProfileBehaviors
  where
  type
    AWSResponse ValidateSecurityProfileBehaviors =
      ValidateSecurityProfileBehaviorsResponse
  request :: (Service -> Service)
-> ValidateSecurityProfileBehaviors
-> Request ValidateSecurityProfileBehaviors
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 ValidateSecurityProfileBehaviors
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ValidateSecurityProfileBehaviors)))
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
-> Maybe [ValidationError]
-> Int
-> ValidateSecurityProfileBehaviorsResponse
ValidateSecurityProfileBehaviorsResponse'
            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
"valid")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"validationErrors"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
    ValidateSecurityProfileBehaviors
  where
  hashWithSalt :: Int -> ValidateSecurityProfileBehaviors -> Int
hashWithSalt
    Int
_salt
    ValidateSecurityProfileBehaviors' {[Behavior]
behaviors :: [Behavior]
$sel:behaviors:ValidateSecurityProfileBehaviors' :: ValidateSecurityProfileBehaviors -> [Behavior]
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Behavior]
behaviors

instance
  Prelude.NFData
    ValidateSecurityProfileBehaviors
  where
  rnf :: ValidateSecurityProfileBehaviors -> ()
rnf ValidateSecurityProfileBehaviors' {[Behavior]
behaviors :: [Behavior]
$sel:behaviors:ValidateSecurityProfileBehaviors' :: ValidateSecurityProfileBehaviors -> [Behavior]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Behavior]
behaviors

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

instance Data.ToJSON ValidateSecurityProfileBehaviors where
  toJSON :: ValidateSecurityProfileBehaviors -> Value
toJSON ValidateSecurityProfileBehaviors' {[Behavior]
behaviors :: [Behavior]
$sel:behaviors:ValidateSecurityProfileBehaviors' :: ValidateSecurityProfileBehaviors -> [Behavior]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"behaviors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Behavior]
behaviors)]
      )

instance Data.ToPath ValidateSecurityProfileBehaviors where
  toPath :: ValidateSecurityProfileBehaviors -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/security-profile-behaviors/validate"

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

-- | /See:/ 'newValidateSecurityProfileBehaviorsResponse' smart constructor.
data ValidateSecurityProfileBehaviorsResponse = ValidateSecurityProfileBehaviorsResponse'
  { -- | True if the behaviors were valid.
    ValidateSecurityProfileBehaviorsResponse -> Maybe Bool
valid :: Prelude.Maybe Prelude.Bool,
    -- | The list of any errors found in the behaviors.
    ValidateSecurityProfileBehaviorsResponse -> Maybe [ValidationError]
validationErrors :: Prelude.Maybe [ValidationError],
    -- | The response's http status code.
    ValidateSecurityProfileBehaviorsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ValidateSecurityProfileBehaviorsResponse
-> ValidateSecurityProfileBehaviorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateSecurityProfileBehaviorsResponse
-> ValidateSecurityProfileBehaviorsResponse -> Bool
$c/= :: ValidateSecurityProfileBehaviorsResponse
-> ValidateSecurityProfileBehaviorsResponse -> Bool
== :: ValidateSecurityProfileBehaviorsResponse
-> ValidateSecurityProfileBehaviorsResponse -> Bool
$c== :: ValidateSecurityProfileBehaviorsResponse
-> ValidateSecurityProfileBehaviorsResponse -> Bool
Prelude.Eq, ReadPrec [ValidateSecurityProfileBehaviorsResponse]
ReadPrec ValidateSecurityProfileBehaviorsResponse
Int -> ReadS ValidateSecurityProfileBehaviorsResponse
ReadS [ValidateSecurityProfileBehaviorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateSecurityProfileBehaviorsResponse]
$creadListPrec :: ReadPrec [ValidateSecurityProfileBehaviorsResponse]
readPrec :: ReadPrec ValidateSecurityProfileBehaviorsResponse
$creadPrec :: ReadPrec ValidateSecurityProfileBehaviorsResponse
readList :: ReadS [ValidateSecurityProfileBehaviorsResponse]
$creadList :: ReadS [ValidateSecurityProfileBehaviorsResponse]
readsPrec :: Int -> ReadS ValidateSecurityProfileBehaviorsResponse
$creadsPrec :: Int -> ReadS ValidateSecurityProfileBehaviorsResponse
Prelude.Read, Int -> ValidateSecurityProfileBehaviorsResponse -> ShowS
[ValidateSecurityProfileBehaviorsResponse] -> ShowS
ValidateSecurityProfileBehaviorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateSecurityProfileBehaviorsResponse] -> ShowS
$cshowList :: [ValidateSecurityProfileBehaviorsResponse] -> ShowS
show :: ValidateSecurityProfileBehaviorsResponse -> String
$cshow :: ValidateSecurityProfileBehaviorsResponse -> String
showsPrec :: Int -> ValidateSecurityProfileBehaviorsResponse -> ShowS
$cshowsPrec :: Int -> ValidateSecurityProfileBehaviorsResponse -> ShowS
Prelude.Show, forall x.
Rep ValidateSecurityProfileBehaviorsResponse x
-> ValidateSecurityProfileBehaviorsResponse
forall x.
ValidateSecurityProfileBehaviorsResponse
-> Rep ValidateSecurityProfileBehaviorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ValidateSecurityProfileBehaviorsResponse x
-> ValidateSecurityProfileBehaviorsResponse
$cfrom :: forall x.
ValidateSecurityProfileBehaviorsResponse
-> Rep ValidateSecurityProfileBehaviorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ValidateSecurityProfileBehaviorsResponse' 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:
--
-- 'valid', 'validateSecurityProfileBehaviorsResponse_valid' - True if the behaviors were valid.
--
-- 'validationErrors', 'validateSecurityProfileBehaviorsResponse_validationErrors' - The list of any errors found in the behaviors.
--
-- 'httpStatus', 'validateSecurityProfileBehaviorsResponse_httpStatus' - The response's http status code.
newValidateSecurityProfileBehaviorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ValidateSecurityProfileBehaviorsResponse
newValidateSecurityProfileBehaviorsResponse :: Int -> ValidateSecurityProfileBehaviorsResponse
newValidateSecurityProfileBehaviorsResponse
  Int
pHttpStatus_ =
    ValidateSecurityProfileBehaviorsResponse'
      { $sel:valid:ValidateSecurityProfileBehaviorsResponse' :: Maybe Bool
valid =
          forall a. Maybe a
Prelude.Nothing,
        $sel:validationErrors:ValidateSecurityProfileBehaviorsResponse' :: Maybe [ValidationError]
validationErrors =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ValidateSecurityProfileBehaviorsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | True if the behaviors were valid.
validateSecurityProfileBehaviorsResponse_valid :: Lens.Lens' ValidateSecurityProfileBehaviorsResponse (Prelude.Maybe Prelude.Bool)
validateSecurityProfileBehaviorsResponse_valid :: Lens' ValidateSecurityProfileBehaviorsResponse (Maybe Bool)
validateSecurityProfileBehaviorsResponse_valid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateSecurityProfileBehaviorsResponse' {Maybe Bool
valid :: Maybe Bool
$sel:valid:ValidateSecurityProfileBehaviorsResponse' :: ValidateSecurityProfileBehaviorsResponse -> Maybe Bool
valid} -> Maybe Bool
valid) (\s :: ValidateSecurityProfileBehaviorsResponse
s@ValidateSecurityProfileBehaviorsResponse' {} Maybe Bool
a -> ValidateSecurityProfileBehaviorsResponse
s {$sel:valid:ValidateSecurityProfileBehaviorsResponse' :: Maybe Bool
valid = Maybe Bool
a} :: ValidateSecurityProfileBehaviorsResponse)

-- | The list of any errors found in the behaviors.
validateSecurityProfileBehaviorsResponse_validationErrors :: Lens.Lens' ValidateSecurityProfileBehaviorsResponse (Prelude.Maybe [ValidationError])
validateSecurityProfileBehaviorsResponse_validationErrors :: Lens'
  ValidateSecurityProfileBehaviorsResponse (Maybe [ValidationError])
validateSecurityProfileBehaviorsResponse_validationErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateSecurityProfileBehaviorsResponse' {Maybe [ValidationError]
validationErrors :: Maybe [ValidationError]
$sel:validationErrors:ValidateSecurityProfileBehaviorsResponse' :: ValidateSecurityProfileBehaviorsResponse -> Maybe [ValidationError]
validationErrors} -> Maybe [ValidationError]
validationErrors) (\s :: ValidateSecurityProfileBehaviorsResponse
s@ValidateSecurityProfileBehaviorsResponse' {} Maybe [ValidationError]
a -> ValidateSecurityProfileBehaviorsResponse
s {$sel:validationErrors:ValidateSecurityProfileBehaviorsResponse' :: Maybe [ValidationError]
validationErrors = Maybe [ValidationError]
a} :: ValidateSecurityProfileBehaviorsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    ValidateSecurityProfileBehaviorsResponse
  where
  rnf :: ValidateSecurityProfileBehaviorsResponse -> ()
rnf ValidateSecurityProfileBehaviorsResponse' {Int
Maybe Bool
Maybe [ValidationError]
httpStatus :: Int
validationErrors :: Maybe [ValidationError]
valid :: Maybe Bool
$sel:httpStatus:ValidateSecurityProfileBehaviorsResponse' :: ValidateSecurityProfileBehaviorsResponse -> Int
$sel:validationErrors:ValidateSecurityProfileBehaviorsResponse' :: ValidateSecurityProfileBehaviorsResponse -> Maybe [ValidationError]
$sel:valid:ValidateSecurityProfileBehaviorsResponse' :: ValidateSecurityProfileBehaviorsResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
valid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ValidationError]
validationErrors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus