{-# 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.CloudWatchEvents.TestEventPattern
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Tests whether the specified event pattern matches the provided event.
--
-- Most services in Amazon Web Services treat : or \/ as the same character
-- in Amazon Resource Names (ARNs). However, EventBridge uses an exact
-- match in event patterns and rules. Be sure to use the correct ARN
-- characters when creating event patterns so that they match the ARN
-- syntax in the event you want to match.
module Amazonka.CloudWatchEvents.TestEventPattern
  ( -- * Creating a Request
    TestEventPattern (..),
    newTestEventPattern,

    -- * Request Lenses
    testEventPattern_eventPattern,
    testEventPattern_event,

    -- * Destructuring the Response
    TestEventPatternResponse (..),
    newTestEventPatternResponse,

    -- * Response Lenses
    testEventPatternResponse_result,
    testEventPatternResponse_httpStatus,
  )
where

import Amazonka.CloudWatchEvents.Types
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

-- | /See:/ 'newTestEventPattern' smart constructor.
data TestEventPattern = TestEventPattern'
  { -- | The event pattern. For more information, see
    -- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eventbridge-and-event-patterns.html Events and Event Patterns>
    -- in the /Amazon EventBridge User Guide/.
    TestEventPattern -> Text
eventPattern :: Prelude.Text,
    -- | The event, in JSON format, to test against the event pattern. The JSON
    -- must follow the format specified in
    -- <https://docs.aws.amazon.com/eventbridge/latest/userguide/aws-events.html Amazon Web Services Events>,
    -- and the following fields are mandatory:
    --
    -- -   @id@
    --
    -- -   @account@
    --
    -- -   @source@
    --
    -- -   @time@
    --
    -- -   @region@
    --
    -- -   @resources@
    --
    -- -   @detail-type@
    TestEventPattern -> Text
event :: Prelude.Text
  }
  deriving (TestEventPattern -> TestEventPattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestEventPattern -> TestEventPattern -> Bool
$c/= :: TestEventPattern -> TestEventPattern -> Bool
== :: TestEventPattern -> TestEventPattern -> Bool
$c== :: TestEventPattern -> TestEventPattern -> Bool
Prelude.Eq, ReadPrec [TestEventPattern]
ReadPrec TestEventPattern
Int -> ReadS TestEventPattern
ReadS [TestEventPattern]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestEventPattern]
$creadListPrec :: ReadPrec [TestEventPattern]
readPrec :: ReadPrec TestEventPattern
$creadPrec :: ReadPrec TestEventPattern
readList :: ReadS [TestEventPattern]
$creadList :: ReadS [TestEventPattern]
readsPrec :: Int -> ReadS TestEventPattern
$creadsPrec :: Int -> ReadS TestEventPattern
Prelude.Read, Int -> TestEventPattern -> ShowS
[TestEventPattern] -> ShowS
TestEventPattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestEventPattern] -> ShowS
$cshowList :: [TestEventPattern] -> ShowS
show :: TestEventPattern -> String
$cshow :: TestEventPattern -> String
showsPrec :: Int -> TestEventPattern -> ShowS
$cshowsPrec :: Int -> TestEventPattern -> ShowS
Prelude.Show, forall x. Rep TestEventPattern x -> TestEventPattern
forall x. TestEventPattern -> Rep TestEventPattern x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestEventPattern x -> TestEventPattern
$cfrom :: forall x. TestEventPattern -> Rep TestEventPattern x
Prelude.Generic)

-- |
-- Create a value of 'TestEventPattern' 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:
--
-- 'eventPattern', 'testEventPattern_eventPattern' - The event pattern. For more information, see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eventbridge-and-event-patterns.html Events and Event Patterns>
-- in the /Amazon EventBridge User Guide/.
--
-- 'event', 'testEventPattern_event' - The event, in JSON format, to test against the event pattern. The JSON
-- must follow the format specified in
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/aws-events.html Amazon Web Services Events>,
-- and the following fields are mandatory:
--
-- -   @id@
--
-- -   @account@
--
-- -   @source@
--
-- -   @time@
--
-- -   @region@
--
-- -   @resources@
--
-- -   @detail-type@
newTestEventPattern ::
  -- | 'eventPattern'
  Prelude.Text ->
  -- | 'event'
  Prelude.Text ->
  TestEventPattern
