{-# 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.SageMaker.DescribeAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes an action.
module Amazonka.SageMaker.DescribeAction
  ( -- * Creating a Request
    DescribeAction (..),
    newDescribeAction,

    -- * Request Lenses
    describeAction_actionName,

    -- * Destructuring the Response
    DescribeActionResponse (..),
    newDescribeActionResponse,

    -- * Response Lenses
    describeActionResponse_actionArn,
    describeActionResponse_actionName,
    describeActionResponse_actionType,
    describeActionResponse_createdBy,
    describeActionResponse_creationTime,
    describeActionResponse_description,
    describeActionResponse_lastModifiedBy,
    describeActionResponse_lastModifiedTime,
    describeActionResponse_lineageGroupArn,
    describeActionResponse_metadataProperties,
    describeActionResponse_properties,
    describeActionResponse_source,
    describeActionResponse_status,
    describeActionResponse_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.SageMaker.Types

-- | /See:/ 'newDescribeAction' smart constructor.
data DescribeAction = DescribeAction'
  { -- | The name of the action to describe.
    DescribeAction -> Text
actionName :: Prelude.Text
  }
  deriving (DescribeAction -> DescribeAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAction -> DescribeAction -> Bool
$c/= :: DescribeAction -> DescribeAction -> Bool
== :: DescribeAction -> DescribeAction -> Bool
$c== :: DescribeAction -> DescribeAction -> Bool
Prelude.Eq, ReadPrec [DescribeAction]
ReadPrec DescribeAction
Int -> ReadS DescribeAction
ReadS [DescribeAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAction]
$creadListPrec :: ReadPrec [DescribeAction]
readPrec :: ReadPrec DescribeAction
$creadPrec :: ReadPrec DescribeAction
readList :: ReadS [DescribeAction]
$creadList :: ReadS [DescribeAction]
readsPrec :: Int -> ReadS DescribeAction
$creadsPrec :: Int -> ReadS DescribeAction
Prelude.Read, Int -> DescribeAction -> ShowS
[DescribeAction] -> ShowS
DescribeAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAction] -> ShowS
$cshowList :: [DescribeAction] -> ShowS
show :: DescribeAction -> String
$cshow :: DescribeAction -> String
showsPrec :: Int -> DescribeAction -> ShowS
$cshowsPrec :: Int -> DescribeAction -> ShowS
Prelude.Show, forall x. Rep DescribeAction x -> DescribeAction
forall x. DescribeAction -> Rep DescribeAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAction x -> DescribeAction
$cfrom :: forall x. DescribeAction -> Rep DescribeAction x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAction' 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:
--
-- 'actionName', 'describeAction_actionName' - The name of the action to describe.
newDescribeAction ::
  -- | 'actionName'
  Prelude.Text ->
  DescribeAction
newDescribeAction :: Text -> DescribeAction
newDescribeAction Text
pActionName_ =
  DescribeAction' {$sel:actionName:DescribeAction' :: Text
actionName = Text
pActionName_}

-- | The name of the action to describe.
describeAction_actionName :: Lens.Lens' DescribeAction Prelude.Text
describeAction_actionName :: Lens' DescribeAction Text
describeAction_actionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAction' {Text
actionName :: Text
$sel:actionName:DescribeAction' :: DescribeAction -> Text
actionName} -> Text
actionName) (\s :: DescribeAction
s@DescribeAction' {} Text
a -> DescribeAction
s {$sel:actionName:DescribeAction' :: Text
actionName = Text
a} :: DescribeAction)

instance Core.AWSRequest DescribeAction where
  type
    AWSResponse DescribeAction =
      DescribeActionResponse
  request :: (Service -> Service) -> DescribeAction -> Request DescribeAction
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 DescribeAction
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeAction)))
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
-> Maybe Text
-> Maybe UserContext
-> Maybe POSIX
-> Maybe Text
-> Maybe UserContext
-> Maybe POSIX
-> Maybe Text
-> Maybe MetadataProperties
-> Maybe (HashMap Text Text)
-> Maybe ActionSource
-> Maybe ActionStatus
-> Int
-> DescribeActionResponse
DescribeActionResponse'
            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
"ActionArn")
            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
"ActionName")
            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
"ActionType")
            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
"CreatedBy")
            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
"CreationTime")
            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
"Description")
            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
"LastModifiedBy")
            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
"LastModifiedTime")
            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
"LineageGroupArn")
            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
"MetadataProperties")
            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
"Properties" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"Source")
            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
"Status")
            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 DescribeAction where
  hashWithSalt :: Int -> DescribeAction -> Int
hashWithSalt Int
_salt DescribeAction' {Text
actionName :: Text
$sel:actionName:DescribeAction' :: DescribeAction -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionName

instance Prelude.NFData DescribeAction where
  rnf :: DescribeAction -> ()
rnf DescribeAction' {Text
actionName :: Text
$sel:actionName:DescribeAction' :: DescribeAction -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
actionName

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

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

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

-- | /See:/ 'newDescribeActionResponse' smart constructor.
data DescribeActionResponse = DescribeActionResponse'
  { -- | The Amazon Resource Name (ARN) of the action.
    DescribeActionResponse -> Maybe Text
actionArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the action.
    DescribeActionResponse -> Maybe Text
actionName :: Prelude.Maybe Prelude.Text,
    -- | The type of the action.
    DescribeActionResponse -> Maybe Text
actionType :: Prelude.Maybe Prelude.Text,
    DescribeActionResponse -> Maybe UserContext
createdBy :: Prelude.Maybe UserContext,
    -- | When the action was created.
    DescribeActionResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The description of the action.
    DescribeActionResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    DescribeActionResponse -> Maybe UserContext
lastModifiedBy :: Prelude.Maybe UserContext,
    -- | When the action was last modified.
    DescribeActionResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Resource Name (ARN) of the lineage group.
    DescribeActionResponse -> Maybe Text
lineageGroupArn :: Prelude.Maybe Prelude.Text,
    DescribeActionResponse -> Maybe MetadataProperties
metadataProperties :: Prelude.Maybe MetadataProperties,
    -- | A list of the action\'s properties.
    DescribeActionResponse -> Maybe (HashMap Text Text)
properties :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The source of the action.
    DescribeActionResponse -> Maybe ActionSource
source :: Prelude.Maybe ActionSource,
    -- | The status of the action.
    DescribeActionResponse -> Maybe ActionStatus
status :: Prelude.Maybe ActionStatus,
    -- | The response's http status code.
    DescribeActionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeActionResponse -> DescribeActionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeActionResponse -> DescribeActionResponse -> Bool
$c/= :: DescribeActionResponse -> DescribeActionResponse -> Bool
== :: DescribeActionResponse -> DescribeActionResponse -> Bool
$c== :: DescribeActionResponse -> DescribeActionResponse -> Bool
Prelude.Eq, ReadPrec [DescribeActionResponse]
ReadPrec DescribeActionResponse
Int -> ReadS DescribeActionResponse
ReadS [DescribeActionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeActionResponse]
$creadListPrec :: ReadPrec [DescribeActionResponse]
readPrec :: ReadPrec DescribeActionResponse
$creadPrec :: ReadPrec DescribeActionResponse
readList :: ReadS [DescribeActionResponse]
$creadList :: ReadS [DescribeActionResponse]
readsPrec :: Int -> ReadS DescribeActionResponse
$creadsPrec :: Int -> ReadS DescribeActionResponse
Prelude.Read, Int -> DescribeActionResponse -> ShowS
[DescribeActionResponse] -> ShowS
DescribeActionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeActionResponse] -> ShowS
$cshowList :: [DescribeActionResponse] -> ShowS
show :: DescribeActionResponse -> String
$cshow :: DescribeActionResponse -> String
showsPrec :: Int -> DescribeActionResponse -> ShowS
$cshowsPrec :: Int -> DescribeActionResponse -> ShowS
Prelude.Show, forall x. Rep DescribeActionResponse x -> DescribeActionResponse
forall x. DescribeActionResponse -> Rep DescribeActionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeActionResponse x -> DescribeActionResponse
$cfrom :: forall x. DescribeActionResponse -> Rep DescribeActionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeActionResponse' 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:
--
-- 'actionArn', 'describeActionResponse_actionArn' - The Amazon Resource Name (ARN) of the action.
--
-- 'actionName', 'describeActionResponse_actionName' - The name of the action.
--
-- 'actionType', 'describeActionResponse_actionType' - The type of the action.
--
-- 'createdBy', 'describeActionResponse_createdBy' - Undocumented member.
--
-- 'creationTime', 'describeActionResponse_creationTime' - When the action was created.
--
-- 'description', 'describeActionResponse_description' - The description of the action.
--
-- 'lastModifiedBy', 'describeActionResponse_lastModifiedBy' - Undocumented member.
--
-- 'lastModifiedTime', 'describeActionResponse_lastModifiedTime' - When the action was last modified.
--
-- 'lineageGroupArn', 'describeActionResponse_lineageGroupArn' - The Amazon Resource Name (ARN) of the lineage group.
--
-- 'metadataProperties', 'describeActionResponse_metadataProperties' - Undocumented member.
--
-- 'properties', 'describeActionResponse_properties' - A list of the action\'s properties.
--
-- 'source', 'describeActionResponse_source' - The source of the action.
--
-- 'status', 'describeActionResponse_status' - The status of the action.
--
-- 'httpStatus', 'describeActionResponse_httpStatus' - The response's http status code.
newDescribeActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeActionResponse
newDescribeActionResponse :: Int -> DescribeActionResponse
newDescribeActionResponse Int
pHttpStatus_ =
  DescribeActionResponse'
    { $sel:actionArn:DescribeActionResponse' :: Maybe Text
actionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actionName:DescribeActionResponse' :: Maybe Text
actionName = forall a. Maybe a
Prelude.Nothing,
      $sel:actionType:DescribeActionResponse' :: Maybe Text
actionType = forall a. Maybe a
Prelude.Nothing,
      $sel:createdBy:DescribeActionResponse' :: Maybe UserContext
createdBy = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:DescribeActionResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeActionResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedBy:DescribeActionResponse' :: Maybe UserContext
lastModifiedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:DescribeActionResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lineageGroupArn:DescribeActionResponse' :: Maybe Text
lineageGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:metadataProperties:DescribeActionResponse' :: Maybe MetadataProperties
metadataProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:properties:DescribeActionResponse' :: Maybe (HashMap Text Text)
properties = forall a. Maybe a
Prelude.Nothing,
      $sel:source:DescribeActionResponse' :: Maybe ActionSource
source = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeActionResponse' :: Maybe ActionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeActionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the action.
describeActionResponse_actionArn :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.Text)
describeActionResponse_actionArn :: Lens' DescribeActionResponse (Maybe Text)
describeActionResponse_actionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe Text
actionArn :: Maybe Text
$sel:actionArn:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
actionArn} -> Maybe Text
actionArn) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe Text
a -> DescribeActionResponse
s {$sel:actionArn:DescribeActionResponse' :: Maybe Text
actionArn = Maybe Text
a} :: DescribeActionResponse)

-- | The name of the action.
describeActionResponse_actionName :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.Text)
describeActionResponse_actionName :: Lens' DescribeActionResponse (Maybe Text)
describeActionResponse_actionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe Text
actionName :: Maybe Text
$sel:actionName:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
actionName} -> Maybe Text
actionName) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe Text
a -> DescribeActionResponse
s {$sel:actionName:DescribeActionResponse' :: Maybe Text
actionName = Maybe Text
a} :: DescribeActionResponse)

-- | The type of the action.
describeActionResponse_actionType :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.Text)
describeActionResponse_actionType :: Lens' DescribeActionResponse (Maybe Text)
describeActionResponse_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe Text
actionType :: Maybe Text
$sel:actionType:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
actionType} -> Maybe Text
actionType) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe Text
a -> DescribeActionResponse
s {$sel:actionType:DescribeActionResponse' :: Maybe Text
actionType = Maybe Text
a} :: DescribeActionResponse)

-- | Undocumented member.
describeActionResponse_createdBy :: Lens.Lens' DescribeActionResponse (Prelude.Maybe UserContext)
describeActionResponse_createdBy :: Lens' DescribeActionResponse (Maybe UserContext)
describeActionResponse_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe UserContext
createdBy :: Maybe UserContext
$sel:createdBy:DescribeActionResponse' :: DescribeActionResponse -> Maybe UserContext
createdBy} -> Maybe UserContext
createdBy) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe UserContext
a -> DescribeActionResponse
s {$sel:createdBy:DescribeActionResponse' :: Maybe UserContext
createdBy = Maybe UserContext
a} :: DescribeActionResponse)

-- | When the action was created.
describeActionResponse_creationTime :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.UTCTime)
describeActionResponse_creationTime :: Lens' DescribeActionResponse (Maybe UTCTime)
describeActionResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribeActionResponse' :: DescribeActionResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe POSIX
a -> DescribeActionResponse
s {$sel:creationTime:DescribeActionResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribeActionResponse) 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 description of the action.
describeActionResponse_description :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.Text)
describeActionResponse_description :: Lens' DescribeActionResponse (Maybe Text)
describeActionResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe Text
a -> DescribeActionResponse
s {$sel:description:DescribeActionResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeActionResponse)

-- | Undocumented member.
describeActionResponse_lastModifiedBy :: Lens.Lens' DescribeActionResponse (Prelude.Maybe UserContext)
describeActionResponse_lastModifiedBy :: Lens' DescribeActionResponse (Maybe UserContext)
describeActionResponse_lastModifiedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe UserContext
lastModifiedBy :: Maybe UserContext
$sel:lastModifiedBy:DescribeActionResponse' :: DescribeActionResponse -> Maybe UserContext
lastModifiedBy} -> Maybe UserContext
lastModifiedBy) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe UserContext
a -> DescribeActionResponse
s {$sel:lastModifiedBy:DescribeActionResponse' :: Maybe UserContext
lastModifiedBy = Maybe UserContext
a} :: DescribeActionResponse)

-- | When the action was last modified.
describeActionResponse_lastModifiedTime :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.UTCTime)
describeActionResponse_lastModifiedTime :: Lens' DescribeActionResponse (Maybe UTCTime)
describeActionResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:DescribeActionResponse' :: DescribeActionResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe POSIX
a -> DescribeActionResponse
s {$sel:lastModifiedTime:DescribeActionResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: DescribeActionResponse) 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 Amazon Resource Name (ARN) of the lineage group.
describeActionResponse_lineageGroupArn :: Lens.Lens' DescribeActionResponse (Prelude.Maybe Prelude.Text)
describeActionResponse_lineageGroupArn :: Lens' DescribeActionResponse (Maybe Text)
describeActionResponse_lineageGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe Text
lineageGroupArn :: Maybe Text
$sel:lineageGroupArn:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
lineageGroupArn} -> Maybe Text
lineageGroupArn) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe Text
a -> DescribeActionResponse
s {$sel:lineageGroupArn:DescribeActionResponse' :: Maybe Text
lineageGroupArn = Maybe Text
a} :: DescribeActionResponse)

-- | Undocumented member.
describeActionResponse_metadataProperties :: Lens.Lens' DescribeActionResponse (Prelude.Maybe MetadataProperties)
describeActionResponse_metadataProperties :: Lens' DescribeActionResponse (Maybe MetadataProperties)
describeActionResponse_metadataProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe MetadataProperties
metadataProperties :: Maybe MetadataProperties
$sel:metadataProperties:DescribeActionResponse' :: DescribeActionResponse -> Maybe MetadataProperties
metadataProperties} -> Maybe MetadataProperties
metadataProperties) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe MetadataProperties
a -> DescribeActionResponse
s {$sel:metadataProperties:DescribeActionResponse' :: Maybe MetadataProperties
metadataProperties = Maybe MetadataProperties
a} :: DescribeActionResponse)

-- | A list of the action\'s properties.
describeActionResponse_properties :: Lens.Lens' DescribeActionResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeActionResponse_properties :: Lens' DescribeActionResponse (Maybe (HashMap Text Text))
describeActionResponse_properties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe (HashMap Text Text)
properties :: Maybe (HashMap Text Text)
$sel:properties:DescribeActionResponse' :: DescribeActionResponse -> Maybe (HashMap Text Text)
properties} -> Maybe (HashMap Text Text)
properties) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe (HashMap Text Text)
a -> DescribeActionResponse
s {$sel:properties:DescribeActionResponse' :: Maybe (HashMap Text Text)
properties = Maybe (HashMap Text Text)
a} :: DescribeActionResponse) 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 source of the action.
describeActionResponse_source :: Lens.Lens' DescribeActionResponse (Prelude.Maybe ActionSource)
describeActionResponse_source :: Lens' DescribeActionResponse (Maybe ActionSource)
describeActionResponse_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe ActionSource
source :: Maybe ActionSource
$sel:source:DescribeActionResponse' :: DescribeActionResponse -> Maybe ActionSource
source} -> Maybe ActionSource
source) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe ActionSource
a -> DescribeActionResponse
s {$sel:source:DescribeActionResponse' :: Maybe ActionSource
source = Maybe ActionSource
a} :: DescribeActionResponse)

-- | The status of the action.
describeActionResponse_status :: Lens.Lens' DescribeActionResponse (Prelude.Maybe ActionStatus)
describeActionResponse_status :: Lens' DescribeActionResponse (Maybe ActionStatus)
describeActionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeActionResponse' {Maybe ActionStatus
status :: Maybe ActionStatus
$sel:status:DescribeActionResponse' :: DescribeActionResponse -> Maybe ActionStatus
status} -> Maybe ActionStatus
status) (\s :: DescribeActionResponse
s@DescribeActionResponse' {} Maybe ActionStatus
a -> DescribeActionResponse
s {$sel:status:DescribeActionResponse' :: Maybe ActionStatus
status = Maybe ActionStatus
a} :: DescribeActionResponse)

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

instance Prelude.NFData DescribeActionResponse where
  rnf :: DescribeActionResponse -> ()
rnf DescribeActionResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe ActionSource
Maybe ActionStatus
Maybe MetadataProperties
Maybe UserContext
httpStatus :: Int
status :: Maybe ActionStatus
source :: Maybe ActionSource
properties :: Maybe (HashMap Text Text)
metadataProperties :: Maybe MetadataProperties
lineageGroupArn :: Maybe Text
lastModifiedTime :: Maybe POSIX
lastModifiedBy :: Maybe UserContext
description :: Maybe Text
creationTime :: Maybe POSIX
createdBy :: Maybe UserContext
actionType :: Maybe Text
actionName :: Maybe Text
actionArn :: Maybe Text
$sel:httpStatus:DescribeActionResponse' :: DescribeActionResponse -> Int
$sel:status:DescribeActionResponse' :: DescribeActionResponse -> Maybe ActionStatus
$sel:source:DescribeActionResponse' :: DescribeActionResponse -> Maybe ActionSource
$sel:properties:DescribeActionResponse' :: DescribeActionResponse -> Maybe (HashMap Text Text)
$sel:metadataProperties:DescribeActionResponse' :: DescribeActionResponse -> Maybe MetadataProperties
$sel:lineageGroupArn:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
$sel:lastModifiedTime:DescribeActionResponse' :: DescribeActionResponse -> Maybe POSIX
$sel:lastModifiedBy:DescribeActionResponse' :: DescribeActionResponse -> Maybe UserContext
$sel:description:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
$sel:creationTime:DescribeActionResponse' :: DescribeActionResponse -> Maybe POSIX
$sel:createdBy:DescribeActionResponse' :: DescribeActionResponse -> Maybe UserContext
$sel:actionType:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
$sel:actionName:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
$sel:actionArn:DescribeActionResponse' :: DescribeActionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserContext
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserContext
lastModifiedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lineageGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetadataProperties
metadataProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
properties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ActionSource
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ActionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus