{-# 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.CreateOpsItem
-- 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 OpsItem. You must have permission in Identity and Access
-- Management (IAM) to create a new OpsItem. For more information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-getting-started.html Getting started with OpsCenter>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- Operations engineers and IT professionals use Amazon Web Services
-- Systems Manager OpsCenter to view, investigate, and remediate
-- operational issues impacting the performance and health of their Amazon
-- Web Services resources. For more information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter.html Amazon Web Services Systems Manager OpsCenter>
-- in the /Amazon Web Services Systems Manager User Guide/.
module Amazonka.SSM.CreateOpsItem
  ( -- * Creating a Request
    CreateOpsItem (..),
    newCreateOpsItem,

    -- * Request Lenses
    createOpsItem_accountId,
    createOpsItem_actualEndTime,
    createOpsItem_actualStartTime,
    createOpsItem_category,
    createOpsItem_notifications,
    createOpsItem_operationalData,
    createOpsItem_opsItemType,
    createOpsItem_plannedEndTime,
    createOpsItem_plannedStartTime,
    createOpsItem_priority,
    createOpsItem_relatedOpsItems,
    createOpsItem_severity,
    createOpsItem_tags,
    createOpsItem_description,
    createOpsItem_source,
    createOpsItem_title,

    -- * Destructuring the Response
    CreateOpsItemResponse (..),
    newCreateOpsItemResponse,

    -- * Response Lenses
    createOpsItemResponse_opsItemArn,
    createOpsItemResponse_opsItemId,
    createOpsItemResponse_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:/ 'newCreateOpsItem' smart constructor.
data CreateOpsItem = CreateOpsItem'
  { -- | The target Amazon Web Services account where you want to create an
    -- OpsItem. To make this call, your account must be configured to work with
    -- OpsItems across accounts. For more information, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-OpsCenter-multiple-accounts.html Setting up OpsCenter to work with OpsItems across accounts>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    CreateOpsItem -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | The time a runbook workflow ended. Currently reported only for the
    -- OpsItem type @\/aws\/changerequest@.
    CreateOpsItem -> Maybe POSIX
actualEndTime :: Prelude.Maybe Data.POSIX,
    -- | The time a runbook workflow started. Currently reported only for the
    -- OpsItem type @\/aws\/changerequest@.
    CreateOpsItem -> Maybe POSIX
actualStartTime :: Prelude.Maybe Data.POSIX,
    -- | Specify a category to assign to an OpsItem.
    CreateOpsItem -> Maybe Text
category :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of an SNS topic where notifications are
    -- sent when this OpsItem is edited or changed.
    CreateOpsItem -> Maybe [OpsItemNotification]
notifications :: Prelude.Maybe [OpsItemNotification],
    -- | Operational data is custom data that provides useful reference details
    -- about the OpsItem. For example, you can specify log files, error
    -- strings, license keys, troubleshooting tips, or other relevant data. You
    -- enter operational data as key-value pairs. The key has a maximum length
    -- of 128 characters. The value has a maximum size of 20 KB.
    --
    -- Operational data keys /can\'t/ begin with the following: @amazon@,
    -- @aws@, @amzn@, @ssm@, @\/amazon@, @\/aws@, @\/amzn@, @\/ssm@.
    --
    -- You can choose to make the data searchable by other users in the account
    -- or you can restrict search access. Searchable data means that all users
    -- with access to the OpsItem Overview page (as provided by the
    -- DescribeOpsItems API operation) can view and search on the specified
    -- data. Operational data that isn\'t searchable is only viewable by users
    -- who have access to the OpsItem (as provided by the GetOpsItem API
    -- operation).
    --
    -- Use the @\/aws\/resources@ key in OperationalData to specify a related
    -- resource in the request. Use the @\/aws\/automations@ key in
    -- OperationalData to associate an Automation runbook with the OpsItem. To
    -- view Amazon Web Services CLI example commands that use these keys, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-creating-OpsItems.html#OpsCenter-manually-create-OpsItems Creating OpsItems manually>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    CreateOpsItem -> Maybe (HashMap Text OpsItemDataValue)
operationalData :: Prelude.Maybe (Prelude.HashMap Prelude.Text OpsItemDataValue),
    -- | The type of OpsItem to create. Systems Manager supports the following
    -- types of OpsItems:
    --
    -- -   @\/aws\/issue@
    --
    --     This type of OpsItem is used for default OpsItems created by
    --     OpsCenter.
    --
    -- -   @\/aws\/changerequest@
    --
    --     This type of OpsItem is used by Change Manager for reviewing and
    --     approving or rejecting change requests.
    --
    -- -   @\/aws\/insights@
    --
    --     This type of OpsItem is used by OpsCenter for aggregating and
    --     reporting on duplicate OpsItems.
    CreateOpsItem -> Maybe Text
opsItemType :: Prelude.Maybe Prelude.Text,
    -- | The time specified in a change request for a runbook workflow to end.
    -- Currently supported only for the OpsItem type @\/aws\/changerequest@.
    CreateOpsItem -> Maybe POSIX
plannedEndTime :: Prelude.Maybe Data.POSIX,
    -- | The time specified in a change request for a runbook workflow to start.
    -- Currently supported only for the OpsItem type @\/aws\/changerequest@.
    CreateOpsItem -> Maybe POSIX
plannedStartTime :: Prelude.Maybe Data.POSIX,
    -- | The importance of this OpsItem in relation to other OpsItems in the
    -- system.
    CreateOpsItem -> Maybe Natural
priority :: Prelude.Maybe Prelude.Natural,
    -- | One or more OpsItems that share something in common with the current
    -- OpsItems. For example, related OpsItems can include OpsItems with
    -- similar error messages, impacted resources, or statuses for the impacted
    -- resource.
    CreateOpsItem -> Maybe [RelatedOpsItem]
relatedOpsItems :: Prelude.Maybe [RelatedOpsItem],
    -- | Specify a severity to assign to an OpsItem.
    CreateOpsItem -> Maybe Text
severity :: Prelude.Maybe Prelude.Text,
    -- | Optional metadata that you assign to a resource. You can restrict access
    -- to OpsItems by using an inline IAM policy that specifies tags. For more
    -- information, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-getting-started.html#OpsCenter-getting-started-user-permissions Getting started with OpsCenter>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    --
    -- Tags use a key-value pair. For example:
    --
    -- @Key=Department,Value=Finance@
    --
    -- To add tags to a new OpsItem, a user must have IAM permissions for both
    -- the @ssm:CreateOpsItems@ operation and the @ssm:AddTagsToResource@
    -- operation. To add tags to an existing OpsItem, use the AddTagsToResource
    -- operation.
    CreateOpsItem -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Information about the OpsItem.
    CreateOpsItem -> Text
description :: Prelude.Text,
    -- | The origin of the OpsItem, such as Amazon EC2 or Systems Manager.
    --
    -- The source name can\'t contain the following strings: @aws@, @amazon@,
    -- and @amzn@.
    CreateOpsItem -> Text
source :: Prelude.Text,
    -- | A short heading that describes the nature of the OpsItem and the
    -- impacted resource.
    CreateOpsItem -> Text
title :: Prelude.Text
  }
  deriving (CreateOpsItem -> CreateOpsItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOpsItem -> CreateOpsItem -> Bool
$c/= :: CreateOpsItem -> CreateOpsItem -> Bool
== :: CreateOpsItem -> CreateOpsItem -> Bool
$c== :: CreateOpsItem -> CreateOpsItem -> Bool
Prelude.Eq, ReadPrec [CreateOpsItem]
ReadPrec CreateOpsItem
Int -> ReadS CreateOpsItem
ReadS [CreateOpsItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOpsItem]
$creadListPrec :: ReadPrec [CreateOpsItem]
readPrec :: ReadPrec CreateOpsItem
$creadPrec :: ReadPrec CreateOpsItem
readList :: ReadS [CreateOpsItem]
$creadList :: ReadS [CreateOpsItem]
readsPrec :: Int -> ReadS CreateOpsItem
$creadsPrec :: Int -> ReadS CreateOpsItem
Prelude.Read, Int -> CreateOpsItem -> ShowS
[CreateOpsItem] -> ShowS
CreateOpsItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOpsItem] -> ShowS
$cshowList :: [CreateOpsItem] -> ShowS
show :: CreateOpsItem -> String
$cshow :: CreateOpsItem -> String
showsPrec :: Int -> CreateOpsItem -> ShowS
$cshowsPrec :: Int -> CreateOpsItem -> ShowS
Prelude.Show, forall x. Rep CreateOpsItem x -> CreateOpsItem
forall x. CreateOpsItem -> Rep CreateOpsItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOpsItem x -> CreateOpsItem
$cfrom :: forall x. CreateOpsItem -> Rep CreateOpsItem x
Prelude.Generic)

-- |
-- Create a value of 'CreateOpsItem' 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:
--
-- 'accountId', 'createOpsItem_accountId' - The target Amazon Web Services account where you want to create an
-- OpsItem. To make this call, your account must be configured to work with
-- OpsItems across accounts. For more information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-OpsCenter-multiple-accounts.html Setting up OpsCenter to work with OpsItems across accounts>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'actualEndTime', 'createOpsItem_actualEndTime' - The time a runbook workflow ended. Currently reported only for the
-- OpsItem type @\/aws\/changerequest@.
--
-- 'actualStartTime', 'createOpsItem_actualStartTime' - The time a runbook workflow started. Currently reported only for the
-- OpsItem type @\/aws\/changerequest@.
--
-- 'category', 'createOpsItem_category' - Specify a category to assign to an OpsItem.
--
-- 'notifications', 'createOpsItem_notifications' - The Amazon Resource Name (ARN) of an SNS topic where notifications are
-- sent when this OpsItem is edited or changed.
--
-- 'operationalData', 'createOpsItem_operationalData' - Operational data is custom data that provides useful reference details
-- about the OpsItem. For example, you can specify log files, error
-- strings, license keys, troubleshooting tips, or other relevant data. You
-- enter operational data as key-value pairs. The key has a maximum length
-- of 128 characters. The value has a maximum size of 20 KB.
--
-- Operational data keys /can\'t/ begin with the following: @amazon@,
-- @aws@, @amzn@, @ssm@, @\/amazon@, @\/aws@, @\/amzn@, @\/ssm@.
--
-- You can choose to make the data searchable by other users in the account
-- or you can restrict search access. Searchable data means that all users
-- with access to the OpsItem Overview page (as provided by the
-- DescribeOpsItems API operation) can view and search on the specified
-- data. Operational data that isn\'t searchable is only viewable by users
-- who have access to the OpsItem (as provided by the GetOpsItem API
-- operation).
--
-- Use the @\/aws\/resources@ key in OperationalData to specify a related
-- resource in the request. Use the @\/aws\/automations@ key in
-- OperationalData to associate an Automation runbook with the OpsItem. To
-- view Amazon Web Services CLI example commands that use these keys, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-creating-OpsItems.html#OpsCenter-manually-create-OpsItems Creating OpsItems manually>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'opsItemType', 'createOpsItem_opsItemType' - The type of OpsItem to create. Systems Manager supports the following
-- types of OpsItems:
--
-- -   @\/aws\/issue@
--
--     This type of OpsItem is used for default OpsItems created by
--     OpsCenter.
--
-- -   @\/aws\/changerequest@
--
--     This type of OpsItem is used by Change Manager for reviewing and
--     approving or rejecting change requests.
--
-- -   @\/aws\/insights@
--
--     This type of OpsItem is used by OpsCenter for aggregating and
--     reporting on duplicate OpsItems.
--
-- 'plannedEndTime', 'createOpsItem_plannedEndTime' - The time specified in a change request for a runbook workflow to end.
-- Currently supported only for the OpsItem type @\/aws\/changerequest@.
--
-- 'plannedStartTime', 'createOpsItem_plannedStartTime' - The time specified in a change request for a runbook workflow to start.
-- Currently supported only for the OpsItem type @\/aws\/changerequest@.
--
-- 'priority', 'createOpsItem_priority' - The importance of this OpsItem in relation to other OpsItems in the
-- system.
--
-- 'relatedOpsItems', 'createOpsItem_relatedOpsItems' - One or more OpsItems that share something in common with the current
-- OpsItems. For example, related OpsItems can include OpsItems with
-- similar error messages, impacted resources, or statuses for the impacted
-- resource.
--
-- 'severity', 'createOpsItem_severity' - Specify a severity to assign to an OpsItem.
--
-- 'tags', 'createOpsItem_tags' - Optional metadata that you assign to a resource. You can restrict access
-- to OpsItems by using an inline IAM policy that specifies tags. For more
-- information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-getting-started.html#OpsCenter-getting-started-user-permissions Getting started with OpsCenter>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- Tags use a key-value pair. For example:
--
-- @Key=Department,Value=Finance@
--
-- To add tags to a new OpsItem, a user must have IAM permissions for both
-- the @ssm:CreateOpsItems@ operation and the @ssm:AddTagsToResource@
-- operation. To add tags to an existing OpsItem, use the AddTagsToResource
-- operation.
--
-- 'description', 'createOpsItem_description' - Information about the OpsItem.
--
-- 'source', 'createOpsItem_source' - The origin of the OpsItem, such as Amazon EC2 or Systems Manager.
--
-- The source name can\'t contain the following strings: @aws@, @amazon@,
-- and @amzn@.
--
-- 'title', 'createOpsItem_title' - A short heading that describes the nature of the OpsItem and the
-- impacted resource.
newCreateOpsItem ::
  -- | 'description'
  Prelude.Text ->
  -- | 'source'
  Prelude.Text ->
  -- | 'title'
  Prelude.Text ->
  CreateOpsItem
newCreateOpsItem :: Text -> Text -> Text -> CreateOpsItem
newCreateOpsItem Text
pDescription_ Text
pSource_ Text
pTitle_ =
  CreateOpsItem'
    { $sel:accountId:CreateOpsItem' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:actualEndTime:CreateOpsItem' :: Maybe POSIX
actualEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:actualStartTime:CreateOpsItem' :: Maybe POSIX
actualStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:category:CreateOpsItem' :: Maybe Text
category = forall a. Maybe a
Prelude.Nothing,
      $sel:notifications:CreateOpsItem' :: Maybe [OpsItemNotification]
notifications = forall a. Maybe a
Prelude.Nothing,
      $sel:operationalData:CreateOpsItem' :: Maybe (HashMap Text OpsItemDataValue)
operationalData = forall a. Maybe a
Prelude.Nothing,
      $sel:opsItemType:CreateOpsItem' :: Maybe Text
opsItemType = forall a. Maybe a
Prelude.Nothing,
      $sel:plannedEndTime:CreateOpsItem' :: Maybe POSIX
plannedEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:plannedStartTime:CreateOpsItem' :: Maybe POSIX
plannedStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:priority:CreateOpsItem' :: Maybe Natural
priority = forall a. Maybe a
Prelude.Nothing,
      $sel:relatedOpsItems:CreateOpsItem' :: Maybe [RelatedOpsItem]
relatedOpsItems = forall a. Maybe a
Prelude.Nothing,
      $sel:severity:CreateOpsItem' :: Maybe Text
severity = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateOpsItem' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateOpsItem' :: Text
description = Text
pDescription_,
      $sel:source:CreateOpsItem' :: Text
source = Text
pSource_,
      $sel:title:CreateOpsItem' :: Text
title = Text
pTitle_
    }

-- | The target Amazon Web Services account where you want to create an
-- OpsItem. To make this call, your account must be configured to work with
-- OpsItems across accounts. For more information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/systems-manager-OpsCenter-multiple-accounts.html Setting up OpsCenter to work with OpsItems across accounts>
-- in the /Amazon Web Services Systems Manager User Guide/.
createOpsItem_accountId :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.Text)
createOpsItem_accountId :: Lens' CreateOpsItem (Maybe Text)
createOpsItem_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe Text
accountId :: Maybe Text
$sel:accountId:CreateOpsItem' :: CreateOpsItem -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe Text
a -> CreateOpsItem
s {$sel:accountId:CreateOpsItem' :: Maybe Text
accountId = Maybe Text
a} :: CreateOpsItem)

