{-# 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.CloudDirectory.CreateTypedLinkFacet
-- 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 TypedLinkFacet. For more information, see
-- <https://docs.aws.amazon.com/clouddirectory/latest/developerguide/directory_objects_links.html#directory_objects_links_typedlink Typed Links>.
module Amazonka.CloudDirectory.CreateTypedLinkFacet
  ( -- * Creating a Request
    CreateTypedLinkFacet (..),
    newCreateTypedLinkFacet,

    -- * Request Lenses
    createTypedLinkFacet_schemaArn,
    createTypedLinkFacet_facet,

    -- * Destructuring the Response
    CreateTypedLinkFacetResponse (..),
    newCreateTypedLinkFacetResponse,

    -- * Response Lenses
    createTypedLinkFacetResponse_httpStatus,
  )
where

import Amazonka.CloudDirectory.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:/ 'newCreateTypedLinkFacet' smart constructor.
data CreateTypedLinkFacet = CreateTypedLinkFacet'
  { -- | The Amazon Resource Name (ARN) that is associated with the schema. For
    -- more information, see arns.
    CreateTypedLinkFacet -> Text
schemaArn :: Prelude.Text,
    -- | Facet structure that is associated with the typed link facet.
    CreateTypedLinkFacet -> TypedLinkFacet
facet :: TypedLinkFacet
  }
  deriving (CreateTypedLinkFacet -> CreateTypedLinkFacet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTypedLinkFacet -> CreateTypedLinkFacet -> Bool
$c/= :: CreateTypedLinkFacet -> CreateTypedLinkFacet -> Bool
== :: CreateTypedLinkFacet -> CreateTypedLinkFacet -> Bool
$c== :: CreateTypedLinkFacet -> CreateTypedLinkFacet -> Bool
Prelude.Eq, ReadPrec [CreateTypedLinkFacet]
ReadPrec CreateTypedLinkFacet
Int -> ReadS CreateTypedLinkFacet
ReadS [CreateTypedLinkFacet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTypedLinkFacet]
$creadListPrec :: ReadPrec [CreateTypedLinkFacet]
readPrec :: ReadPrec CreateTypedLinkFacet
$creadPrec :: ReadPrec CreateTypedLinkFacet
readList :: ReadS [CreateTypedLinkFacet]
$creadList :: ReadS [CreateTypedLinkFacet]
readsPrec :: Int -> ReadS CreateTypedLinkFacet
$creadsPrec :: Int -> ReadS CreateTypedLinkFacet
Prelude.Read, Int -> CreateTypedLinkFacet -> ShowS
[CreateTypedLinkFacet] -> ShowS
CreateTypedLinkFacet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTypedLinkFacet] -> ShowS
$cshowList :: [CreateTypedLinkFacet] -> ShowS
show :: CreateTypedLinkFacet -> String
$cshow :: CreateTypedLinkFacet -> String
showsPrec :: Int -> CreateTypedLinkFacet -> ShowS
$cshowsPrec :: Int -> CreateTypedLinkFacet -> ShowS
Prelude.Show, forall x. Rep CreateTypedLinkFacet x -> CreateTypedLinkFacet
forall x. CreateTypedLinkFacet -> Rep CreateTypedLinkFacet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTypedLinkFacet x -> CreateTypedLinkFacet
$cfrom :: forall x. CreateTypedLinkFacet -> Rep CreateTypedLinkFacet x
Prelude.Generic)

-- |
-- Create a value of 'CreateTypedLinkFacet' 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:
--
-- 'schemaArn', 'createTypedLinkFacet_schemaArn' - The Amazon Resource Name (ARN) that is associated with the schema. For
-- more information, see arns.
--
-- 'facet', 'createTypedLinkFacet_facet' - Facet structure that is associated with the typed link facet.
newCreateTypedLinkFacet ::
  -- | 'schemaArn'
  Prelude.Text ->
  -- | 'facet'
  TypedLinkFacet ->
  CreateTypedLinkFacet
newCreateTypedLinkFacet :: Text -> TypedLinkFacet -> CreateTypedLinkFacet
newCreateTypedLinkFacet Text
pSchemaArn_ TypedLinkFacet
pFacet_ =
  CreateTypedLinkFacet'
    { $sel:schemaArn:CreateTypedLinkFacet' :: Text
schemaArn = Text
pSchemaArn_,
      $sel:facet:CreateTypedLinkFacet' :: TypedLinkFacet
facet = TypedLinkFacet
pFacet_
    }

-- | The Amazon Resource Name (ARN) that is associated with the schema. For
-- more information, see arns.
createTypedLinkFacet_schemaArn :: Lens.Lens' CreateTypedLinkFacet Prelude.Text
createTypedLinkFacet_schemaArn :: Lens' CreateTypedLinkFacet Text
createTypedLinkFacet_schemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTypedLinkFacet' {Text
schemaArn :: Text
$sel:schemaArn:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> Text
schemaArn} -> Text
schemaArn) (\s :: CreateTypedLinkFacet
s@CreateTypedLinkFacet' {} Text
a -> CreateTypedLinkFacet
s {$sel:schemaArn:CreateTypedLinkFacet' :: Text
schemaArn = Text
a} :: CreateTypedLinkFacet)

-- | Facet structure that is associated with the typed link facet.
createTypedLinkFacet_facet :: Lens.Lens' CreateTypedLinkFacet TypedLinkFacet
createTypedLinkFacet_facet :: Lens' CreateTypedLinkFacet TypedLinkFacet
createTypedLinkFacet_facet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTypedLinkFacet' {TypedLinkFacet
facet :: TypedLinkFacet
$sel:facet:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> TypedLinkFacet
facet} -> TypedLinkFacet
facet) (\s :: CreateTypedLinkFacet
s@CreateTypedLinkFacet' {} TypedLinkFacet
a -> CreateTypedLinkFacet
s {$sel:facet:CreateTypedLinkFacet' :: TypedLinkFacet
facet = TypedLinkFacet
a} :: CreateTypedLinkFacet)

instance Core.AWSRequest CreateTypedLinkFacet where
  type
    AWSResponse CreateTypedLinkFacet =
      CreateTypedLinkFacetResponse
  request :: (Service -> Service)
-> CreateTypedLinkFacet -> Request CreateTypedLinkFacet
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateTypedLinkFacet
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateTypedLinkFacet)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> CreateTypedLinkFacetResponse
CreateTypedLinkFacetResponse'
            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))
      )

instance Prelude.Hashable CreateTypedLinkFacet where
  hashWithSalt :: Int -> CreateTypedLinkFacet -> Int
hashWithSalt Int
_salt CreateTypedLinkFacet' {Text
TypedLinkFacet
facet :: TypedLinkFacet
schemaArn :: Text
$sel:facet:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> TypedLinkFacet
$sel:schemaArn:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TypedLinkFacet
facet

instance Prelude.NFData CreateTypedLinkFacet where
  rnf :: CreateTypedLinkFacet -> ()
rnf CreateTypedLinkFacet' {Text
TypedLinkFacet
facet :: TypedLinkFacet
schemaArn :: Text
$sel:facet:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> TypedLinkFacet
$sel:schemaArn:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
schemaArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TypedLinkFacet
facet

instance Data.ToHeaders CreateTypedLinkFacet where
  toHeaders :: CreateTypedLinkFacet -> ResponseHeaders
toHeaders CreateTypedLinkFacet' {Text
TypedLinkFacet
facet :: TypedLinkFacet
schemaArn :: Text
$sel:facet:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> TypedLinkFacet
$sel:schemaArn:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-data-partition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
schemaArn]

instance Data.ToJSON CreateTypedLinkFacet where
  toJSON :: CreateTypedLinkFacet -> Value
toJSON CreateTypedLinkFacet' {Text
TypedLinkFacet
facet :: TypedLinkFacet
schemaArn :: Text
$sel:facet:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> TypedLinkFacet
$sel:schemaArn:CreateTypedLinkFacet' :: CreateTypedLinkFacet -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Facet" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TypedLinkFacet
facet)]
      )

instance Data.ToPath CreateTypedLinkFacet where
  toPath :: CreateTypedLinkFacet -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/typedlink/facet/create"

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

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

-- |
-- Create a value of 'CreateTypedLinkFacetResponse' 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', 'createTypedLinkFacetResponse_httpStatus' - The response's http status code.
newCreateTypedLinkFacetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTypedLinkFacetResponse
newCreateTypedLinkFacetResponse :: Int -> CreateTypedLinkFacetResponse
newCreateTypedLinkFacetResponse Int
pHttpStatus_ =
  CreateTypedLinkFacetResponse'
    { $sel:httpStatus:CreateTypedLinkFacetResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData CreateTypedLinkFacetResponse where
  rnf :: CreateTypedLinkFacetResponse -> ()
rnf CreateTypedLinkFacetResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateTypedLinkFacetResponse' :: CreateTypedLinkFacetResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus