{-# 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.Grafana.CreateWorkspaceApiKey
-- 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 Grafana API key for the workspace. This key can be used to
-- authenticate requests sent to the workspace\'s HTTP API. See
-- <https://docs.aws.amazon.com/grafana/latest/userguide/Using-Grafana-APIs.html>
-- for available APIs and example requests.
module Amazonka.Grafana.CreateWorkspaceApiKey
  ( -- * Creating a Request
    CreateWorkspaceApiKey (..),
    newCreateWorkspaceApiKey,

    -- * Request Lenses
    createWorkspaceApiKey_keyName,
    createWorkspaceApiKey_keyRole,
    createWorkspaceApiKey_secondsToLive,
    createWorkspaceApiKey_workspaceId,

    -- * Destructuring the Response
    CreateWorkspaceApiKeyResponse (..),
    newCreateWorkspaceApiKeyResponse,

    -- * Response Lenses
    createWorkspaceApiKeyResponse_httpStatus,
    createWorkspaceApiKeyResponse_key,
    createWorkspaceApiKeyResponse_keyName,
    createWorkspaceApiKeyResponse_workspaceId,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Grafana.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateWorkspaceApiKey' smart constructor.
data CreateWorkspaceApiKey = CreateWorkspaceApiKey'
  { -- | Specifies the name of the key. Keynames must be unique to the workspace.
    CreateWorkspaceApiKey -> Text
keyName :: Prelude.Text,
    -- | Specifies the permission level of the key.
    --
    -- Valid values: @VIEWER@|@EDITOR@|@ADMIN@
    CreateWorkspaceApiKey -> Text
keyRole :: Prelude.Text,
    -- | Specifies the time in seconds until the key expires. Keys can be valid
    -- for up to 30 days.
    CreateWorkspaceApiKey -> Natural
secondsToLive :: Prelude.Natural,
    -- | The ID of the workspace to create an API key.
    CreateWorkspaceApiKey -> Text
workspaceId :: Prelude.Text
  }
  deriving (CreateWorkspaceApiKey -> CreateWorkspaceApiKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkspaceApiKey -> CreateWorkspaceApiKey -> Bool
$c/= :: CreateWorkspaceApiKey -> CreateWorkspaceApiKey -> Bool
== :: CreateWorkspaceApiKey -> CreateWorkspaceApiKey -> Bool
$c== :: CreateWorkspaceApiKey -> CreateWorkspaceApiKey -> Bool
Prelude.Eq, ReadPrec [CreateWorkspaceApiKey]
ReadPrec CreateWorkspaceApiKey
Int -> ReadS CreateWorkspaceApiKey
ReadS [CreateWorkspaceApiKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWorkspaceApiKey]
$creadListPrec :: ReadPrec [CreateWorkspaceApiKey]
readPrec :: ReadPrec CreateWorkspaceApiKey
$creadPrec :: ReadPrec CreateWorkspaceApiKey
readList :: ReadS [CreateWorkspaceApiKey]
$creadList :: ReadS [CreateWorkspaceApiKey]
readsPrec :: Int -> ReadS CreateWorkspaceApiKey
$creadsPrec :: Int -> ReadS CreateWorkspaceApiKey
Prelude.Read, Int -> CreateWorkspaceApiKey -> ShowS
[CreateWorkspaceApiKey] -> ShowS
CreateWorkspaceApiKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkspaceApiKey] -> ShowS
$cshowList :: [CreateWorkspaceApiKey] -> ShowS
show :: CreateWorkspaceApiKey -> String
$cshow :: CreateWorkspaceApiKey -> String
showsPrec :: Int -> CreateWorkspaceApiKey -> ShowS
$cshowsPrec :: Int -> CreateWorkspaceApiKey -> ShowS
Prelude.Show, forall x. Rep CreateWorkspaceApiKey x -> CreateWorkspaceApiKey
forall x. CreateWorkspaceApiKey -> Rep CreateWorkspaceApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWorkspaceApiKey x -> CreateWorkspaceApiKey
$cfrom :: forall x. CreateWorkspaceApiKey -> Rep CreateWorkspaceApiKey x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkspaceApiKey' 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:
--
-- 'keyName', 'createWorkspaceApiKey_keyName' - Specifies the name of the key. Keynames must be unique to the workspace.
--
-- 'keyRole', 'createWorkspaceApiKey_keyRole' - Specifies the permission level of the key.
--
-- Valid values: @VIEWER@|@EDITOR@|@ADMIN@
--
-- 'secondsToLive', 'createWorkspaceApiKey_secondsToLive' - Specifies the time in seconds until the key expires. Keys can be valid
-- for up to 30 days.
--
-- 'workspaceId', 'createWorkspaceApiKey_workspaceId' - The ID of the workspace to create an API key.
newCreateWorkspaceApiKey ::
  -- | 'keyName'
  Prelude.Text ->
  -- | 'keyRole'
  Prelude.Text ->
  -- | 'secondsToLive'
  Prelude.Natural ->
  -- | 'workspaceId'
  Prelude.Text ->
  CreateWorkspaceApiKey
newCreateWorkspaceApiKey :: Text -> Text -> Natural -> Text -> CreateWorkspaceApiKey
newCreateWorkspaceApiKey
  Text
pKeyName_
  Text
pKeyRole_
  Natural
pSecondsToLive_
  Text
pWorkspaceId_ =
    CreateWorkspaceApiKey'
      { $sel:keyName:CreateWorkspaceApiKey' :: Text
keyName = Text
pKeyName_,
        $sel:keyRole:CreateWorkspaceApiKey' :: Text
keyRole = Text
pKeyRole_,
        $sel:secondsToLive:CreateWorkspaceApiKey' :: Natural
secondsToLive = Natural
pSecondsToLive_,
        $sel:workspaceId:CreateWorkspaceApiKey' :: Text
workspaceId = Text
pWorkspaceId_
      }

-- | Specifies the name of the key. Keynames must be unique to the workspace.
createWorkspaceApiKey_keyName :: Lens.Lens' CreateWorkspaceApiKey Prelude.Text
createWorkspaceApiKey_keyName :: Lens' CreateWorkspaceApiKey Text
createWorkspaceApiKey_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKey' {Text
keyName :: Text
$sel:keyName:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
keyName} -> Text
keyName) (\s :: CreateWorkspaceApiKey
s@CreateWorkspaceApiKey' {} Text
a -> CreateWorkspaceApiKey
s {$sel:keyName:CreateWorkspaceApiKey' :: Text
keyName = Text
a} :: CreateWorkspaceApiKey)

-- | Specifies the permission level of the key.
--
-- Valid values: @VIEWER@|@EDITOR@|@ADMIN@
createWorkspaceApiKey_keyRole :: Lens.Lens' CreateWorkspaceApiKey Prelude.Text
createWorkspaceApiKey_keyRole :: Lens' CreateWorkspaceApiKey Text
createWorkspaceApiKey_keyRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKey' {Text
keyRole :: Text
$sel:keyRole:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
keyRole} -> Text
keyRole) (\s :: CreateWorkspaceApiKey
s@CreateWorkspaceApiKey' {} Text
a -> CreateWorkspaceApiKey
s {$sel:keyRole:CreateWorkspaceApiKey' :: Text
keyRole = Text
a} :: CreateWorkspaceApiKey)

-- | Specifies the time in seconds until the key expires. Keys can be valid
-- for up to 30 days.
createWorkspaceApiKey_secondsToLive :: Lens.Lens' CreateWorkspaceApiKey Prelude.Natural
createWorkspaceApiKey_secondsToLive :: Lens' CreateWorkspaceApiKey Natural
createWorkspaceApiKey_secondsToLive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKey' {Natural
secondsToLive :: Natural
$sel:secondsToLive:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Natural
secondsToLive} -> Natural
secondsToLive) (\s :: CreateWorkspaceApiKey
s@CreateWorkspaceApiKey' {} Natural
a -> CreateWorkspaceApiKey
s {$sel:secondsToLive:CreateWorkspaceApiKey' :: Natural
secondsToLive = Natural
a} :: CreateWorkspaceApiKey)

-- | The ID of the workspace to create an API key.
createWorkspaceApiKey_workspaceId :: Lens.Lens' CreateWorkspaceApiKey Prelude.Text
createWorkspaceApiKey_workspaceId :: Lens' CreateWorkspaceApiKey Text
createWorkspaceApiKey_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKey' {Text
workspaceId :: Text
$sel:workspaceId:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
workspaceId} -> Text
workspaceId) (\s :: CreateWorkspaceApiKey
s@CreateWorkspaceApiKey' {} Text
a -> CreateWorkspaceApiKey
s {$sel:workspaceId:CreateWorkspaceApiKey' :: Text
workspaceId = Text
a} :: CreateWorkspaceApiKey)

instance Core.AWSRequest CreateWorkspaceApiKey where
  type
    AWSResponse CreateWorkspaceApiKey =
      CreateWorkspaceApiKeyResponse
  request :: (Service -> Service)
-> CreateWorkspaceApiKey -> Request CreateWorkspaceApiKey
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 CreateWorkspaceApiKey
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateWorkspaceApiKey)))
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 ->
          Int
-> Sensitive Text -> Text -> Text -> CreateWorkspaceApiKeyResponse
CreateWorkspaceApiKeyResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"key")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"keyName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"workspaceId")
      )

instance Prelude.Hashable CreateWorkspaceApiKey where
  hashWithSalt :: Int -> CreateWorkspaceApiKey -> Int
hashWithSalt Int
_salt CreateWorkspaceApiKey' {Natural
Text
workspaceId :: Text
secondsToLive :: Natural
keyRole :: Text
keyName :: Text
$sel:workspaceId:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:secondsToLive:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Natural
$sel:keyRole:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:keyName:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
secondsToLive
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId

instance Prelude.NFData CreateWorkspaceApiKey where
  rnf :: CreateWorkspaceApiKey -> ()
rnf CreateWorkspaceApiKey' {Natural
Text
workspaceId :: Text
secondsToLive :: Natural
keyRole :: Text
keyName :: Text
$sel:workspaceId:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:secondsToLive:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Natural
$sel:keyRole:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:keyName:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
secondsToLive
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId

instance Data.ToHeaders CreateWorkspaceApiKey where
  toHeaders :: CreateWorkspaceApiKey -> 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 CreateWorkspaceApiKey where
  toJSON :: CreateWorkspaceApiKey -> Value
toJSON CreateWorkspaceApiKey' {Natural
Text
workspaceId :: Text
secondsToLive :: Natural
keyRole :: Text
keyName :: Text
$sel:workspaceId:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:secondsToLive:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Natural
$sel:keyRole:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:keyName:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"keyName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyName),
            forall a. a -> Maybe a
Prelude.Just (Key
"keyRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyRole),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"secondsToLive" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
secondsToLive)
          ]
      )

instance Data.ToPath CreateWorkspaceApiKey where
  toPath :: CreateWorkspaceApiKey -> ByteString
toPath CreateWorkspaceApiKey' {Natural
Text
workspaceId :: Text
secondsToLive :: Natural
keyRole :: Text
keyName :: Text
$sel:workspaceId:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:secondsToLive:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Natural
$sel:keyRole:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
$sel:keyName:CreateWorkspaceApiKey' :: CreateWorkspaceApiKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/workspaces/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId, ByteString
"/apikeys"]

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

-- | /See:/ 'newCreateWorkspaceApiKeyResponse' smart constructor.
data CreateWorkspaceApiKeyResponse = CreateWorkspaceApiKeyResponse'
  { -- | The response's http status code.
    CreateWorkspaceApiKeyResponse -> Int
httpStatus :: Prelude.Int,
    -- | The key token. Use this value as a bearer token to authenticate HTTP
    -- requests to the workspace.
    CreateWorkspaceApiKeyResponse -> Sensitive Text
key :: Data.Sensitive Prelude.Text,
    -- | The name of the key that was created.
    CreateWorkspaceApiKeyResponse -> Text
keyName :: Prelude.Text,
    -- | The ID of the workspace that the key is valid for.
    CreateWorkspaceApiKeyResponse -> Text
workspaceId :: Prelude.Text
  }
  deriving (CreateWorkspaceApiKeyResponse
-> CreateWorkspaceApiKeyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWorkspaceApiKeyResponse
-> CreateWorkspaceApiKeyResponse -> Bool
$c/= :: CreateWorkspaceApiKeyResponse
-> CreateWorkspaceApiKeyResponse -> Bool
== :: CreateWorkspaceApiKeyResponse
-> CreateWorkspaceApiKeyResponse -> Bool
$c== :: CreateWorkspaceApiKeyResponse
-> CreateWorkspaceApiKeyResponse -> Bool
Prelude.Eq, Int -> CreateWorkspaceApiKeyResponse -> ShowS
[CreateWorkspaceApiKeyResponse] -> ShowS
CreateWorkspaceApiKeyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWorkspaceApiKeyResponse] -> ShowS
$cshowList :: [CreateWorkspaceApiKeyResponse] -> ShowS
show :: CreateWorkspaceApiKeyResponse -> String
$cshow :: CreateWorkspaceApiKeyResponse -> String
showsPrec :: Int -> CreateWorkspaceApiKeyResponse -> ShowS
$cshowsPrec :: Int -> CreateWorkspaceApiKeyResponse -> ShowS
Prelude.Show, forall x.
Rep CreateWorkspaceApiKeyResponse x
-> CreateWorkspaceApiKeyResponse
forall x.
CreateWorkspaceApiKeyResponse
-> Rep CreateWorkspaceApiKeyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateWorkspaceApiKeyResponse x
-> CreateWorkspaceApiKeyResponse
$cfrom :: forall x.
CreateWorkspaceApiKeyResponse
-> Rep CreateWorkspaceApiKeyResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateWorkspaceApiKeyResponse' 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:
--
-- 'httpStatus', 'createWorkspaceApiKeyResponse_httpStatus' - The response's http status code.
--
-- 'key', 'createWorkspaceApiKeyResponse_key' - The key token. Use this value as a bearer token to authenticate HTTP
-- requests to the workspace.
--
-- 'keyName', 'createWorkspaceApiKeyResponse_keyName' - The name of the key that was created.
--
-- 'workspaceId', 'createWorkspaceApiKeyResponse_workspaceId' - The ID of the workspace that the key is valid for.
newCreateWorkspaceApiKeyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'key'
  Prelude.Text ->
  -- | 'keyName'
  Prelude.Text ->
  -- | 'workspaceId'
  Prelude.Text ->
  CreateWorkspaceApiKeyResponse
newCreateWorkspaceApiKeyResponse :: Int -> Text -> Text -> Text -> CreateWorkspaceApiKeyResponse
newCreateWorkspaceApiKeyResponse
  Int
pHttpStatus_
  Text
pKey_
  Text
pKeyName_
  Text
pWorkspaceId_ =
    CreateWorkspaceApiKeyResponse'
      { $sel:httpStatus:CreateWorkspaceApiKeyResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:key:CreateWorkspaceApiKeyResponse' :: Sensitive Text
key = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pKey_,
        $sel:keyName:CreateWorkspaceApiKeyResponse' :: Text
keyName = Text
pKeyName_,
        $sel:workspaceId:CreateWorkspaceApiKeyResponse' :: Text
workspaceId = Text
pWorkspaceId_
      }

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

-- | The key token. Use this value as a bearer token to authenticate HTTP
-- requests to the workspace.
createWorkspaceApiKeyResponse_key :: Lens.Lens' CreateWorkspaceApiKeyResponse Prelude.Text
createWorkspaceApiKeyResponse_key :: Lens' CreateWorkspaceApiKeyResponse Text
createWorkspaceApiKeyResponse_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKeyResponse' {Sensitive Text
key :: Sensitive Text
$sel:key:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Sensitive Text
key} -> Sensitive Text
key) (\s :: CreateWorkspaceApiKeyResponse
s@CreateWorkspaceApiKeyResponse' {} Sensitive Text
a -> CreateWorkspaceApiKeyResponse
s {$sel:key:CreateWorkspaceApiKeyResponse' :: Sensitive Text
key = Sensitive Text
a} :: CreateWorkspaceApiKeyResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The name of the key that was created.
createWorkspaceApiKeyResponse_keyName :: Lens.Lens' CreateWorkspaceApiKeyResponse Prelude.Text
createWorkspaceApiKeyResponse_keyName :: Lens' CreateWorkspaceApiKeyResponse Text
createWorkspaceApiKeyResponse_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKeyResponse' {Text
keyName :: Text
$sel:keyName:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Text
keyName} -> Text
keyName) (\s :: CreateWorkspaceApiKeyResponse
s@CreateWorkspaceApiKeyResponse' {} Text
a -> CreateWorkspaceApiKeyResponse
s {$sel:keyName:CreateWorkspaceApiKeyResponse' :: Text
keyName = Text
a} :: CreateWorkspaceApiKeyResponse)

-- | The ID of the workspace that the key is valid for.
createWorkspaceApiKeyResponse_workspaceId :: Lens.Lens' CreateWorkspaceApiKeyResponse Prelude.Text
createWorkspaceApiKeyResponse_workspaceId :: Lens' CreateWorkspaceApiKeyResponse Text
createWorkspaceApiKeyResponse_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWorkspaceApiKeyResponse' {Text
workspaceId :: Text
$sel:workspaceId:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Text
workspaceId} -> Text
workspaceId) (\s :: CreateWorkspaceApiKeyResponse
s@CreateWorkspaceApiKeyResponse' {} Text
a -> CreateWorkspaceApiKeyResponse
s {$sel:workspaceId:CreateWorkspaceApiKeyResponse' :: Text
workspaceId = Text
a} :: CreateWorkspaceApiKeyResponse)

instance Prelude.NFData CreateWorkspaceApiKeyResponse where
  rnf :: CreateWorkspaceApiKeyResponse -> ()
rnf CreateWorkspaceApiKeyResponse' {Int
Text
Sensitive Text
workspaceId :: Text
keyName :: Text
key :: Sensitive Text
httpStatus :: Int
$sel:workspaceId:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Text
$sel:keyName:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Text
$sel:key:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Sensitive Text
$sel:httpStatus:CreateWorkspaceApiKeyResponse' :: CreateWorkspaceApiKeyResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
key
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId