{-# 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.SSM.CreateDocument
-- 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 Amazon Web Services Systems Manager (SSM document). An SSM
-- document defines the actions that Systems Manager performs on your
-- managed nodes. For more information about SSM documents, including
-- information about supported schemas, features, and syntax, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-ssm-docs.html Amazon Web Services Systems Manager Documents>
-- in the /Amazon Web Services Systems Manager User Guide/.
module Amazonka.SSM.CreateDocument
  ( -- * Creating a Request
    CreateDocument (..),
    newCreateDocument,

    -- * Request Lenses
    createDocument_attachments,
    createDocument_displayName,
    createDocument_documentFormat,
    createDocument_documentType,
    createDocument_requires,
    createDocument_tags,
    createDocument_targetType,
    createDocument_versionName,
    createDocument_content,
    createDocument_name,

    -- * Destructuring the Response
    CreateDocumentResponse (..),
    newCreateDocumentResponse,

    -- * Response Lenses
    createDocumentResponse_documentDescription,
    createDocumentResponse_httpStatus,
  )
where

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
import Amazonka.SSM.Types

-- | /See:/ 'newCreateDocument' smart constructor.
data CreateDocument = CreateDocument'
  { -- | A list of key-value pairs that describe attachments to a version of a
    -- document.
    CreateDocument -> Maybe [AttachmentsSource]
attachments :: Prelude.Maybe [AttachmentsSource],
    -- | An optional field where you can specify a friendly name for the SSM
    -- document. This value can differ for each version of the document. You
    -- can update this value at a later time using the UpdateDocument
    -- operation.
    CreateDocument -> Maybe Text
displayName :: Prelude.Maybe Prelude.Text,
    -- | Specify the document format for the request. The document format can be
    -- JSON, YAML, or TEXT. JSON is the default format.
    CreateDocument -> Maybe DocumentFormat
documentFormat :: Prelude.Maybe DocumentFormat,
    -- | The type of document to create.
    --
    -- The @DeploymentStrategy@ document type is an internal-use-only document
    -- type reserved for AppConfig.
    CreateDocument -> Maybe DocumentType
documentType :: Prelude.Maybe DocumentType,
    -- | A list of SSM documents required by a document. This parameter is used
    -- exclusively by AppConfig. When a user creates an AppConfig configuration
    -- in an SSM document, the user must also specify a required document for
    -- validation purposes. In this case, an @ApplicationConfiguration@
    -- document requires an @ApplicationConfigurationSchema@ document for
    -- validation purposes. For more information, see
    -- <https://docs.aws.amazon.com/appconfig/latest/userguide/what-is-appconfig.html What is AppConfig?>
    -- in the /AppConfig User Guide/.
    CreateDocument -> Maybe (NonEmpty DocumentRequires)
requires :: Prelude.Maybe (Prelude.NonEmpty DocumentRequires),
    -- | Optional metadata that you assign to a resource. Tags enable you to
    -- categorize a resource in different ways, such as by purpose, owner, or
    -- environment. For example, you might want to tag an SSM document to
    -- identify the types of targets or the environment where it will run. In
    -- this case, you could specify the following key-value pairs:
    --
    -- -   @Key=OS,Value=Windows@
    --
    -- -   @Key=Environment,Value=Production@
    --
    -- To add tags to an existing SSM document, use the AddTagsToResource
    -- operation.
    CreateDocument -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Specify a target type to define the kinds of resources the document can
    -- run on. For example, to run a document on EC2 instances, specify the
    -- following value: @\/AWS::EC2::Instance@. If you specify a value of
    -- \'\/\' the document can run on all types of resources. If you don\'t
    -- specify a value, the document can\'t run on any resources. For a list of
    -- valid resource types, see
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-template-resource-type-ref.html Amazon Web Services resource and property types reference>
    -- in the /CloudFormation User Guide/.
    CreateDocument -> Maybe Text
targetType :: Prelude.Maybe Prelude.Text,
    -- | An optional field specifying the version of the artifact you are
    -- creating with the document. For example, @Release12.1@. This value is
    -- unique across all versions of a document, and can\'t be changed.
    CreateDocument -> Maybe Text
versionName :: Prelude.Maybe Prelude.Text,
    -- | The content for the new SSM document in JSON or YAML format. We
    -- recommend storing the contents for your new document in an external JSON
    -- or YAML file and referencing the file in a command.
    --
    -- For examples, see the following topics in the /Amazon Web Services
    -- Systems Manager User Guide/.
    --
    -- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-api.html Create an SSM document (Amazon Web Services API)>
    --
    -- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-cli.html Create an SSM document (Amazon Web Services CLI)>
    --
    -- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-api.html Create an SSM document (API)>
    CreateDocument -> Text
content :: Prelude.Text,
    -- | A name for the SSM document.
    --
    -- You can\'t use the following strings as document name prefixes. These
    -- are reserved by Amazon Web Services for use as document name prefixes:
    --
    -- -   @aws@
    --
    -- -   @amazon@
    --
    -- -   @amzn@
    CreateDocument -> Text
name :: Prelude.Text
  }
  deriving (CreateDocument -> CreateDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDocument -> CreateDocument -> Bool
$c/= :: CreateDocument -> CreateDocument -> Bool
== :: CreateDocument -> CreateDocument -> Bool
$c== :: CreateDocument -> CreateDocument -> Bool
Prelude.Eq, ReadPrec [CreateDocument]
ReadPrec CreateDocument
Int -> ReadS CreateDocument
ReadS [CreateDocument]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDocument]
$creadListPrec :: ReadPrec [CreateDocument]
readPrec :: ReadPrec CreateDocument
$creadPrec :: ReadPrec CreateDocument
readList :: ReadS [CreateDocument]
$creadList :: ReadS [CreateDocument]
readsPrec :: Int -> ReadS CreateDocument
$creadsPrec :: Int -> ReadS CreateDocument
Prelude.Read, Int -> CreateDocument -> ShowS
[CreateDocument] -> ShowS
CreateDocument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDocument] -> ShowS
$cshowList :: [CreateDocument] -> ShowS
show :: CreateDocument -> String
$cshow :: CreateDocument -> String
showsPrec :: Int -> CreateDocument -> ShowS
$cshowsPrec :: Int -> CreateDocument -> ShowS
Prelude.Show, forall x. Rep CreateDocument x -> CreateDocument
forall x. CreateDocument -> Rep CreateDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDocument x -> CreateDocument
$cfrom :: forall x. CreateDocument -> Rep CreateDocument x
Prelude.Generic)

-- |
-- Create a value of 'CreateDocument' 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:
--
-- 'attachments', 'createDocument_attachments' - A list of key-value pairs that describe attachments to a version of a
-- document.
--
-- 'displayName', 'createDocument_displayName' - An optional field where you can specify a friendly name for the SSM
-- document. This value can differ for each version of the document. You
-- can update this value at a later time using the UpdateDocument
-- operation.
--
-- 'documentFormat', 'createDocument_documentFormat' - Specify the document format for the request. The document format can be
-- JSON, YAML, or TEXT. JSON is the default format.
--
-- 'documentType', 'createDocument_documentType' - The type of document to create.
--
-- The @DeploymentStrategy@ document type is an internal-use-only document
-- type reserved for AppConfig.
--
-- 'requires', 'createDocument_requires' - A list of SSM documents required by a document. This parameter is used
-- exclusively by AppConfig. When a user creates an AppConfig configuration
-- in an SSM document, the user must also specify a required document for
-- validation purposes. In this case, an @ApplicationConfiguration@
-- document requires an @ApplicationConfigurationSchema@ document for
-- validation purposes. For more information, see
-- <https://docs.aws.amazon.com/appconfig/latest/userguide/what-is-appconfig.html What is AppConfig?>
-- in the /AppConfig User Guide/.
--
-- 'tags', 'createDocument_tags' - Optional metadata that you assign to a resource. Tags enable you to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment. For example, you might want to tag an SSM document to
-- identify the types of targets or the environment where it will run. In
-- this case, you could specify the following key-value pairs:
--
-- -   @Key=OS,Value=Windows@
--
-- -   @Key=Environment,Value=Production@
--
-- To add tags to an existing SSM document, use the AddTagsToResource
-- operation.
--
-- 'targetType', 'createDocument_targetType' - Specify a target type to define the kinds of resources the document can
-- run on. For example, to run a document on EC2 instances, specify the
-- following value: @\/AWS::EC2::Instance@. If you specify a value of
-- \'\/\' the document can run on all types of resources. If you don\'t
-- specify a value, the document can\'t run on any resources. For a list of
-- valid resource types, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-template-resource-type-ref.html Amazon Web Services resource and property types reference>
-- in the /CloudFormation User Guide/.
--
-- 'versionName', 'createDocument_versionName' - An optional field specifying the version of the artifact you are
-- creating with the document. For example, @Release12.1@. This value is
-- unique across all versions of a document, and can\'t be changed.
--
-- 'content', 'createDocument_content' - The content for the new SSM document in JSON or YAML format. We
-- recommend storing the contents for your new document in an external JSON
-- or YAML file and referencing the file in a command.
--
-- For examples, see the following topics in the /Amazon Web Services
-- Systems Manager User Guide/.
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-api.html Create an SSM document (Amazon Web Services API)>
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-cli.html Create an SSM document (Amazon Web Services CLI)>
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-api.html Create an SSM document (API)>
--
-- 'name', 'createDocument_name' - A name for the SSM document.
--
-- You can\'t use the following strings as document name prefixes. These
-- are reserved by Amazon Web Services for use as document name prefixes:
--
-- -   @aws@
--
-- -   @amazon@
--
-- -   @amzn@
newCreateDocument ::
  -- | 'content'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateDocument
newCreateDocument :: Text -> Text -> CreateDocument
newCreateDocument Text
pContent_ Text
pName_ =
  CreateDocument'
    { $sel:attachments:CreateDocument' :: Maybe [AttachmentsSource]
attachments = forall a. Maybe a
Prelude.Nothing,
      $sel:displayName:CreateDocument' :: Maybe Text
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:documentFormat:CreateDocument' :: Maybe DocumentFormat
documentFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:documentType:CreateDocument' :: Maybe DocumentType
documentType = forall a. Maybe a
Prelude.Nothing,
      $sel:requires:CreateDocument' :: Maybe (NonEmpty DocumentRequires)
requires = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDocument' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:targetType:CreateDocument' :: Maybe Text
targetType = forall a. Maybe a
Prelude.Nothing,
      $sel:versionName:CreateDocument' :: Maybe Text
versionName = forall a. Maybe a
Prelude.Nothing,
      $sel:content:CreateDocument' :: Text
content = Text
pContent_,
      $sel:name:CreateDocument' :: Text
name = Text
pName_
    }

-- | A list of key-value pairs that describe attachments to a version of a
-- document.
createDocument_attachments :: Lens.Lens' CreateDocument (Prelude.Maybe [AttachmentsSource])
createDocument_attachments :: Lens' CreateDocument (Maybe [AttachmentsSource])
createDocument_attachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe [AttachmentsSource]
attachments :: Maybe [AttachmentsSource]
$sel:attachments:CreateDocument' :: CreateDocument -> Maybe [AttachmentsSource]
attachments} -> Maybe [AttachmentsSource]
attachments) (\s :: CreateDocument
s@CreateDocument' {} Maybe [AttachmentsSource]
a -> CreateDocument
s {$sel:attachments:CreateDocument' :: Maybe [AttachmentsSource]
attachments = Maybe [AttachmentsSource]
a} :: CreateDocument) 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

-- | An optional field where you can specify a friendly name for the SSM
-- document. This value can differ for each version of the document. You
-- can update this value at a later time using the UpdateDocument
-- operation.
createDocument_displayName :: Lens.Lens' CreateDocument (Prelude.Maybe Prelude.Text)
createDocument_displayName :: Lens' CreateDocument (Maybe Text)
createDocument_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe Text
displayName :: Maybe Text
$sel:displayName:CreateDocument' :: CreateDocument -> Maybe Text
displayName} -> Maybe Text
displayName) (\s :: CreateDocument
s@CreateDocument' {} Maybe Text
a -> CreateDocument
s {$sel:displayName:CreateDocument' :: Maybe Text
displayName = Maybe Text
a} :: CreateDocument)

-- | Specify the document format for the request. The document format can be
-- JSON, YAML, or TEXT. JSON is the default format.
createDocument_documentFormat :: Lens.Lens' CreateDocument (Prelude.Maybe DocumentFormat)
createDocument_documentFormat :: Lens' CreateDocument (Maybe DocumentFormat)
createDocument_documentFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe DocumentFormat
documentFormat :: Maybe DocumentFormat
$sel:documentFormat:CreateDocument' :: CreateDocument -> Maybe DocumentFormat
documentFormat} -> Maybe DocumentFormat
documentFormat) (\s :: CreateDocument
s@CreateDocument' {} Maybe DocumentFormat
a -> CreateDocument
s {$sel:documentFormat:CreateDocument' :: Maybe DocumentFormat
documentFormat = Maybe DocumentFormat
a} :: CreateDocument)

-- | The type of document to create.
--
-- The @DeploymentStrategy@ document type is an internal-use-only document
-- type reserved for AppConfig.
createDocument_documentType :: Lens.Lens' CreateDocument (Prelude.Maybe DocumentType)
createDocument_documentType :: Lens' CreateDocument (Maybe DocumentType)
createDocument_documentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe DocumentType
documentType :: Maybe DocumentType
$sel:documentType:CreateDocument' :: CreateDocument -> Maybe DocumentType
documentType} -> Maybe DocumentType
documentType) (\s :: CreateDocument
s@CreateDocument' {} Maybe DocumentType
a -> CreateDocument
s {$sel:documentType:CreateDocument' :: Maybe DocumentType
documentType = Maybe DocumentType
a} :: CreateDocument)

-- | A list of SSM documents required by a document. This parameter is used
-- exclusively by AppConfig. When a user creates an AppConfig configuration
-- in an SSM document, the user must also specify a required document for
-- validation purposes. In this case, an @ApplicationConfiguration@
-- document requires an @ApplicationConfigurationSchema@ document for
-- validation purposes. For more information, see
-- <https://docs.aws.amazon.com/appconfig/latest/userguide/what-is-appconfig.html What is AppConfig?>
-- in the /AppConfig User Guide/.
createDocument_requires :: Lens.Lens' CreateDocument (Prelude.Maybe (Prelude.NonEmpty DocumentRequires))
createDocument_requires :: Lens' CreateDocument (Maybe (NonEmpty DocumentRequires))
createDocument_requires = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe (NonEmpty DocumentRequires)
requires :: Maybe (NonEmpty DocumentRequires)
$sel:requires:CreateDocument' :: CreateDocument -> Maybe (NonEmpty DocumentRequires)
requires} -> Maybe (NonEmpty DocumentRequires)
requires) (\s :: CreateDocument
s@CreateDocument' {} Maybe (NonEmpty DocumentRequires)
a -> CreateDocument
s {$sel:requires:CreateDocument' :: Maybe (NonEmpty DocumentRequires)
requires = Maybe (NonEmpty DocumentRequires)
a} :: CreateDocument) 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

-- | Optional metadata that you assign to a resource. Tags enable you to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment. For example, you might want to tag an SSM document to
-- identify the types of targets or the environment where it will run. In
-- this case, you could specify the following key-value pairs:
--
-- -   @Key=OS,Value=Windows@
--
-- -   @Key=Environment,Value=Production@
--
-- To add tags to an existing SSM document, use the AddTagsToResource
-- operation.
createDocument_tags :: Lens.Lens' CreateDocument (Prelude.Maybe [Tag])
createDocument_tags :: Lens' CreateDocument (Maybe [Tag])
createDocument_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDocument' :: CreateDocument -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDocument
s@CreateDocument' {} Maybe [Tag]
a -> CreateDocument
s {$sel:tags:CreateDocument' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDocument) 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

-- | Specify a target type to define the kinds of resources the document can
-- run on. For example, to run a document on EC2 instances, specify the
-- following value: @\/AWS::EC2::Instance@. If you specify a value of
-- \'\/\' the document can run on all types of resources. If you don\'t
-- specify a value, the document can\'t run on any resources. For a list of
-- valid resource types, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-template-resource-type-ref.html Amazon Web Services resource and property types reference>
-- in the /CloudFormation User Guide/.
createDocument_targetType :: Lens.Lens' CreateDocument (Prelude.Maybe Prelude.Text)
createDocument_targetType :: Lens' CreateDocument (Maybe Text)
createDocument_targetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe Text
targetType :: Maybe Text
$sel:targetType:CreateDocument' :: CreateDocument -> Maybe Text
targetType} -> Maybe Text
targetType) (\s :: CreateDocument
s@CreateDocument' {} Maybe Text
a -> CreateDocument
s {$sel:targetType:CreateDocument' :: Maybe Text
targetType = Maybe Text
a} :: CreateDocument)

-- | An optional field specifying the version of the artifact you are
-- creating with the document. For example, @Release12.1@. This value is
-- unique across all versions of a document, and can\'t be changed.
createDocument_versionName :: Lens.Lens' CreateDocument (Prelude.Maybe Prelude.Text)
createDocument_versionName :: Lens' CreateDocument (Maybe Text)
createDocument_versionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Maybe Text
versionName :: Maybe Text
$sel:versionName:CreateDocument' :: CreateDocument -> Maybe Text
versionName} -> Maybe Text
versionName) (\s :: CreateDocument
s@CreateDocument' {} Maybe Text
a -> CreateDocument
s {$sel:versionName:CreateDocument' :: Maybe Text
versionName = Maybe Text
a} :: CreateDocument)

-- | The content for the new SSM document in JSON or YAML format. We
-- recommend storing the contents for your new document in an external JSON
-- or YAML file and referencing the file in a command.
--
-- For examples, see the following topics in the /Amazon Web Services
-- Systems Manager User Guide/.
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-api.html Create an SSM document (Amazon Web Services API)>
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-cli.html Create an SSM document (Amazon Web Services CLI)>
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/create-ssm-document-api.html Create an SSM document (API)>
createDocument_content :: Lens.Lens' CreateDocument Prelude.Text
createDocument_content :: Lens' CreateDocument Text
createDocument_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Text
content :: Text
$sel:content:CreateDocument' :: CreateDocument -> Text
content} -> Text
content) (\s :: CreateDocument
s@CreateDocument' {} Text
a -> CreateDocument
s {$sel:content:CreateDocument' :: Text
content = Text
a} :: CreateDocument)

-- | A name for the SSM document.
--
-- You can\'t use the following strings as document name prefixes. These
-- are reserved by Amazon Web Services for use as document name prefixes:
--
-- -   @aws@
--
-- -   @amazon@
--
-- -   @amzn@
createDocument_name :: Lens.Lens' CreateDocument Prelude.Text
createDocument_name :: Lens' CreateDocument Text
createDocument_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocument' {Text
name :: Text
$sel:name:CreateDocument' :: CreateDocument -> Text
name} -> Text
name) (\s :: CreateDocument
s@CreateDocument' {} Text
a -> CreateDocument
s {$sel:name:CreateDocument' :: Text
name = Text
a} :: CreateDocument)

instance Core.AWSRequest CreateDocument where
  type
    AWSResponse CreateDocument =
      CreateDocumentResponse
  request :: (Service -> Service) -> CreateDocument -> Request CreateDocument
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 CreateDocument
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDocument)))
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 DocumentDescription -> Int -> CreateDocumentResponse
CreateDocumentResponse'
            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
"DocumentDescription")
            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 CreateDocument where
  hashWithSalt :: Int -> CreateDocument -> Int
hashWithSalt Int
_salt CreateDocument' {Maybe [AttachmentsSource]
Maybe [Tag]
Maybe (NonEmpty DocumentRequires)
Maybe Text
Maybe DocumentFormat
Maybe DocumentType
Text
name :: Text
content :: Text
versionName :: Maybe Text
targetType :: Maybe Text
tags :: Maybe [Tag]
requires :: Maybe (NonEmpty DocumentRequires)
documentType :: Maybe DocumentType
documentFormat :: Maybe DocumentFormat
displayName :: Maybe Text
attachments :: Maybe [AttachmentsSource]
$sel:name:CreateDocument' :: CreateDocument -> Text
$sel:content:CreateDocument' :: CreateDocument -> Text
$sel:versionName:CreateDocument' :: CreateDocument -> Maybe Text
$sel:targetType:CreateDocument' :: CreateDocument -> Maybe Text
$sel:tags:CreateDocument' :: CreateDocument -> Maybe [Tag]
$sel:requires:CreateDocument' :: CreateDocument -> Maybe (NonEmpty DocumentRequires)
$sel:documentType:CreateDocument' :: CreateDocument -> Maybe DocumentType
$sel:documentFormat:CreateDocument' :: CreateDocument -> Maybe DocumentFormat
$sel:displayName:CreateDocument' :: CreateDocument -> Maybe Text
$sel:attachments:CreateDocument' :: CreateDocument -> Maybe [AttachmentsSource]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AttachmentsSource]
attachments
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DocumentFormat
documentFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DocumentType
documentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty DocumentRequires)
requires
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
versionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateDocument where
  rnf :: CreateDocument -> ()
rnf CreateDocument' {Maybe [AttachmentsSource]
Maybe [Tag]
Maybe (NonEmpty DocumentRequires)
Maybe Text
Maybe DocumentFormat
Maybe DocumentType
Text
name :: Text
content :: Text
versionName :: Maybe Text
targetType :: Maybe Text
tags :: Maybe [Tag]
requires :: Maybe (NonEmpty DocumentRequires)
documentType :: Maybe DocumentType
documentFormat :: Maybe DocumentFormat
displayName :: Maybe Text
attachments :: Maybe [AttachmentsSource]
$sel:name:CreateDocument' :: CreateDocument -> Text
$sel:content:CreateDocument' :: CreateDocument -> Text
$sel:versionName:CreateDocument' :: CreateDocument -> Maybe Text
$sel:targetType:CreateDocument' :: CreateDocument -> Maybe Text
$sel:tags:CreateDocument' :: CreateDocument -> Maybe [Tag]
$sel:requires:CreateDocument' :: CreateDocument -> Maybe (NonEmpty DocumentRequires)
$sel:documentType:CreateDocument' :: CreateDocument -> Maybe DocumentType
$sel:documentFormat:CreateDocument' :: CreateDocument -> Maybe DocumentFormat
$sel:displayName:CreateDocument' :: CreateDocument -> Maybe Text
$sel:attachments:CreateDocument' :: CreateDocument -> Maybe [AttachmentsSource]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttachmentsSource]
attachments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentFormat
documentFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DocumentType
documentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty DocumentRequires)
requires
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
versionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateDocument where
  toHeaders :: CreateDocument -> 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
"AmazonSSM.CreateDocument" :: 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 CreateDocument where
  toJSON :: CreateDocument -> Value
toJSON CreateDocument' {Maybe [AttachmentsSource]
Maybe [Tag]
Maybe (NonEmpty DocumentRequires)
Maybe Text
Maybe DocumentFormat
Maybe DocumentType
Text
name :: Text
content :: Text
versionName :: Maybe Text
targetType :: Maybe Text
tags :: Maybe [Tag]
requires :: Maybe (NonEmpty DocumentRequires)
documentType :: Maybe DocumentType
documentFormat :: Maybe DocumentFormat
displayName :: Maybe Text
attachments :: Maybe [AttachmentsSource]
$sel:name:CreateDocument' :: CreateDocument -> Text
$sel:content:CreateDocument' :: CreateDocument -> Text
$sel:versionName:CreateDocument' :: CreateDocument -> Maybe Text
$sel:targetType:CreateDocument' :: CreateDocument -> Maybe Text
$sel:tags:CreateDocument' :: CreateDocument -> Maybe [Tag]
$sel:requires:CreateDocument' :: CreateDocument -> Maybe (NonEmpty DocumentRequires)
$sel:documentType:CreateDocument' :: CreateDocument -> Maybe DocumentType
$sel:documentFormat:CreateDocument' :: CreateDocument -> Maybe DocumentFormat
$sel:displayName:CreateDocument' :: CreateDocument -> Maybe Text
$sel:attachments:CreateDocument' :: CreateDocument -> Maybe [AttachmentsSource]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Attachments" 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 [AttachmentsSource]
attachments,
            (Key
"DisplayName" 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
displayName,
            (Key
"DocumentFormat" 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 DocumentFormat
documentFormat,
            (Key
"DocumentType" 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 DocumentType
documentType,
            (Key
"Requires" 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 (NonEmpty DocumentRequires)
requires,
            (Key
"Tags" 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 [Tag]
tags,
            (Key
"TargetType" 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
targetType,
            (Key
"VersionName" 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
versionName,
            forall a. a -> Maybe a
Prelude.Just (Key
"Content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
content),
            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 CreateDocument where
  toPath :: CreateDocument -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CreateDocumentResponse' 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:
--
-- 'documentDescription', 'createDocumentResponse_documentDescription' - Information about the SSM document.
--
-- 'httpStatus', 'createDocumentResponse_httpStatus' - The response's http status code.
newCreateDocumentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDocumentResponse
newCreateDocumentResponse :: Int -> CreateDocumentResponse
newCreateDocumentResponse Int
pHttpStatus_ =
  CreateDocumentResponse'
    { $sel:documentDescription:CreateDocumentResponse' :: Maybe DocumentDescription
documentDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDocumentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the SSM document.
createDocumentResponse_documentDescription :: Lens.Lens' CreateDocumentResponse (Prelude.Maybe DocumentDescription)
createDocumentResponse_documentDescription :: Lens' CreateDocumentResponse (Maybe DocumentDescription)
createDocumentResponse_documentDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDocumentResponse' {Maybe DocumentDescription
documentDescription :: Maybe DocumentDescription
$sel:documentDescription:CreateDocumentResponse' :: CreateDocumentResponse -> Maybe DocumentDescription
documentDescription} -> Maybe DocumentDescription
documentDescription) (\s :: CreateDocumentResponse
s@CreateDocumentResponse' {} Maybe DocumentDescription
a -> CreateDocumentResponse
s {$sel:documentDescription:CreateDocumentResponse' :: Maybe DocumentDescription
documentDescription = Maybe DocumentDescription
a} :: CreateDocumentResponse)

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

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