newTestEventPattern :: Text -> Text -> TestEventPattern
newTestEventPattern Text
pEventPattern_ Text
pEvent_ =
  TestEventPattern'
    { $sel:eventPattern:TestEventPattern' :: Text
eventPattern = Text
pEventPattern_,
      $sel:event:TestEventPattern' :: Text
event = Text
pEvent_
    }

-- | The event pattern. For more information, see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eventbridge-and-event-patterns.html Events and Event Patterns>
-- in the /Amazon EventBridge User Guide/.
testEventPattern_eventPattern :: Lens.Lens' TestEventPattern Prelude.Text
testEventPattern_eventPattern :: Lens' TestEventPattern Text
testEventPattern_eventPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestEventPattern' {Text
eventPattern :: Text
$sel:eventPattern:TestEventPattern' :: TestEventPattern -> Text
eventPattern} -> Text
eventPattern) (\s :: TestEventPattern
s@TestEventPattern' {} Text
a -> TestEventPattern
s {$sel:eventPattern:TestEventPattern' :: Text
eventPattern = Text
a} :: TestEventPattern)

-- | The event, in JSON format, to test against the event pattern. The JSON
-- must follow the format specified in
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/aws-events.html Amazon Web Services Events>,
-- and the following fields are mandatory:
--
-- -   @id@
--
-- -   @account@
--
-- -   @source@
--
-- -   @time@
--
-- -   @region@
--
-- -   @resources@
--
-- -   @detail-type@
testEventPattern_event :: Lens.Lens' TestEventPattern Prelude.Text
testEventPattern_event :: Lens' TestEventPattern Text
testEventPattern_event = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestEventPattern' {Text
event :: Text
$sel:event:TestEventPattern' :: TestEventPattern -> Text
event} -> Text
event) (\s :: TestEventPattern
s@TestEventPattern' {} Text
a -> TestEventPattern
s {$sel:event:TestEventPattern' :: Text
event = Text
a} :: TestEventPattern)

instance Core.AWSRequest TestEventPattern where
  type
    AWSResponse TestEventPattern =
      TestEventPatternResponse
  request :: (Service -> Service)
-> TestEventPattern -> Request TestEventPattern
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 TestEventPattern
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TestEventPattern)))
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 -> TestEventPatternResponse
TestEventPatternResponse'
            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
"Result")
            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 TestEventPattern where
  hashWithSalt :: Int -> TestEventPattern -> Int
hashWithSalt Int
_salt TestEventPattern' {Text
event :: Text
eventPattern :: Text
$sel:event:TestEventPattern' :: TestEventPattern -> Text
$sel:eventPattern:TestEventPattern' :: TestEventPattern -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventPattern
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
event

instance Prelude.NFData TestEventPattern where
  rnf :: TestEventPattern -> ()
rnf TestEventPattern' {Text
event :: Text
eventPattern :: Text
$sel:event:TestEventPattern' :: TestEventPattern -> Text
$sel:eventPattern:TestEventPattern' :: TestEventPattern -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
eventPattern
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
event

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

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

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

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

-- |
-- Create a value of 'TestEventPatternResponse' 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:
--
-- 'result', 'testEventPatternResponse_result' - Indicates whether the event matches the event pattern.
--
-- 'httpStatus', 'testEventPatternResponse_httpStatus' - The response's http status code.
newTestEventPatternResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestEventPatternResponse
newTestEventPatternResponse :: Int -> TestEventPatternResponse
newTestEventPatternResponse Int
pHttpStatus_ =
  TestEventPatternResponse'
    { $sel:result:TestEventPatternResponse' :: Maybe Bool
result = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestEventPatternResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether the event matches the event pattern.
testEventPatternResponse_result :: Lens.Lens' TestEventPatternResponse (Prelude.Maybe Prelude.Bool)
testEventPatternResponse_result :: Lens' TestEventPatternResponse (Maybe Bool)
testEventPatternResponse_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestEventPatternResponse' {Maybe Bool
result :: Maybe Bool
$sel:result:TestEventPatternResponse' :: TestEventPatternResponse -> Maybe Bool
result} -> Maybe Bool
result) (\s :: TestEventPatternResponse
s@TestEventPatternResponse' {} Maybe Bool
a -> TestEventPatternResponse
s {$sel:result:TestEventPatternResponse' :: Maybe Bool
result = Maybe Bool
a} :: TestEventPatternResponse)

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

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