{-# 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.UpdateApiKey
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an API key. You can update the key as long as it\'s not deleted.
module Amazonka.AppSync.UpdateApiKey
  ( -- * Creating a Request
    UpdateApiKey (..),
    newUpdateApiKey,

    -- * Request Lenses
    updateApiKey_description,
    updateApiKey_expires,
    updateApiKey_apiId,
    updateApiKey_id,

    -- * Destructuring the Response
    UpdateApiKeyResponse (..),
    newUpdateApiKeyResponse,

    -- * Response Lenses
    updateApiKeyResponse_apiKey,
    updateApiKeyResponse_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:/ 'newUpdateApiKey' smart constructor.
data UpdateApiKey = UpdateApiKey'
  { -- | A description of the purpose of the API key.
    UpdateApiKey -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | From the update time, the time after which the API key expires. The date
    -- is represented as seconds since the epoch. For more information, see .
    UpdateApiKey -> Maybe Integer
expires :: Prelude.Maybe Prelude.Integer,
    -- | The ID for the GraphQL API.
    UpdateApiKey -> Text
apiId :: Prelude.Text,
    -- | The API key ID.
    UpdateApiKey -> Text
id :: Prelude.Text
  }
  deriving (UpdateApiKey -> UpdateApiKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateApiKey -> UpdateApiKey -> Bool
$c/= :: UpdateApiKey -> UpdateApiKey -> Bool
== :: UpdateApiKey -> UpdateApiKey -> Bool
$c== :: UpdateApiKey -> UpdateApiKey -> Bool
Prelude.Eq, ReadPrec [UpdateApiKey]
ReadPrec UpdateApiKey
Int -> ReadS UpdateApiKey
ReadS [UpdateApiKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateApiKey]
$creadListPrec :: ReadPrec [UpdateApiKey]
readPrec :: ReadPrec UpdateApiKey
$creadPrec :: ReadPrec UpdateApiKey
readList :: ReadS [UpdateApiKey]
$creadList :: ReadS [UpdateApiKey]
readsPrec :: Int -> ReadS UpdateApiKey
$creadsPrec :: Int -> ReadS UpdateApiKey
Prelude.Read, Int -> UpdateApiKey -> ShowS
[UpdateApiKey] -> ShowS
UpdateApiKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateApiKey] -> ShowS
$cshowList :: [UpdateApiKey] -> ShowS
show :: UpdateApiKey -> String
$cshow :: UpdateApiKey -> String
showsPrec :: Int -> UpdateApiKey -> ShowS
$cshowsPrec :: Int -> UpdateApiKey -> ShowS
Prelude.Show, forall x. Rep UpdateApiKey x -> UpdateApiKey
forall x. UpdateApiKey -> Rep UpdateApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateApiKey x -> UpdateApiKey
$cfrom :: forall x. UpdateApiKey -> Rep UpdateApiKey x
Prelude.Generic)

-- |
-- Create a value of 'UpdateApiKey' 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', 'updateApiKey_description' - A description of the purpose of the API key.
--
-- 'expires', 'updateApiKey_expires' - From the update time, the time after which the API key expires. The date
-- is represented as seconds since the epoch. For more information, see .
--
-- 'apiId', 'updateApiKey_apiId' - The ID for the GraphQL API.
--
-- 'id', 'updateApiKey_id' - The API key ID.
newUpdateApiKey ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  UpdateApiKey
newUpdateApiKey :: Text -> Text -> UpdateApiKey
newUpdateApiKey Text
pApiId_ Text
pId_ =
  UpdateApiKey'
    { $sel:description:UpdateApiKey' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:expires:UpdateApiKey' :: Maybe Integer
expires = forall a. Maybe a
Prelude.Nothing,
      $sel:apiId:UpdateApiKey' :: Text
apiId = Text
pApiId_,
      $sel:id:UpdateApiKey' :: Text
id = Text
pId_
    }

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

-- | From the update time, the time after which the API key expires. The date
-- is represented as seconds since the epoch. For more information, see .
updateApiKey_expires :: Lens.Lens' UpdateApiKey (Prelude.Maybe Prelude.Integer)
updateApiKey_expires :: Lens' UpdateApiKey (Maybe Integer)
updateApiKey_expires = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApiKey' {Maybe Integer
expires :: Maybe Integer
$sel:expires:UpdateApiKey' :: UpdateApiKey -> Maybe Integer
expires} -> Maybe Integer
expires) (\s :: UpdateApiKey
s@UpdateApiKey' {} Maybe Integer
a -> UpdateApiKey
s {$sel:expires:UpdateApiKey' :: Maybe Integer
expires = Maybe Integer
a} :: UpdateApiKey)

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

-- | The API key ID.
updateApiKey_id :: Lens.Lens' UpdateApiKey Prelude.Text
updateApiKey_id :: Lens' UpdateApiKey Text
updateApiKey_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateApiKey' {Text
id :: Text
$sel:id:UpdateApiKey' :: UpdateApiKey -> Text
id} -> Text
id) (\s :: UpdateApiKey
s@UpdateApiKey' {} Text
a -> UpdateApiKey
s {$sel:id:UpdateApiKey' :: Text
id = Text
a} :: UpdateApiKey)

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

instance Prelude.NFData UpdateApiKey where
  rnf :: UpdateApiKey -> ()
rnf UpdateApiKey' {Maybe Integer
Maybe Text
Text
id :: Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:id:UpdateApiKey' :: UpdateApiKey -> Text
$sel:apiId:UpdateApiKey' :: UpdateApiKey -> Text
$sel:expires:UpdateApiKey' :: UpdateApiKey -> Maybe Integer
$sel:description:UpdateApiKey' :: UpdateApiKey -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders UpdateApiKey where
  toHeaders :: UpdateApiKey -> 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 UpdateApiKey where
  toJSON :: UpdateApiKey -> Value
toJSON UpdateApiKey' {Maybe Integer
Maybe Text
Text
id :: Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:id:UpdateApiKey' :: UpdateApiKey -> Text
$sel:apiId:UpdateApiKey' :: UpdateApiKey -> Text
$sel:expires:UpdateApiKey' :: UpdateApiKey -> Maybe Integer
$sel:description:UpdateApiKey' :: UpdateApiKey -> 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 UpdateApiKey where
  toPath :: UpdateApiKey -> ByteString
toPath UpdateApiKey' {Maybe Integer
Maybe Text
Text
id :: Text
apiId :: Text
expires :: Maybe Integer
description :: Maybe Text
$sel:id:UpdateApiKey' :: UpdateApiKey -> Text
$sel:apiId:UpdateApiKey' :: UpdateApiKey -> Text
$sel:expires:UpdateApiKey' :: UpdateApiKey -> Maybe Integer
$sel:description:UpdateApiKey' :: UpdateApiKey -> 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/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
id
      ]

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

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

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

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

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

instance Prelude.NFData UpdateApiKeyResponse where
  rnf :: UpdateApiKeyResponse -> ()
rnf UpdateApiKeyResponse' {Int
Maybe ApiKey
httpStatus :: Int
apiKey :: Maybe ApiKey
$sel:httpStatus:UpdateApiKeyResponse' :: UpdateApiKeyResponse -> Int
$sel:apiKey:UpdateApiKeyResponse' :: UpdateApiKeyResponse -> 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