{-# 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.CloudFront.TestFunction
-- 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 a CloudFront function.
--
-- To test a function, you provide an /event object/ that represents an
-- HTTP request or response that your CloudFront distribution could receive
-- in production. CloudFront runs the function, passing it the event object
-- that you provided, and returns the function\'s result (the modified
-- event object) in the response. The response also contains function logs
-- and error messages, if any exist. For more information about testing
-- functions, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/managing-functions.html#test-function Testing functions>
-- in the /Amazon CloudFront Developer Guide/.
--
-- To test a function, you provide the function\'s name and version (@ETag@
-- value) along with the event object. To get the function\'s name and
-- version, you can use @ListFunctions@ and @DescribeFunction@.
module Amazonka.CloudFront.TestFunction
  ( -- * Creating a Request
    TestFunction (..),
    newTestFunction,

    -- * Request Lenses
    testFunction_stage,
    testFunction_name,
    testFunction_ifMatch,
    testFunction_eventObject,

    -- * Destructuring the Response
    TestFunctionResponse (..),
    newTestFunctionResponse,

    -- * Response Lenses
    testFunctionResponse_testResult,
    testFunctionResponse_httpStatus,
  )
where

import Amazonka.CloudFront.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:/ 'newTestFunction' smart constructor.
data TestFunction = TestFunction'
  { -- | The stage of the function that you are testing, either @DEVELOPMENT@ or
    -- @LIVE@.
    TestFunction -> Maybe FunctionStage
stage :: Prelude.Maybe FunctionStage,
    -- | The name of the function that you are testing.
    TestFunction -> Text
name :: Prelude.Text,
    -- | The current version (@ETag@ value) of the function that you are testing,
    -- which you can get using @DescribeFunction@.
    TestFunction -> Text
ifMatch :: Prelude.Text,
    -- | The event object to test the function with. For more information about
    -- the structure of the event object, see
    -- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/managing-functions.html#test-function Testing functions>
    -- in the /Amazon CloudFront Developer Guide/.
    TestFunction -> Sensitive Base64
eventObject :: Data.Sensitive Data.Base64
  }
  deriving (TestFunction -> TestFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestFunction -> TestFunction -> Bool
$c/= :: TestFunction -> TestFunction -> Bool
== :: TestFunction -> TestFunction -> Bool
$c== :: TestFunction -> TestFunction -> Bool
Prelude.Eq, Int -> TestFunction -> ShowS
[TestFunction] -> ShowS
TestFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestFunction] -> ShowS
$cshowList :: [TestFunction] -> ShowS
show :: TestFunction -> String
$cshow :: TestFunction -> String
showsPrec :: Int -> TestFunction -> ShowS
$cshowsPrec :: Int -> TestFunction -> ShowS
Prelude.Show, forall x. Rep TestFunction x -> TestFunction
forall x. TestFunction -> Rep TestFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestFunction x -> TestFunction
$cfrom :: forall x. TestFunction -> Rep TestFunction x
Prelude.Generic)

-- |
-- Create a value of 'TestFunction' 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:
--
-- 'stage', 'testFunction_stage' - The stage of the function that you are testing, either @DEVELOPMENT@ or
-- @LIVE@.
--
-- 'name', 'testFunction_name' - The name of the function that you are testing.
--
-- 'ifMatch', 'testFunction_ifMatch' - The current version (@ETag@ value) of the function that you are testing,
-- which you can get using @DescribeFunction@.
--
-- 'eventObject', 'testFunction_eventObject' - The event object to test the function with. For more information about
-- the structure of the event object, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/managing-functions.html#test-function Testing functions>
-- in the /Amazon CloudFront Developer Guide/.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
newTestFunction ::
  -- | 'name'
  Prelude.Text ->
  -- | 'ifMatch'
  Prelude.Text ->
  -- | 'eventObject'
  Prelude.ByteString ->
  TestFunction
newTestFunction :: Text -> Text -> ByteString -> TestFunction
newTestFunction Text
pName_ Text
pIfMatch_ ByteString
pEventObject_ =
  TestFunction'
    { $sel:stage:TestFunction' :: Maybe FunctionStage
stage = forall a. Maybe a
Prelude.Nothing,
      $sel:name:TestFunction' :: Text
name = Text
pName_,
      $sel:ifMatch:TestFunction' :: Text
ifMatch = Text
pIfMatch_,
      $sel:eventObject:TestFunction' :: Sensitive Base64
eventObject =
        forall a. Iso' (Sensitive a) a
Data._Sensitive
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64
          forall t b. AReview t b -> b -> t
Lens.# ByteString
pEventObject_
    }

-- | The stage of the function that you are testing, either @DEVELOPMENT@ or
-- @LIVE@.
testFunction_stage :: Lens.Lens' TestFunction (Prelude.Maybe FunctionStage)
testFunction_stage :: Lens' TestFunction (Maybe FunctionStage)
testFunction_stage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestFunction' {Maybe FunctionStage
stage :: Maybe FunctionStage
$sel:stage:TestFunction' :: TestFunction -> Maybe FunctionStage
stage} -> Maybe FunctionStage
stage) (\s :: TestFunction
s@TestFunction' {} Maybe FunctionStage
a -> TestFunction
s {$sel:stage:TestFunction' :: Maybe FunctionStage
stage = Maybe FunctionStage
a} :: TestFunction)

-- | The name of the function that you are testing.
testFunction_name :: Lens.Lens' TestFunction Prelude.Text
testFunction_name :: Lens' TestFunction Text
testFunction_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestFunction' {Text
name :: Text
$sel:name:TestFunction' :: TestFunction -> Text
name} -> Text
name) (\s :: TestFunction
s@TestFunction' {} Text
a -> TestFunction
s {$sel:name:TestFunction' :: Text
name = Text
a} :: TestFunction)

-- | The current version (@ETag@ value) of the function that you are testing,
-- which you can get using @DescribeFunction@.
testFunction_ifMatch :: Lens.Lens' TestFunction Prelude.Text
testFunction_ifMatch :: Lens' TestFunction Text
testFunction_ifMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestFunction' {Text
ifMatch :: Text
$sel:ifMatch:TestFunction' :: TestFunction -> Text
ifMatch} -> Text
ifMatch) (\s :: TestFunction
s@TestFunction' {} Text
a -> TestFunction
s {$sel:ifMatch:TestFunction' :: Text
ifMatch = Text
a} :: TestFunction)

-- | The event object to test the function with. For more information about
-- the structure of the event object, see
-- <https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/managing-functions.html#test-function Testing functions>
-- in the /Amazon CloudFront Developer Guide/.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
testFunction_eventObject :: Lens.Lens' TestFunction Prelude.ByteString
testFunction_eventObject :: Lens' TestFunction ByteString
testFunction_eventObject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestFunction' {Sensitive Base64
eventObject :: Sensitive Base64
$sel:eventObject:TestFunction' :: TestFunction -> Sensitive Base64
eventObject} -> Sensitive Base64
eventObject) (\s :: TestFunction
s@TestFunction' {} Sensitive Base64
a -> TestFunction
s {$sel:eventObject:TestFunction' :: Sensitive Base64
eventObject = Sensitive Base64
a} :: TestFunction) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Core.AWSRequest TestFunction where
  type AWSResponse TestFunction = TestFunctionResponse
  request :: (Service -> Service) -> TestFunction -> Request TestFunction
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy TestFunction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TestFunction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe TestResult -> Int -> TestFunctionResponse
TestFunctionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            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 TestFunction where
  hashWithSalt :: Int -> TestFunction -> Int
hashWithSalt Int
_salt TestFunction' {Maybe FunctionStage
Text
Sensitive Base64
eventObject :: Sensitive Base64
ifMatch :: Text
name :: Text
stage :: Maybe FunctionStage
$sel:eventObject:TestFunction' :: TestFunction -> Sensitive Base64
$sel:ifMatch:TestFunction' :: TestFunction -> Text
$sel:name:TestFunction' :: TestFunction -> Text
$sel:stage:TestFunction' :: TestFunction -> Maybe FunctionStage
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FunctionStage
stage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ifMatch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Base64
eventObject

instance Prelude.NFData TestFunction where
  rnf :: TestFunction -> ()
rnf TestFunction' {Maybe FunctionStage
Text
Sensitive Base64
eventObject :: Sensitive Base64
ifMatch :: Text
name :: Text
stage :: Maybe FunctionStage
$sel:eventObject:TestFunction' :: TestFunction -> Sensitive Base64
$sel:ifMatch:TestFunction' :: TestFunction -> Text
$sel:name:TestFunction' :: TestFunction -> Text
$sel:stage:TestFunction' :: TestFunction -> Maybe FunctionStage
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FunctionStage
stage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ifMatch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Base64
eventObject

instance Data.ToElement TestFunction where
  toElement :: TestFunction -> Element
toElement =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://cloudfront.amazonaws.com/doc/2020-05-31/}TestFunctionRequest"

instance Data.ToHeaders TestFunction where
  toHeaders :: TestFunction -> ResponseHeaders
toHeaders TestFunction' {Maybe FunctionStage
Text
Sensitive Base64
eventObject :: Sensitive Base64
ifMatch :: Text
name :: Text
stage :: Maybe FunctionStage
$sel:eventObject:TestFunction' :: TestFunction -> Sensitive Base64
$sel:ifMatch:TestFunction' :: TestFunction -> Text
$sel:name:TestFunction' :: TestFunction -> Text
$sel:stage:TestFunction' :: TestFunction -> Maybe FunctionStage
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [HeaderName
"If-Match" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
ifMatch]

instance Data.ToPath TestFunction where
  toPath :: TestFunction -> ByteString
toPath TestFunction' {Maybe FunctionStage
Text
Sensitive Base64
eventObject :: Sensitive Base64
ifMatch :: Text
name :: Text
stage :: Maybe FunctionStage
$sel:eventObject:TestFunction' :: TestFunction -> Sensitive Base64
$sel:ifMatch:TestFunction' :: TestFunction -> Text
$sel:name:TestFunction' :: TestFunction -> Text
$sel:stage:TestFunction' :: TestFunction -> Maybe FunctionStage
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2020-05-31/function/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name, ByteString
"/test"]

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

instance Data.ToXML TestFunction where
  toXML :: TestFunction -> XML
toXML TestFunction' {Maybe FunctionStage
Text
Sensitive Base64
eventObject :: Sensitive Base64
ifMatch :: Text
name :: Text
stage :: Maybe FunctionStage
$sel:eventObject:TestFunction' :: TestFunction -> Sensitive Base64
$sel:ifMatch:TestFunction' :: TestFunction -> Text
$sel:name:TestFunction' :: TestFunction -> Text
$sel:stage:TestFunction' :: TestFunction -> Maybe FunctionStage
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"Stage" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe FunctionStage
stage,
        Name
"EventObject" forall a. ToXML a => Name -> a -> XML
Data.@= Sensitive Base64
eventObject
      ]

-- | /See:/ 'newTestFunctionResponse' smart constructor.
data TestFunctionResponse = TestFunctionResponse'
  { -- | An object that represents the result of running the function with the
    -- provided event object.
    TestFunctionResponse -> Maybe TestResult
testResult :: Prelude.Maybe TestResult,
    -- | The response's http status code.
    TestFunctionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestFunctionResponse -> TestFunctionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestFunctionResponse -> TestFunctionResponse -> Bool
$c/= :: TestFunctionResponse -> TestFunctionResponse -> Bool
== :: TestFunctionResponse -> TestFunctionResponse -> Bool
$c== :: TestFunctionResponse -> TestFunctionResponse -> Bool
Prelude.Eq, Int -> TestFunctionResponse -> ShowS
[TestFunctionResponse] -> ShowS
TestFunctionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestFunctionResponse] -> ShowS
$cshowList :: [TestFunctionResponse] -> ShowS
show :: TestFunctionResponse -> String
$cshow :: TestFunctionResponse -> String
showsPrec :: Int -> TestFunctionResponse -> ShowS
$cshowsPrec :: Int -> TestFunctionResponse -> ShowS
Prelude.Show, forall x. Rep TestFunctionResponse x -> TestFunctionResponse
forall x. TestFunctionResponse -> Rep TestFunctionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestFunctionResponse x -> TestFunctionResponse
$cfrom :: forall x. TestFunctionResponse -> Rep TestFunctionResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestFunctionResponse' 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:
--
-- 'testResult', 'testFunctionResponse_testResult' - An object that represents the result of running the function with the
-- provided event object.
--
-- 'httpStatus', 'testFunctionResponse_httpStatus' - The response's http status code.
newTestFunctionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestFunctionResponse
newTestFunctionResponse :: Int -> TestFunctionResponse
newTestFunctionResponse Int
pHttpStatus_ =
  TestFunctionResponse'
    { $sel:testResult:TestFunctionResponse' :: Maybe TestResult
testResult = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestFunctionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that represents the result of running the function with the
-- provided event object.
testFunctionResponse_testResult :: Lens.Lens' TestFunctionResponse (Prelude.Maybe TestResult)
testFunctionResponse_testResult :: Lens' TestFunctionResponse (Maybe TestResult)
testFunctionResponse_testResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestFunctionResponse' {Maybe TestResult
testResult :: Maybe TestResult
$sel:testResult:TestFunctionResponse' :: TestFunctionResponse -> Maybe TestResult
testResult} -> Maybe TestResult
testResult) (\s :: TestFunctionResponse
s@TestFunctionResponse' {} Maybe TestResult
a -> TestFunctionResponse
s {$sel:testResult:TestFunctionResponse' :: Maybe TestResult
testResult = Maybe TestResult
a} :: TestFunctionResponse)

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

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