{-# 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.CognitoIdentityProvider.CreateResourceServer
-- 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 new OAuth2.0 resource server and defines custom scopes within
-- it.
module Amazonka.CognitoIdentityProvider.CreateResourceServer
  ( -- * Creating a Request
    CreateResourceServer (..),
    newCreateResourceServer,

    -- * Request Lenses
    createResourceServer_scopes,
    createResourceServer_userPoolId,
    createResourceServer_identifier,
    createResourceServer_name,

    -- * Destructuring the Response
    CreateResourceServerResponse (..),
    newCreateResourceServerResponse,

    -- * Response Lenses
    createResourceServerResponse_httpStatus,
    createResourceServerResponse_resourceServer,
  )
where

import Amazonka.CognitoIdentityProvider.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:/ 'newCreateResourceServer' smart constructor.
data CreateResourceServer = CreateResourceServer'
  { -- | A list of scopes. Each scope is a key-value map with the keys @name@ and
    -- @description@.
    CreateResourceServer -> Maybe [ResourceServerScopeType]
scopes :: Prelude.Maybe [ResourceServerScopeType],
    -- | The user pool ID for the user pool.
    CreateResourceServer -> Text
userPoolId :: Prelude.Text,
    -- | A unique resource server identifier for the resource server. This could
    -- be an HTTPS endpoint where the resource server is located, such as
    -- @https:\/\/my-weather-api.example.com@.
    CreateResourceServer -> Text
identifier :: Prelude.Text,
    -- | A friendly name for the resource server.
    CreateResourceServer -> Text
name :: Prelude.Text
  }
  deriving (CreateResourceServer -> CreateResourceServer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateResourceServer -> CreateResourceServer -> Bool
$c/= :: CreateResourceServer -> CreateResourceServer -> Bool
== :: CreateResourceServer -> CreateResourceServer -> Bool
$c== :: CreateResourceServer -> CreateResourceServer -> Bool
Prelude.Eq, ReadPrec [CreateResourceServer]
ReadPrec CreateResourceServer
Int -> ReadS CreateResourceServer
ReadS [CreateResourceServer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateResourceServer]
$creadListPrec :: ReadPrec [CreateResourceServer]
readPrec :: ReadPrec CreateResourceServer
$creadPrec :: ReadPrec CreateResourceServer
readList :: ReadS [CreateResourceServer]
$creadList :: ReadS [CreateResourceServer]
readsPrec :: Int -> ReadS CreateResourceServer
$creadsPrec :: Int -> ReadS CreateResourceServer
Prelude.Read, Int -> CreateResourceServer -> ShowS
[CreateResourceServer] -> ShowS
CreateResourceServer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateResourceServer] -> ShowS
$cshowList :: [CreateResourceServer] -> ShowS
show :: CreateResourceServer -> String
$cshow :: CreateResourceServer -> String
showsPrec :: Int -> CreateResourceServer -> ShowS
$cshowsPrec :: Int -> CreateResourceServer -> ShowS
Prelude.Show, forall x. Rep CreateResourceServer x -> CreateResourceServer
forall x. CreateResourceServer -> Rep CreateResourceServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateResourceServer x -> CreateResourceServer
$cfrom :: forall x. CreateResourceServer -> Rep CreateResourceServer x
Prelude.Generic)

-- |
-- Create a value of 'CreateResourceServer' 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:
--
-- 'scopes', 'createResourceServer_scopes' - A list of scopes. Each scope is a key-value map with the keys @name@ and
-- @description@.
--
-- 'userPoolId', 'createResourceServer_userPoolId' - The user pool ID for the user pool.
--
-- 'identifier', 'createResourceServer_identifier' - A unique resource server identifier for the resource server. This could
-- be an HTTPS endpoint where the resource server is located, such as
-- @https:\/\/my-weather-api.example.com@.
--
-- 'name', 'createResourceServer_name' - A friendly name for the resource server.
newCreateResourceServer ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'identifier'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateResourceServer
newCreateResourceServer :: Text -> Text -> Text -> CreateResourceServer
newCreateResourceServer
  Text
pUserPoolId_
  Text
pIdentifier_
  Text
pName_ =
    CreateResourceServer'
      { $sel:scopes:CreateResourceServer' :: Maybe [ResourceServerScopeType]
scopes = forall a. Maybe a
Prelude.Nothing,
        $sel:userPoolId:CreateResourceServer' :: Text
userPoolId = Text
pUserPoolId_,
        $sel:identifier:CreateResourceServer' :: Text
identifier = Text
pIdentifier_,
        $sel:name:CreateResourceServer' :: Text
name = Text
pName_
      }

-- | A list of scopes. Each scope is a key-value map with the keys @name@ and
-- @description@.
createResourceServer_scopes :: Lens.Lens' CreateResourceServer (Prelude.Maybe [ResourceServerScopeType])
createResourceServer_scopes :: Lens' CreateResourceServer (Maybe [ResourceServerScopeType])
createResourceServer_scopes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceServer' {Maybe [ResourceServerScopeType]
scopes :: Maybe [ResourceServerScopeType]
$sel:scopes:CreateResourceServer' :: CreateResourceServer -> Maybe [ResourceServerScopeType]
scopes} -> Maybe [ResourceServerScopeType]
scopes) (\s :: CreateResourceServer
s@CreateResourceServer' {} Maybe [ResourceServerScopeType]
a -> CreateResourceServer
s {$sel:scopes:CreateResourceServer' :: Maybe [ResourceServerScopeType]
scopes = Maybe [ResourceServerScopeType]
a} :: CreateResourceServer) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The user pool ID for the user pool.
createResourceServer_userPoolId :: Lens.Lens' CreateResourceServer Prelude.Text
createResourceServer_userPoolId :: Lens' CreateResourceServer Text
createResourceServer_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceServer' {Text
userPoolId :: Text
$sel:userPoolId:CreateResourceServer' :: CreateResourceServer -> Text
userPoolId} -> Text
userPoolId) (\s :: CreateResourceServer
s@CreateResourceServer' {} Text
a -> CreateResourceServer
s {$sel:userPoolId:CreateResourceServer' :: Text
userPoolId = Text
a} :: CreateResourceServer)

-- | A unique resource server identifier for the resource server. This could
-- be an HTTPS endpoint where the resource server is located, such as
-- @https:\/\/my-weather-api.example.com@.
createResourceServer_identifier :: Lens.Lens' CreateResourceServer Prelude.Text
createResourceServer_identifier :: Lens' CreateResourceServer Text
createResourceServer_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceServer' {Text
identifier :: Text
$sel:identifier:CreateResourceServer' :: CreateResourceServer -> Text
identifier} -> Text
identifier) (\s :: CreateResourceServer
s@CreateResourceServer' {} Text
a -> CreateResourceServer
s {$sel:identifier:CreateResourceServer' :: Text
identifier = Text
a} :: CreateResourceServer)

-- | A friendly name for the resource server.
createResourceServer_name :: Lens.Lens' CreateResourceServer Prelude.Text
createResourceServer_name :: Lens' CreateResourceServer Text
createResourceServer_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceServer' {Text
name :: Text
$sel:name:CreateResourceServer' :: CreateResourceServer -> Text
name} -> Text
name) (\s :: CreateResourceServer
s@CreateResourceServer' {} Text
a -> CreateResourceServer
s {$sel:name:CreateResourceServer' :: Text
name = Text
a} :: CreateResourceServer)

instance Core.AWSRequest CreateResourceServer where
  type
    AWSResponse CreateResourceServer =
      CreateResourceServerResponse
  request :: (Service -> Service)
-> CreateResourceServer -> Request CreateResourceServer
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 CreateResourceServer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateResourceServer)))
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 -> ResourceServerType -> CreateResourceServerResponse
CreateResourceServerResponse'
            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
"ResourceServer")
      )

instance Prelude.Hashable CreateResourceServer where
  hashWithSalt :: Int -> CreateResourceServer -> Int
hashWithSalt Int
_salt CreateResourceServer' {Maybe [ResourceServerScopeType]
Text
name :: Text
identifier :: Text
userPoolId :: Text
scopes :: Maybe [ResourceServerScopeType]
$sel:name:CreateResourceServer' :: CreateResourceServer -> Text
$sel:identifier:CreateResourceServer' :: CreateResourceServer -> Text
$sel:userPoolId:CreateResourceServer' :: CreateResourceServer -> Text
$sel:scopes:CreateResourceServer' :: CreateResourceServer -> Maybe [ResourceServerScopeType]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ResourceServerScopeType]
scopes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateResourceServer where
  rnf :: CreateResourceServer -> ()
rnf CreateResourceServer' {Maybe [ResourceServerScopeType]
Text
name :: Text
identifier :: Text
userPoolId :: Text
scopes :: Maybe [ResourceServerScopeType]
$sel:name:CreateResourceServer' :: CreateResourceServer -> Text
$sel:identifier:CreateResourceServer' :: CreateResourceServer -> Text
$sel:userPoolId:CreateResourceServer' :: CreateResourceServer -> Text
$sel:scopes:CreateResourceServer' :: CreateResourceServer -> Maybe [ResourceServerScopeType]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceServerScopeType]
scopes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToJSON CreateResourceServer where
  toJSON :: CreateResourceServer -> Value
toJSON CreateResourceServer' {Maybe [ResourceServerScopeType]
Text
name :: Text
identifier :: Text
userPoolId :: Text
scopes :: Maybe [ResourceServerScopeType]
$sel:name:CreateResourceServer' :: CreateResourceServer -> Text
$sel:identifier:CreateResourceServer' :: CreateResourceServer -> Text
$sel:userPoolId:CreateResourceServer' :: CreateResourceServer -> Text
$sel:scopes:CreateResourceServer' :: CreateResourceServer -> Maybe [ResourceServerScopeType]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Scopes" 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 [ResourceServerScopeType]
scopes,
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identifier),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateResourceServer where
  toPath :: CreateResourceServer -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CreateResourceServerResponse' 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', 'createResourceServerResponse_httpStatus' - The response's http status code.
--
-- 'resourceServer', 'createResourceServerResponse_resourceServer' - The newly created resource server.
newCreateResourceServerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'resourceServer'
  ResourceServerType ->
  CreateResourceServerResponse
newCreateResourceServerResponse :: Int -> ResourceServerType -> CreateResourceServerResponse
newCreateResourceServerResponse
  Int
pHttpStatus_
  ResourceServerType
pResourceServer_ =
    CreateResourceServerResponse'
      { $sel:httpStatus:CreateResourceServerResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:resourceServer:CreateResourceServerResponse' :: ResourceServerType
resourceServer = ResourceServerType
pResourceServer_
      }

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

-- | The newly created resource server.
createResourceServerResponse_resourceServer :: Lens.Lens' CreateResourceServerResponse ResourceServerType
createResourceServerResponse_resourceServer :: Lens' CreateResourceServerResponse ResourceServerType
createResourceServerResponse_resourceServer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateResourceServerResponse' {ResourceServerType
resourceServer :: ResourceServerType
$sel:resourceServer:CreateResourceServerResponse' :: CreateResourceServerResponse -> ResourceServerType
resourceServer} -> ResourceServerType
resourceServer) (\s :: CreateResourceServerResponse
s@CreateResourceServerResponse' {} ResourceServerType
a -> CreateResourceServerResponse
s {$sel:resourceServer:CreateResourceServerResponse' :: ResourceServerType
resourceServer = ResourceServerType
a} :: CreateResourceServerResponse)

instance Prelude.NFData CreateResourceServerResponse where
  rnf :: CreateResourceServerResponse -> ()
rnf CreateResourceServerResponse' {Int
ResourceServerType
resourceServer :: ResourceServerType
httpStatus :: Int
$sel:resourceServer:CreateResourceServerResponse' :: CreateResourceServerResponse -> ResourceServerType
$sel:httpStatus:CreateResourceServerResponse' :: CreateResourceServerResponse -> 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 ResourceServerType
resourceServer