{-# 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.PublishFunction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Publishes a CloudFront function by copying the function code from the
-- @DEVELOPMENT@ stage to @LIVE@. This automatically updates all cache
-- behaviors that are using this function to use the newly published copy
-- in the @LIVE@ stage.
--
-- When a function is published to the @LIVE@ stage, you can attach the
-- function to a distribution\'s cache behavior, using the function\'s
-- Amazon Resource Name (ARN).
--
-- To publish a function, you must provide the function\'s name and version
-- (@ETag@ value). To get these values, you can use @ListFunctions@ and
-- @DescribeFunction@.
module Amazonka.CloudFront.PublishFunction
  ( -- * Creating a Request
    PublishFunction (..),
    newPublishFunction,

    -- * Request Lenses
    publishFunction_name,
    publishFunction_ifMatch,

    -- * Destructuring the Response
    PublishFunctionResponse (..),
    newPublishFunctionResponse,

    -- * Response Lenses
    publishFunctionResponse_functionSummary,
    publishFunctionResponse_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:/ 'newPublishFunction' smart constructor.
data PublishFunction = PublishFunction'
  { -- | The name of the function that you are publishing.
    PublishFunction -> Text
name :: Prelude.Text,
    -- | The current version (@ETag@ value) of the function that you are
    -- publishing, which you can get using @DescribeFunction@.
    PublishFunction -> Text
ifMatch :: Prelude.Text
  }
  deriving (PublishFunction -> PublishFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishFunction -> PublishFunction -> Bool
$c/= :: PublishFunction -> PublishFunction -> Bool
== :: PublishFunction -> PublishFunction -> Bool
$c== :: PublishFunction -> PublishFunction -> Bool
Prelude.Eq, ReadPrec [PublishFunction]
ReadPrec PublishFunction
Int -> ReadS PublishFunction
ReadS [PublishFunction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishFunction]
$creadListPrec :: ReadPrec [PublishFunction]
readPrec :: ReadPrec PublishFunction
$creadPrec :: ReadPrec PublishFunction
readList :: ReadS [PublishFunction]
$creadList :: ReadS [PublishFunction]
readsPrec :: Int -> ReadS PublishFunction
$creadsPrec :: Int -> ReadS PublishFunction
Prelude.Read, Int -> PublishFunction -> ShowS
[PublishFunction] -> ShowS
PublishFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishFunction] -> ShowS
$cshowList :: [PublishFunction] -> ShowS
show :: PublishFunction -> String
$cshow :: PublishFunction -> String
showsPrec :: Int -> PublishFunction -> ShowS
$cshowsPrec :: Int -> PublishFunction -> ShowS
Prelude.Show, forall x. Rep PublishFunction x -> PublishFunction
forall x. PublishFunction -> Rep PublishFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublishFunction x -> PublishFunction
$cfrom :: forall x. PublishFunction -> Rep PublishFunction x
Prelude.Generic)

-- |
-- Create a value of 'PublishFunction' 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:
--
-- 'name', 'publishFunction_name' - The name of the function that you are publishing.
--
-- 'ifMatch', 'publishFunction_ifMatch' - The current version (@ETag@ value) of the function that you are
-- publishing, which you can get using @DescribeFunction@.
newPublishFunction ::
  -- | 'name'
  Prelude.Text ->
  -- | 'ifMatch'
  Prelude.Text ->
  PublishFunction
newPublishFunction :: Text -> Text -> PublishFunction
newPublishFunction Text
pName_ Text
pIfMatch_ =
  PublishFunction'
    { $sel:name:PublishFunction' :: Text
name = Text
pName_,
      $sel:ifMatch:PublishFunction' :: Text
ifMatch = Text
pIfMatch_
    }

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

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

instance Core.AWSRequest PublishFunction where
  type
    AWSResponse PublishFunction =
      PublishFunctionResponse
  request :: (Service -> Service) -> PublishFunction -> Request PublishFunction
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.post (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PublishFunction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PublishFunction)))
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 FunctionSummary -> Int -> PublishFunctionResponse
PublishFunctionResponse'
            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 PublishFunction where
  hashWithSalt :: Int -> PublishFunction -> Int
hashWithSalt Int
_salt PublishFunction' {Text
ifMatch :: Text
name :: Text
$sel:ifMatch:PublishFunction' :: PublishFunction -> Text
$sel:name:PublishFunction' :: PublishFunction -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ifMatch

instance Prelude.NFData PublishFunction where
  rnf :: PublishFunction -> ()
rnf PublishFunction' {Text
ifMatch :: Text
name :: Text
$sel:ifMatch:PublishFunction' :: PublishFunction -> Text
$sel:name:PublishFunction' :: PublishFunction -> Text
..} =
    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

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

instance Data.ToPath PublishFunction where
  toPath :: PublishFunction -> ByteString
toPath PublishFunction' {Text
ifMatch :: Text
name :: Text
$sel:ifMatch:PublishFunction' :: PublishFunction -> Text
$sel:name:PublishFunction' :: PublishFunction -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2020-05-31/function/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name, ByteString
"/publish"]

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

-- | /See:/ 'newPublishFunctionResponse' smart constructor.
data PublishFunctionResponse = PublishFunctionResponse'
  { -- | Contains configuration information and metadata about a CloudFront
    -- function.
    PublishFunctionResponse -> Maybe FunctionSummary
functionSummary :: Prelude.Maybe FunctionSummary,
    -- | The response's http status code.
    PublishFunctionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PublishFunctionResponse -> PublishFunctionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishFunctionResponse -> PublishFunctionResponse -> Bool
$c/= :: PublishFunctionResponse -> PublishFunctionResponse -> Bool
== :: PublishFunctionResponse -> PublishFunctionResponse -> Bool
$c== :: PublishFunctionResponse -> PublishFunctionResponse -> Bool
Prelude.Eq, ReadPrec [PublishFunctionResponse]
ReadPrec PublishFunctionResponse
Int -> ReadS PublishFunctionResponse
ReadS [PublishFunctionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishFunctionResponse]
$creadListPrec :: ReadPrec [PublishFunctionResponse]
readPrec :: ReadPrec PublishFunctionResponse
$creadPrec :: ReadPrec PublishFunctionResponse
readList :: ReadS [PublishFunctionResponse]
$creadList :: ReadS [PublishFunctionResponse]
readsPrec :: Int -> ReadS PublishFunctionResponse
$creadsPrec :: Int -> ReadS PublishFunctionResponse
Prelude.Read, Int -> PublishFunctionResponse -> ShowS
[PublishFunctionResponse] -> ShowS
PublishFunctionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishFunctionResponse] -> ShowS
$cshowList :: [PublishFunctionResponse] -> ShowS
show :: PublishFunctionResponse -> String
$cshow :: PublishFunctionResponse -> String
showsPrec :: Int -> PublishFunctionResponse -> ShowS
$cshowsPrec :: Int -> PublishFunctionResponse -> ShowS
Prelude.Show, forall x. Rep PublishFunctionResponse x -> PublishFunctionResponse
forall x. PublishFunctionResponse -> Rep PublishFunctionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublishFunctionResponse x -> PublishFunctionResponse
$cfrom :: forall x. PublishFunctionResponse -> Rep PublishFunctionResponse x
Prelude.Generic)

-- |
-- Create a value of 'PublishFunctionResponse' 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:
--
-- 'functionSummary', 'publishFunctionResponse_functionSummary' - Contains configuration information and metadata about a CloudFront
-- function.
--
-- 'httpStatus', 'publishFunctionResponse_httpStatus' - The response's http status code.
newPublishFunctionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PublishFunctionResponse
newPublishFunctionResponse :: Int -> PublishFunctionResponse
newPublishFunctionResponse Int
pHttpStatus_ =
  PublishFunctionResponse'
    { $sel:functionSummary:PublishFunctionResponse' :: Maybe FunctionSummary
functionSummary =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PublishFunctionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains configuration information and metadata about a CloudFront
-- function.
publishFunctionResponse_functionSummary :: Lens.Lens' PublishFunctionResponse (Prelude.Maybe FunctionSummary)
publishFunctionResponse_functionSummary :: Lens' PublishFunctionResponse (Maybe FunctionSummary)
publishFunctionResponse_functionSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublishFunctionResponse' {Maybe FunctionSummary
functionSummary :: Maybe FunctionSummary
$sel:functionSummary:PublishFunctionResponse' :: PublishFunctionResponse -> Maybe FunctionSummary
functionSummary} -> Maybe FunctionSummary
functionSummary) (\s :: PublishFunctionResponse
s@PublishFunctionResponse' {} Maybe FunctionSummary
a -> PublishFunctionResponse
s {$sel:functionSummary:PublishFunctionResponse' :: Maybe FunctionSummary
functionSummary = Maybe FunctionSummary
a} :: PublishFunctionResponse)

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

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