-- | The time a runbook workflow ended. Currently reported only for the
-- OpsItem type @\/aws\/changerequest@.
createOpsItem_actualEndTime :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.UTCTime)
createOpsItem_actualEndTime :: Lens' CreateOpsItem (Maybe UTCTime)
createOpsItem_actualEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe POSIX
actualEndTime :: Maybe POSIX
$sel:actualEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
actualEndTime} -> Maybe POSIX
actualEndTime) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe POSIX
a -> CreateOpsItem
s {$sel:actualEndTime:CreateOpsItem' :: Maybe POSIX
actualEndTime = Maybe POSIX
a} :: CreateOpsItem) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time a runbook workflow started. Currently reported only for the
-- OpsItem type @\/aws\/changerequest@.
createOpsItem_actualStartTime :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.UTCTime)
createOpsItem_actualStartTime :: Lens' CreateOpsItem (Maybe UTCTime)
createOpsItem_actualStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe POSIX
actualStartTime :: Maybe POSIX
$sel:actualStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
actualStartTime} -> Maybe POSIX
actualStartTime) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe POSIX
a -> CreateOpsItem
s {$sel:actualStartTime:CreateOpsItem' :: Maybe POSIX
actualStartTime = Maybe POSIX
a} :: CreateOpsItem) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Specify a category to assign to an OpsItem.
createOpsItem_category :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.Text)
createOpsItem_category :: Lens' CreateOpsItem (Maybe Text)
createOpsItem_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe Text
category :: Maybe Text
$sel:category:CreateOpsItem' :: CreateOpsItem -> Maybe Text
category} -> Maybe Text
category) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe Text
a -> CreateOpsItem
s {$sel:category:CreateOpsItem' :: Maybe Text
category = Maybe Text
a} :: CreateOpsItem)

-- | The Amazon Resource Name (ARN) of an SNS topic where notifications are
-- sent when this OpsItem is edited or changed.
createOpsItem_notifications :: Lens.Lens' CreateOpsItem (Prelude.Maybe [OpsItemNotification])
createOpsItem_notifications :: Lens' CreateOpsItem (Maybe [OpsItemNotification])
createOpsItem_notifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe [OpsItemNotification]
notifications :: Maybe [OpsItemNotification]
$sel:notifications:CreateOpsItem' :: CreateOpsItem -> Maybe [OpsItemNotification]
notifications} -> Maybe [OpsItemNotification]
notifications) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe [OpsItemNotification]
a -> CreateOpsItem
s {$sel:notifications:CreateOpsItem' :: Maybe [OpsItemNotification]
notifications = Maybe [OpsItemNotification]
a} :: CreateOpsItem) 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

-- | Operational data is custom data that provides useful reference details
-- about the OpsItem. For example, you can specify log files, error
-- strings, license keys, troubleshooting tips, or other relevant data. You
-- enter operational data as key-value pairs. The key has a maximum length
-- of 128 characters. The value has a maximum size of 20 KB.
--
-- Operational data keys /can\'t/ begin with the following: @amazon@,
-- @aws@, @amzn@, @ssm@, @\/amazon@, @\/aws@, @\/amzn@, @\/ssm@.
--
-- You can choose to make the data searchable by other users in the account
-- or you can restrict search access. Searchable data means that all users
-- with access to the OpsItem Overview page (as provided by the
-- DescribeOpsItems API operation) can view and search on the specified
-- data. Operational data that isn\'t searchable is only viewable by users
-- who have access to the OpsItem (as provided by the GetOpsItem API
-- operation).
--
-- Use the @\/aws\/resources@ key in OperationalData to specify a related
-- resource in the request. Use the @\/aws\/automations@ key in
-- OperationalData to associate an Automation runbook with the OpsItem. To
-- view Amazon Web Services CLI example commands that use these keys, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-creating-OpsItems.html#OpsCenter-manually-create-OpsItems Creating OpsItems manually>
-- in the /Amazon Web Services Systems Manager User Guide/.
createOpsItem_operationalData :: Lens.Lens' CreateOpsItem (Prelude.Maybe (Prelude.HashMap Prelude.Text OpsItemDataValue))
createOpsItem_operationalData :: Lens' CreateOpsItem (Maybe (HashMap Text OpsItemDataValue))
createOpsItem_operationalData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe (HashMap Text OpsItemDataValue)
operationalData :: Maybe (HashMap Text OpsItemDataValue)
$sel:operationalData:CreateOpsItem' :: CreateOpsItem -> Maybe (HashMap Text OpsItemDataValue)
operationalData} -> Maybe (HashMap Text OpsItemDataValue)
operationalData) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe (HashMap Text OpsItemDataValue)
a -> CreateOpsItem
s {$sel:operationalData:CreateOpsItem' :: Maybe (HashMap Text OpsItemDataValue)
operationalData = Maybe (HashMap Text OpsItemDataValue)
a} :: CreateOpsItem) 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 type of OpsItem to create. Systems Manager supports the following
-- types of OpsItems:
--
-- -   @\/aws\/issue@
--
--     This type of OpsItem is used for default OpsItems created by
--     OpsCenter.
--
-- -   @\/aws\/changerequest@
--
--     This type of OpsItem is used by Change Manager for reviewing and
--     approving or rejecting change requests.
--
-- -   @\/aws\/insights@
--
--     This type of OpsItem is used by OpsCenter for aggregating and
--     reporting on duplicate OpsItems.
createOpsItem_opsItemType :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.Text)
createOpsItem_opsItemType :: Lens' CreateOpsItem (Maybe Text)
createOpsItem_opsItemType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe Text
opsItemType :: Maybe Text
$sel:opsItemType:CreateOpsItem' :: CreateOpsItem -> Maybe Text
opsItemType} -> Maybe Text
opsItemType) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe Text
a -> CreateOpsItem
s {$sel:opsItemType:CreateOpsItem' :: Maybe Text
opsItemType = Maybe Text
a} :: CreateOpsItem)

