{-# 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.GetFunction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the code of a CloudFront function. To get configuration information
-- and metadata about a function, use @DescribeFunction@.
--
-- To get a function\'s code, you must provide the function\'s name and
-- stage. To get these values, you can use @ListFunctions@.
module Amazonka.CloudFront.GetFunction
  ( -- * Creating a Request
    GetFunction (..),
    newGetFunction,

    -- * Request Lenses
    getFunction_stage,
    getFunction_name,

    -- * Destructuring the Response
    GetFunctionResponse (..),
    newGetFunctionResponse,

    -- * Response Lenses
    getFunctionResponse_contentType,
    getFunctionResponse_eTag,
    getFunctionResponse_functionCode,
    getFunctionResponse_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:/ 'newGetFunction' smart constructor.
data GetFunction = GetFunction'
  { -- | The function\'s stage, either @DEVELOPMENT@ or @LIVE@.
    GetFunction -> Maybe FunctionStage
stage :: Prelude.Maybe FunctionStage,
    -- | The name of the function whose code you are getting.
    GetFunction -> Text
name :: Prelude.Text
  }
  deriving (GetFunction -> GetFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFunction -> GetFunction -> Bool
$c/= :: GetFunction -> GetFunction -> Bool
== :: GetFunction -> GetFunction -> Bool
$c== :: GetFunction -> GetFunction -> Bool
Prelude.Eq, ReadPrec [GetFunction]
ReadPrec GetFunction
Int -> ReadS GetFunction
ReadS [GetFunction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFunction]
$creadListPrec :: ReadPrec [GetFunction]
readPrec :: ReadPrec GetFunction
$creadPrec :: ReadPrec GetFunction
readList :: ReadS [GetFunction]
$creadList :: ReadS [GetFunction]
readsPrec :: Int -> ReadS GetFunction
$creadsPrec :: Int -> ReadS GetFunction
Prelude.Read, Int -> GetFunction -> ShowS
[GetFunction] -> ShowS
GetFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFunction] -> ShowS
$cshowList :: [GetFunction] -> ShowS
show :: GetFunction -> String
$cshow :: GetFunction -> String
showsPrec :: Int -> GetFunction -> ShowS
$cshowsPrec :: Int -> GetFunction -> ShowS
Prelude.Show, forall x. Rep GetFunction x -> GetFunction
forall x. GetFunction -> Rep GetFunction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFunction x -> GetFunction
$cfrom :: forall x. GetFunction -> Rep GetFunction x
Prelude.Generic)

-- |
-- Create a value of 'GetFunction' 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', 'getFunction_stage' - The function\'s stage, either @DEVELOPMENT@ or @LIVE@.
--
-- 'name', 'getFunction_name' - The name of the function whose code you are getting.
newGetFunction ::
  -- | 'name'
  Prelude.Text ->
  GetFunction
newGetFunction :: Text -> GetFunction
newGetFunction Text
pName_ =
  GetFunction'
    { $sel:stage:GetFunction' :: Maybe FunctionStage
stage = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetFunction' :: Text
name = Text
pName_
    }

-- | The function\'s stage, either @DEVELOPMENT@ or @LIVE@.
getFunction_stage :: Lens.Lens' GetFunction (Prelude.Maybe FunctionStage)
getFunction_stage :: Lens' GetFunction (Maybe FunctionStage)
getFunction_stage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunction' {Maybe FunctionStage
stage :: Maybe FunctionStage
$sel:stage:GetFunction' :: GetFunction -> Maybe FunctionStage
stage} -> Maybe FunctionStage
stage) (\s :: GetFunction
s@GetFunction' {} Maybe FunctionStage
a -> GetFunction
s {$sel:stage:GetFunction' :: Maybe FunctionStage
stage = Maybe FunctionStage
a} :: GetFunction)

-- | The name of the function whose code you are getting.
getFunction_name :: Lens.Lens' GetFunction Prelude.Text
getFunction_name :: Lens' GetFunction Text
getFunction_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunction' {Text
name :: Text
$sel:name:GetFunction' :: GetFunction -> Text
name} -> Text
name) (\s :: GetFunction
s@GetFunction' {} Text
a -> GetFunction
s {$sel:name:GetFunction' :: Text
name = Text
a} :: GetFunction)

instance Core.AWSRequest GetFunction where
  type AWSResponse GetFunction = GetFunctionResponse
  request :: (Service -> Service) -> GetFunction -> Request GetFunction
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetFunction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFunction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Maybe Text
-> Maybe Text
-> Maybe (Sensitive ByteString)
-> Int
-> GetFunctionResponse
GetFunctionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"ETag")
            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. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
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 GetFunction where
  hashWithSalt :: Int -> GetFunction -> Int
hashWithSalt Int
_salt GetFunction' {Maybe FunctionStage
Text
name :: Text
stage :: Maybe FunctionStage
$sel:name:GetFunction' :: GetFunction -> Text
$sel:stage:GetFunction' :: GetFunction -> 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

instance Prelude.NFData GetFunction where
  rnf :: GetFunction -> ()
rnf GetFunction' {Maybe FunctionStage
Text
name :: Text
stage :: Maybe FunctionStage
$sel:name:GetFunction' :: GetFunction -> Text
$sel:stage:GetFunction' :: GetFunction -> 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

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

instance Data.ToPath GetFunction where
  toPath :: GetFunction -> ByteString
toPath GetFunction' {Maybe FunctionStage
Text
name :: Text
stage :: Maybe FunctionStage
$sel:name:GetFunction' :: GetFunction -> Text
$sel:stage:GetFunction' :: GetFunction -> 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]

instance Data.ToQuery GetFunction where
  toQuery :: GetFunction -> QueryString
toQuery GetFunction' {Maybe FunctionStage
Text
name :: Text
stage :: Maybe FunctionStage
$sel:name:GetFunction' :: GetFunction -> Text
$sel:stage:GetFunction' :: GetFunction -> Maybe FunctionStage
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"Stage" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FunctionStage
stage]

-- | /See:/ 'newGetFunctionResponse' smart constructor.
data GetFunctionResponse = GetFunctionResponse'
  { -- | The content type (media type) of the response.
    GetFunctionResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The version identifier for the current version of the CloudFront
    -- function.
    GetFunctionResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | The function code of a CloudFront function.
    GetFunctionResponse -> Maybe (Sensitive ByteString)
functionCode :: Prelude.Maybe (Data.Sensitive Prelude.ByteString),
    -- | The response's http status code.
    GetFunctionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetFunctionResponse -> GetFunctionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFunctionResponse -> GetFunctionResponse -> Bool
$c/= :: GetFunctionResponse -> GetFunctionResponse -> Bool
== :: GetFunctionResponse -> GetFunctionResponse -> Bool
$c== :: GetFunctionResponse -> GetFunctionResponse -> Bool
Prelude.Eq, Int -> GetFunctionResponse -> ShowS
[GetFunctionResponse] -> ShowS
GetFunctionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFunctionResponse] -> ShowS
$cshowList :: [GetFunctionResponse] -> ShowS
show :: GetFunctionResponse -> String
$cshow :: GetFunctionResponse -> String
showsPrec :: Int -> GetFunctionResponse -> ShowS
$cshowsPrec :: Int -> GetFunctionResponse -> ShowS
Prelude.Show, forall x. Rep GetFunctionResponse x -> GetFunctionResponse
forall x. GetFunctionResponse -> Rep GetFunctionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFunctionResponse x -> GetFunctionResponse
$cfrom :: forall x. GetFunctionResponse -> Rep GetFunctionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFunctionResponse' 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:
--
-- 'contentType', 'getFunctionResponse_contentType' - The content type (media type) of the response.
--
-- 'eTag', 'getFunctionResponse_eTag' - The version identifier for the current version of the CloudFront
-- function.
--
-- 'functionCode', 'getFunctionResponse_functionCode' - The function code of a CloudFront function.
--
-- 'httpStatus', 'getFunctionResponse_httpStatus' - The response's http status code.
newGetFunctionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetFunctionResponse
newGetFunctionResponse :: Int -> GetFunctionResponse
newGetFunctionResponse Int
pHttpStatus_ =
  GetFunctionResponse'
    { $sel:contentType:GetFunctionResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:eTag:GetFunctionResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:functionCode:GetFunctionResponse' :: Maybe (Sensitive ByteString)
functionCode = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetFunctionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The content type (media type) of the response.
getFunctionResponse_contentType :: Lens.Lens' GetFunctionResponse (Prelude.Maybe Prelude.Text)
getFunctionResponse_contentType :: Lens' GetFunctionResponse (Maybe Text)
getFunctionResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunctionResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:GetFunctionResponse' :: GetFunctionResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: GetFunctionResponse
s@GetFunctionResponse' {} Maybe Text
a -> GetFunctionResponse
s {$sel:contentType:GetFunctionResponse' :: Maybe Text
contentType = Maybe Text
a} :: GetFunctionResponse)

-- | The version identifier for the current version of the CloudFront
-- function.
getFunctionResponse_eTag :: Lens.Lens' GetFunctionResponse (Prelude.Maybe Prelude.Text)
getFunctionResponse_eTag :: Lens' GetFunctionResponse (Maybe Text)
getFunctionResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunctionResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:GetFunctionResponse' :: GetFunctionResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: GetFunctionResponse
s@GetFunctionResponse' {} Maybe Text
a -> GetFunctionResponse
s {$sel:eTag:GetFunctionResponse' :: Maybe Text
eTag = Maybe Text
a} :: GetFunctionResponse)

-- | The function code of a CloudFront function.
getFunctionResponse_functionCode :: Lens.Lens' GetFunctionResponse (Prelude.Maybe Prelude.ByteString)
getFunctionResponse_functionCode :: Lens' GetFunctionResponse (Maybe ByteString)
getFunctionResponse_functionCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunctionResponse' {Maybe (Sensitive ByteString)
functionCode :: Maybe (Sensitive ByteString)
$sel:functionCode:GetFunctionResponse' :: GetFunctionResponse -> Maybe (Sensitive ByteString)
functionCode} -> Maybe (Sensitive ByteString)
functionCode) (\s :: GetFunctionResponse
s@GetFunctionResponse' {} Maybe (Sensitive ByteString)
a -> GetFunctionResponse
s {$sel:functionCode:GetFunctionResponse' :: Maybe (Sensitive ByteString)
functionCode = Maybe (Sensitive ByteString)
a} :: GetFunctionResponse) 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 a. Iso' (Sensitive a) a
Data._Sensitive

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

instance Prelude.NFData GetFunctionResponse where
  rnf :: GetFunctionResponse -> ()
rnf GetFunctionResponse' {Int
Maybe Text
Maybe (Sensitive ByteString)
httpStatus :: Int
functionCode :: Maybe (Sensitive ByteString)
eTag :: Maybe Text
contentType :: Maybe Text
$sel:httpStatus:GetFunctionResponse' :: GetFunctionResponse -> Int
$sel:functionCode:GetFunctionResponse' :: GetFunctionResponse -> Maybe (Sensitive ByteString)
$sel:eTag:GetFunctionResponse' :: GetFunctionResponse -> Maybe Text
$sel:contentType:GetFunctionResponse' :: GetFunctionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive ByteString)
functionCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus