{-# 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.AppSync.CreateApiKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a unique key that you can distribute to clients who invoke your
-- API.
module Amazonka.AppSync.CreateApiKey
  ( -- * Creating a Request
    CreateApiKey (..),
    newCreateApiKey,

    -- * Request Lenses
    createApiKey_description,
    createApiKey_expires,
    createApiKey_apiId,

    -- * Destructuring the Response
    CreateApiKeyResponse (..),
    newCreateApiKeyResponse,

    -- * Response Lenses
    createApiKeyResponse_apiKey,
    createApiKeyResponse_httpStatus,
  )
where

import Amazonka.AppSync.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:/ 'newCreateApiKey' smart constructor.
data CreateApiKey = CreateApiKey'
  { -- | A description of the purpose of the API key.
    CreateApiKey -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | From the creation time, the time after which the API key expires. The
    -- date is represented as seconds since the epoch, rounded down to the
    -- nearest hour. The default value for this parameter is 7 days from
    -- creation time. For more information, see .
    CreateApiKey -> Maybe Integer
expires :: Prelude.Maybe Prelude.Integer,
    -- | The ID for your GraphQL API.
    CreateApiKey -> Text
apiId :: Prelude.Text
  }
  deriving (CreateApiKey -> CreateApiKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateApiKey -> CreateApiKey -> Bool
$c/= :: CreateApiKey -> CreateApiKey -> Bool
== :: CreateApiKey -> CreateApiKey -> Bool
$c== :: CreateApiKey -> CreateApiKey -> Bool
Prelude.Eq, ReadPrec [CreateApiKey]
ReadPrec CreateApiKey
Int -> ReadS CreateApiKey
ReadS [CreateApiKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateApiKey]
$creadListPrec :: ReadPrec [CreateApiKey]
readPrec :: ReadPrec CreateApiKey
$creadPrec :: ReadPrec CreateApiKey
readList :: ReadS [CreateApiKey]
$creadList :: ReadS [CreateApiKey]
readsPrec :: Int -> ReadS CreateApiKey
$creadsPrec :: Int -> ReadS CreateApiKey
Prelude.Read, Int -> CreateApiKey -> ShowS
[CreateApiKey] -> ShowS
CreateApiKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateApiKey] -> ShowS
$cshowList :: [CreateApiKey] -> ShowS
show :: CreateApiKey -> String
$cshow :: CreateApiKey -> String
showsPrec :: Int -> CreateApiKey -> ShowS
$cshowsPrec :: Int -> CreateApiKey -> ShowS
Prelude.Show, forall x. Rep CreateApiKey x -> CreateApiKey
forall x. CreateApiKey -> Rep CreateApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateApiKey x -> CreateApiKey
$cfrom :: forall x. CreateApiKey -> Rep CreateApiKey x
Prelude.Generic)

-- |
-- Create a value of 'CreateApiKey' 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:
--
-- 'description', 'createApiKey_description' - A description of the purpose of the API key.
--
-- 'expires', 'createApiKey_expires' - From the creation time, the time after which the API key expires. The
-- date is represented as seconds since the epoch, rounded down to the
-- nearest hour. The default value for this parameter is 7 days from
-- creation time. For more information, see .
--
-- 'apiId', 'createApiKey_apiId' - The ID for your GraphQL API.
newCreateApiKey ::
  -- | 'apiId'
  Prelude.Text ->
  CreateApiKey
newCreateApiKey :: Text -> CreateApiKey
newCreateApiKey Text
pApiId_ =
  CreateApiKey'
    { $sel:description:CreateApiKey' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:expires:CreateApiKey' :: Maybe Integer
expires = forall a. Maybe a
Prelude.Nothing,
      $sel:apiId:CreateApiKey' :: Text
apiId = Text
pApiId_
    }

-- | A description of the purpose of the API key.
createApiKey_description :: Lens.Lens' CreateApiKey (Prelude.Maybe Prelude.Text)
createApiKey_description :: Lens' CreateApiKey (Maybe Text)
createApiKey_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiKey' {Maybe Text
description :: Maybe Text
$sel:description:CreateApiKey' :: CreateApiKey -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateApiKey
s@CreateApiKey' {} Maybe Text
a -> CreateApiKey
s {$sel:description:CreateApiKey' :: Maybe Text
description = Maybe Text
a} :: CreateApiKey)

-- | From the creation time, the time after which the API key expires. The
-- date is represented as seconds since the epoch, rounded down to the
-- nearest hour. The default value for this parameter is 7 days from
-- creation time. For more information, see .
createApiKey_expires :: Lens.Lens' CreateApiKey (Prelude.Maybe Prelude.Integer)
createApiKey_expires :: Lens' CreateApiKey (Maybe Integer)
createApiKey_expires = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiKey' {Maybe Integer
expires :: Maybe Integer
$sel:expires:CreateApiKey' :: CreateApiKey -> Maybe Integer
expires} -> Maybe Integer
expires) (\s :: CreateApiKey
s@CreateApiKey' {} Maybe Integer
a -> CreateApiKey
s {$sel:expires:CreateApiKey' :: Maybe Integer
expires = Maybe Integer
a} :: CreateApiKey)

-- | The ID for your GraphQL API.
createApiKey_apiId :: Lens.Lens' CreateApiKey Prelude.Text
createApiKey_apiId :: Lens' CreateApiKey Text
createApiKey_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiKey' {Text
apiId :: Text
$sel:apiId:CreateApiKey' :: CreateApiKey -> Text
apiId} -> Text
apiId) (\s :: CreateApiKey
s@CreateApiKey' {} Text
a -> CreateApiKey
s {$sel:apiId:CreateApiKey' :: Text
apiId = Text
a} :: CreateApiKey)

instance Core.AWSRequest CreateApiKey where
  type AWSResponse CreateApiKey = CreateApiKeyResponse
  request :: (Service -> Service) -> CreateApiKey -> Request CreateApiKey
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 CreateApiKey
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateApiKey)))
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 ApiKey -> Int -> CreateApiKeyResponse
CreateApiKeyResponse'
            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
"apiKey")
            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 CreateApiKey where
  hashWithSalt :: Int -> CreateApiKey -> Int
hashWithSalt Int
_salt CreateApiKey' {Maybe Integer
Maybe Text
Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:apiId:CreateApiKey' :: CreateApiKey -> Text
$sel:expires:CreateApiKey' :: CreateApiKey -> Maybe Integer
$sel:description:CreateApiKey' :: CreateApiKey -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
expires
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId

instance Prelude.NFData CreateApiKey where
  rnf :: CreateApiKey -> ()
rnf CreateApiKey' {Maybe Integer
Maybe Text
Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:apiId:CreateApiKey' :: CreateApiKey -> Text
$sel:expires:CreateApiKey' :: CreateApiKey -> Maybe Integer
$sel:description:CreateApiKey' :: CreateApiKey -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
expires
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId

instance Data.ToHeaders CreateApiKey where
  toHeaders :: CreateApiKey -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateApiKey where
  toJSON :: CreateApiKey -> Value
toJSON CreateApiKey' {Maybe Integer
Maybe Text
Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:apiId:CreateApiKey' :: CreateApiKey -> Text
$sel:expires:CreateApiKey' :: CreateApiKey -> Maybe Integer
$sel:description:CreateApiKey' :: CreateApiKey -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"expires" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Integer
expires
          ]
      )

instance Data.ToPath CreateApiKey where
  toPath :: CreateApiKey -> ByteString
toPath CreateApiKey' {Maybe Integer
Maybe Text
Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:apiId:CreateApiKey' :: CreateApiKey -> Text
$sel:expires:CreateApiKey' :: CreateApiKey -> Maybe Integer
$sel:description:CreateApiKey' :: CreateApiKey -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/apis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId, ByteString
"/apikeys"]

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

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

-- |
-- Create a value of 'CreateApiKeyResponse' 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:
--
-- 'apiKey', 'createApiKeyResponse_apiKey' - The API key.
--
-- 'httpStatus', 'createApiKeyResponse_httpStatus' - The response's http status code.
newCreateApiKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateApiKeyResponse
newCreateApiKeyResponse :: Int -> CreateApiKeyResponse
newCreateApiKeyResponse Int
pHttpStatus_ =
  CreateApiKeyResponse'
    { $sel:apiKey:CreateApiKeyResponse' :: Maybe ApiKey
apiKey = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateApiKeyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The API key.
createApiKeyResponse_apiKey :: Lens.Lens' CreateApiKeyResponse (Prelude.Maybe ApiKey)
createApiKeyResponse_apiKey :: Lens' CreateApiKeyResponse (Maybe ApiKey)
createApiKeyResponse_apiKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateApiKeyResponse' {Maybe ApiKey
apiKey :: Maybe ApiKey
$sel:apiKey:CreateApiKeyResponse' :: CreateApiKeyResponse -> Maybe ApiKey
apiKey} -> Maybe ApiKey
apiKey) (\s :: CreateApiKeyResponse
s@CreateApiKeyResponse' {} Maybe ApiKey
a -> CreateApiKeyResponse
s {$sel:apiKey:CreateApiKeyResponse' :: Maybe ApiKey
apiKey = Maybe ApiKey
a} :: CreateApiKeyResponse)

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

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