-- | The time specified in a change request for a runbook workflow to end.
-- Currently supported only for the OpsItem type @\/aws\/changerequest@.
createOpsItem_plannedEndTime :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.UTCTime)
createOpsItem_plannedEndTime :: Lens' CreateOpsItem (Maybe UTCTime)
createOpsItem_plannedEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe POSIX
plannedEndTime :: Maybe POSIX
$sel:plannedEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
plannedEndTime} -> Maybe POSIX
plannedEndTime) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe POSIX
a -> CreateOpsItem
s {$sel:plannedEndTime:CreateOpsItem' :: Maybe POSIX
plannedEndTime = Maybe POSIX
a} :: CreateOpsItem) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time specified in a change request for a runbook workflow to start.
-- Currently supported only for the OpsItem type @\/aws\/changerequest@.
createOpsItem_plannedStartTime :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.UTCTime)
createOpsItem_plannedStartTime :: Lens' CreateOpsItem (Maybe UTCTime)
createOpsItem_plannedStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe POSIX
plannedStartTime :: Maybe POSIX
$sel:plannedStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
plannedStartTime} -> Maybe POSIX
plannedStartTime) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe POSIX
a -> CreateOpsItem
s {$sel:plannedStartTime:CreateOpsItem' :: Maybe POSIX
plannedStartTime = Maybe POSIX
a} :: CreateOpsItem) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The importance of this OpsItem in relation to other OpsItems in the
-- system.
createOpsItem_priority :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.Natural)
createOpsItem_priority :: Lens' CreateOpsItem (Maybe Natural)
createOpsItem_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe Natural
priority :: Maybe Natural
$sel:priority:CreateOpsItem' :: CreateOpsItem -> Maybe Natural
priority} -> Maybe Natural
priority) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe Natural
a -> CreateOpsItem
s {$sel:priority:CreateOpsItem' :: Maybe Natural
priority = Maybe Natural
a} :: CreateOpsItem)

-- | One or more OpsItems that share something in common with the current
-- OpsItems. For example, related OpsItems can include OpsItems with
-- similar error messages, impacted resources, or statuses for the impacted
-- resource.
createOpsItem_relatedOpsItems :: Lens.Lens' CreateOpsItem (Prelude.Maybe [RelatedOpsItem])
createOpsItem_relatedOpsItems :: Lens' CreateOpsItem (Maybe [RelatedOpsItem])
createOpsItem_relatedOpsItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe [RelatedOpsItem]
relatedOpsItems :: Maybe [RelatedOpsItem]
$sel:relatedOpsItems:CreateOpsItem' :: CreateOpsItem -> Maybe [RelatedOpsItem]
relatedOpsItems} -> Maybe [RelatedOpsItem]
relatedOpsItems) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe [RelatedOpsItem]
a -> CreateOpsItem
s {$sel:relatedOpsItems:CreateOpsItem' :: Maybe [RelatedOpsItem]
relatedOpsItems = Maybe [RelatedOpsItem]
a} :: CreateOpsItem) 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 severity to assign to an OpsItem.
createOpsItem_severity :: Lens.Lens' CreateOpsItem (Prelude.Maybe Prelude.Text)
createOpsItem_severity :: Lens' CreateOpsItem (Maybe Text)
createOpsItem_severity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe Text
severity :: Maybe Text
$sel:severity:CreateOpsItem' :: CreateOpsItem -> Maybe Text
severity} -> Maybe Text
severity) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe Text
a -> CreateOpsItem
s {$sel:severity:CreateOpsItem' :: Maybe Text
severity = Maybe Text
a} :: CreateOpsItem)

-- | Optional metadata that you assign to a resource. You can restrict access
-- to OpsItems by using an inline IAM policy that specifies tags. For more
-- information, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/OpsCenter-getting-started.html#OpsCenter-getting-started-user-permissions Getting started with OpsCenter>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- Tags use a key-value pair. For example:
--
-- @Key=Department,Value=Finance@
--
-- To add tags to a new OpsItem, a user must have IAM permissions for both
-- the @ssm:CreateOpsItems@ operation and the @ssm:AddTagsToResource@
-- operation. To add tags to an existing OpsItem, use the AddTagsToResource
-- operation.
createOpsItem_tags :: Lens.Lens' CreateOpsItem (Prelude.Maybe [Tag])
createOpsItem_tags :: Lens' CreateOpsItem (Maybe [Tag])
createOpsItem_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateOpsItem' :: CreateOpsItem -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateOpsItem
s@CreateOpsItem' {} Maybe [Tag]
a -> CreateOpsItem
s {$sel:tags:CreateOpsItem' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateOpsItem) 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

-- | Information about the OpsItem.
createOpsItem_description :: Lens.Lens' CreateOpsItem Prelude.Text
createOpsItem_description :: Lens' CreateOpsItem Text
createOpsItem_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Text
description :: Text
$sel:description:CreateOpsItem' :: CreateOpsItem -> Text
description} -> Text
description) (\s :: CreateOpsItem
s@CreateOpsItem' {} Text
a -> CreateOpsItem
s {$sel:description:CreateOpsItem' :: Text
description = Text
a} :: CreateOpsItem)

-- | The origin of the OpsItem, such as Amazon EC2 or Systems Manager.
--
-- The source name can\'t contain the following strings: @aws@, @amazon@,
-- and @amzn@.
createOpsItem_source :: Lens.Lens' CreateOpsItem Prelude.Text
createOpsItem_source :: Lens' CreateOpsItem Text
createOpsItem_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Text
source :: Text
$sel:source:CreateOpsItem' :: CreateOpsItem -> Text
source} -> Text
source) (\s :: CreateOpsItem
s@CreateOpsItem' {} Text
a -> CreateOpsItem
s {$sel:source:CreateOpsItem' :: Text
source = Text
a} :: CreateOpsItem)

-- | A short heading that describes the nature of the OpsItem and the
-- impacted resource.
createOpsItem_title :: Lens.Lens' CreateOpsItem Prelude.Text
createOpsItem_title :: Lens' CreateOpsItem Text
createOpsItem_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItem' {Text
title :: Text
$sel:title:CreateOpsItem' :: CreateOpsItem -> Text
title} -> Text
title) (\s :: CreateOpsItem
s@CreateOpsItem' {} Text
a -> CreateOpsItem
s {$sel:title:CreateOpsItem' :: Text
title = Text
a} :: CreateOpsItem)

instance Core.AWSRequest CreateOpsItem where
  type
    AWSResponse CreateOpsItem =
      CreateOpsItemResponse
  request :: (Service -> Service) -> CreateOpsItem -> Request CreateOpsItem
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 CreateOpsItem
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateOpsItem)))
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 Text -> Maybe Text -> Int -> CreateOpsItemResponse
CreateOpsItemResponse'
            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
"OpsItemArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"OpsItemId")
            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 CreateOpsItem where
  hashWithSalt :: Int -> CreateOpsItem -> Int
hashWithSalt Int
_salt CreateOpsItem' {Maybe Natural
Maybe [OpsItemNotification]
Maybe [RelatedOpsItem]
Maybe [Tag]
Maybe Text
Maybe (HashMap Text OpsItemDataValue)
Maybe POSIX
Text
title :: Text
source :: Text
description :: Text
tags :: Maybe [Tag]
severity :: Maybe Text
relatedOpsItems :: Maybe [RelatedOpsItem]
priority :: Maybe Natural
plannedStartTime :: Maybe POSIX
plannedEndTime :: Maybe POSIX
opsItemType :: Maybe Text
operationalData :: Maybe (HashMap Text OpsItemDataValue)
notifications :: Maybe [OpsItemNotification]
category :: Maybe Text
actualStartTime :: Maybe POSIX
actualEndTime :: Maybe POSIX
accountId :: Maybe Text
$sel:title:CreateOpsItem' :: CreateOpsItem -> Text
$sel:source:CreateOpsItem' :: CreateOpsItem -> Text
$sel:description:CreateOpsItem' :: CreateOpsItem -> Text
$sel:tags:CreateOpsItem' :: CreateOpsItem -> Maybe [Tag]
$sel:severity:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:relatedOpsItems:CreateOpsItem' :: CreateOpsItem -> Maybe [RelatedOpsItem]
$sel:priority:CreateOpsItem' :: CreateOpsItem -> Maybe Natural
$sel:plannedStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:plannedEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:opsItemType:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:operationalData:CreateOpsItem' :: CreateOpsItem -> Maybe (HashMap Text OpsItemDataValue)
$sel:notifications:CreateOpsItem' :: CreateOpsItem -> Maybe [OpsItemNotification]
$sel:category:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:actualStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:actualEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:accountId:CreateOpsItem' :: CreateOpsItem -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
actualEndTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
actualStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
category
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OpsItemNotification]
notifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text OpsItemDataValue)
operationalData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
opsItemType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
plannedEndTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
plannedStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
priority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RelatedOpsItem]
relatedOpsItems
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
severity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
source
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
title

instance Prelude.NFData CreateOpsItem where
  rnf :: CreateOpsItem -> ()
rnf CreateOpsItem' {Maybe Natural
Maybe [OpsItemNotification]
Maybe [RelatedOpsItem]
Maybe [Tag]
Maybe Text
Maybe (HashMap Text OpsItemDataValue)
Maybe POSIX
Text
title :: Text
source :: Text
description :: Text
tags :: Maybe [Tag]
severity :: Maybe Text
relatedOpsItems :: Maybe [RelatedOpsItem]
priority :: Maybe Natural
plannedStartTime :: Maybe POSIX
plannedEndTime :: Maybe POSIX
opsItemType :: Maybe Text
operationalData :: Maybe (HashMap Text OpsItemDataValue)
notifications :: Maybe [OpsItemNotification]
category :: Maybe Text
actualStartTime :: Maybe POSIX
actualEndTime :: Maybe POSIX
accountId :: Maybe Text
$sel:title:CreateOpsItem' :: CreateOpsItem -> Text
$sel:source:CreateOpsItem' :: CreateOpsItem -> Text
$sel:description:CreateOpsItem' :: CreateOpsItem -> Text
$sel:tags:CreateOpsItem' :: CreateOpsItem -> Maybe [Tag]
$sel:severity:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:relatedOpsItems:CreateOpsItem' :: CreateOpsItem -> Maybe [RelatedOpsItem]
$sel:priority:CreateOpsItem' :: CreateOpsItem -> Maybe Natural
$sel:plannedStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:plannedEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:opsItemType:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:operationalData:CreateOpsItem' :: CreateOpsItem -> Maybe (HashMap Text OpsItemDataValue)
$sel:notifications:CreateOpsItem' :: CreateOpsItem -> Maybe [OpsItemNotification]
$sel:category:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:actualStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:actualEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:accountId:CreateOpsItem' :: CreateOpsItem -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
actualEndTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
actualStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
category
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OpsItemNotification]
notifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text OpsItemDataValue)
operationalData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
opsItemType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
plannedEndTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
plannedStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RelatedOpsItem]
relatedOpsItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
severity
      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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
title

instance Data.ToHeaders CreateOpsItem where
  toHeaders :: CreateOpsItem -> 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.CreateOpsItem" :: 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 CreateOpsItem where
  toJSON :: CreateOpsItem -> Value
toJSON CreateOpsItem' {Maybe Natural
Maybe [OpsItemNotification]
Maybe [RelatedOpsItem]
Maybe [Tag]
Maybe Text
Maybe (HashMap Text OpsItemDataValue)
Maybe POSIX
Text
title :: Text
source :: Text
description :: Text
tags :: Maybe [Tag]
severity :: Maybe Text
relatedOpsItems :: Maybe [RelatedOpsItem]
priority :: Maybe Natural
plannedStartTime :: Maybe POSIX
plannedEndTime :: Maybe POSIX
opsItemType :: Maybe Text
operationalData :: Maybe (HashMap Text OpsItemDataValue)
notifications :: Maybe [OpsItemNotification]
category :: Maybe Text
actualStartTime :: Maybe POSIX
actualEndTime :: Maybe POSIX
accountId :: Maybe Text
$sel:title:CreateOpsItem' :: CreateOpsItem -> Text
$sel:source:CreateOpsItem' :: CreateOpsItem -> Text
$sel:description:CreateOpsItem' :: CreateOpsItem -> Text
$sel:tags:CreateOpsItem' :: CreateOpsItem -> Maybe [Tag]
$sel:severity:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:relatedOpsItems:CreateOpsItem' :: CreateOpsItem -> Maybe [RelatedOpsItem]
$sel:priority:CreateOpsItem' :: CreateOpsItem -> Maybe Natural
$sel:plannedStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:plannedEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:opsItemType:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:operationalData:CreateOpsItem' :: CreateOpsItem -> Maybe (HashMap Text OpsItemDataValue)
$sel:notifications:CreateOpsItem' :: CreateOpsItem -> Maybe [OpsItemNotification]
$sel:category:CreateOpsItem' :: CreateOpsItem -> Maybe Text
$sel:actualStartTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:actualEndTime:CreateOpsItem' :: CreateOpsItem -> Maybe POSIX
$sel:accountId:CreateOpsItem' :: CreateOpsItem -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountId" 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
accountId,
            (Key
"ActualEndTime" 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 POSIX
actualEndTime,
            (Key
"ActualStartTime" 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 POSIX
actualStartTime,
            (Key
"Category" 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
category,
            (Key
"Notifications" 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 [OpsItemNotification]
notifications,
            (Key
"OperationalData" 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 (HashMap Text OpsItemDataValue)
operationalData,
            (Key
"OpsItemType" 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
opsItemType,
            (Key
"PlannedEndTime" 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 POSIX
plannedEndTime,
            (Key
"PlannedStartTime" 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 POSIX
plannedStartTime,
            (Key
"Priority" 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 Natural
priority,
            (Key
"RelatedOpsItems" 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 [RelatedOpsItem]
relatedOpsItems,
            (Key
"Severity" 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
severity,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description),
            forall a. a -> Maybe a
Prelude.Just (Key
"Source" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
source),
            forall a. a -> Maybe a
Prelude.Just (Key
"Title" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
title)
          ]
      )

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

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

-- | /See:/ 'newCreateOpsItemResponse' smart constructor.
data CreateOpsItemResponse = CreateOpsItemResponse'
  { -- | The OpsItem Amazon Resource Name (ARN).
    CreateOpsItemResponse -> Maybe Text
opsItemArn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the OpsItem.
    CreateOpsItemResponse -> Maybe Text
opsItemId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateOpsItemResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateOpsItemResponse -> CreateOpsItemResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOpsItemResponse -> CreateOpsItemResponse -> Bool
$c/= :: CreateOpsItemResponse -> CreateOpsItemResponse -> Bool
== :: CreateOpsItemResponse -> CreateOpsItemResponse -> Bool
$c== :: CreateOpsItemResponse -> CreateOpsItemResponse -> Bool
Prelude.Eq, ReadPrec [CreateOpsItemResponse]
ReadPrec CreateOpsItemResponse
Int -> ReadS CreateOpsItemResponse
ReadS [CreateOpsItemResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOpsItemResponse]
$creadListPrec :: ReadPrec [CreateOpsItemResponse]
readPrec :: ReadPrec CreateOpsItemResponse
$creadPrec :: ReadPrec CreateOpsItemResponse
readList :: ReadS [CreateOpsItemResponse]
$creadList :: ReadS [CreateOpsItemResponse]
readsPrec :: Int -> ReadS CreateOpsItemResponse
$creadsPrec :: Int -> ReadS CreateOpsItemResponse
Prelude.Read, Int -> CreateOpsItemResponse -> ShowS
[CreateOpsItemResponse] -> ShowS
CreateOpsItemResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOpsItemResponse] -> ShowS
$cshowList :: [CreateOpsItemResponse] -> ShowS
show :: CreateOpsItemResponse -> String
$cshow :: CreateOpsItemResponse -> String
showsPrec :: Int -> CreateOpsItemResponse -> ShowS
$cshowsPrec :: Int -> CreateOpsItemResponse -> ShowS
Prelude.Show, forall x. Rep CreateOpsItemResponse x -> CreateOpsItemResponse
forall x. CreateOpsItemResponse -> Rep CreateOpsItemResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOpsItemResponse x -> CreateOpsItemResponse
$cfrom :: forall x. CreateOpsItemResponse -> Rep CreateOpsItemResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateOpsItemResponse' 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:
--
-- 'opsItemArn', 'createOpsItemResponse_opsItemArn' - The OpsItem Amazon Resource Name (ARN).
--
-- 'opsItemId', 'createOpsItemResponse_opsItemId' - The ID of the OpsItem.
--
-- 'httpStatus', 'createOpsItemResponse_httpStatus' - The response's http status code.
newCreateOpsItemResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOpsItemResponse
newCreateOpsItemResponse :: Int -> CreateOpsItemResponse
newCreateOpsItemResponse Int
pHttpStatus_ =
  CreateOpsItemResponse'
    { $sel:opsItemArn:CreateOpsItemResponse' :: Maybe Text
opsItemArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:opsItemId:CreateOpsItemResponse' :: Maybe Text
opsItemId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOpsItemResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The OpsItem Amazon Resource Name (ARN).
createOpsItemResponse_opsItemArn :: Lens.Lens' CreateOpsItemResponse (Prelude.Maybe Prelude.Text)
createOpsItemResponse_opsItemArn :: Lens' CreateOpsItemResponse (Maybe Text)
createOpsItemResponse_opsItemArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItemResponse' {Maybe Text
opsItemArn :: Maybe Text
$sel:opsItemArn:CreateOpsItemResponse' :: CreateOpsItemResponse -> Maybe Text
opsItemArn} -> Maybe Text
opsItemArn) (\s :: CreateOpsItemResponse
s@CreateOpsItemResponse' {} Maybe Text
a -> CreateOpsItemResponse
s {$sel:opsItemArn:CreateOpsItemResponse' :: Maybe Text
opsItemArn = Maybe Text
a} :: CreateOpsItemResponse)

-- | The ID of the OpsItem.
createOpsItemResponse_opsItemId :: Lens.Lens' CreateOpsItemResponse (Prelude.Maybe Prelude.Text)
createOpsItemResponse_opsItemId :: Lens' CreateOpsItemResponse (Maybe Text)
createOpsItemResponse_opsItemId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOpsItemResponse' {Maybe Text
opsItemId :: Maybe Text
$sel:opsItemId:CreateOpsItemResponse' :: CreateOpsItemResponse -> Maybe Text
opsItemId} -> Maybe Text
opsItemId) (\s :: CreateOpsItemResponse
s@CreateOpsItemResponse' {} Maybe Text
a -> CreateOpsItemResponse
s {$sel:opsItemId:CreateOpsItemResponse' :: Maybe Text
opsItemId = Maybe Text
a} :: CreateOpsItemResponse)

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

instance Prelude.NFData CreateOpsItemResponse where
  rnf :: CreateOpsItemResponse -> ()
rnf CreateOpsItemResponse' {Int
Maybe Text
httpStatus :: Int
opsItemId :: Maybe Text
opsItemArn :: Maybe Text
$sel:httpStatus:CreateOpsItemResponse' :: CreateOpsItemResponse -> Int
$sel:opsItemId:CreateOpsItemResponse' :: CreateOpsItemResponse -> Maybe Text
$sel:opsItemArn:CreateOpsItemResponse' :: CreateOpsItemResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
opsItemArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
opsItemId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus