{-# 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.Glue.GetWorkflowRunProperties
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the workflow run properties which were set during the run.
module Amazonka.Glue.GetWorkflowRunProperties
  ( -- * Creating a Request
    GetWorkflowRunProperties (..),
    newGetWorkflowRunProperties,

    -- * Request Lenses
    getWorkflowRunProperties_name,
    getWorkflowRunProperties_runId,

    -- * Destructuring the Response
    GetWorkflowRunPropertiesResponse (..),
    newGetWorkflowRunPropertiesResponse,

    -- * Response Lenses
    getWorkflowRunPropertiesResponse_runProperties,
    getWorkflowRunPropertiesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetWorkflowRunProperties' smart constructor.
data GetWorkflowRunProperties = GetWorkflowRunProperties'
  { -- | Name of the workflow which was run.
    GetWorkflowRunProperties -> Text
name :: Prelude.Text,
    -- | The ID of the workflow run whose run properties should be returned.
    GetWorkflowRunProperties -> Text
runId :: Prelude.Text
  }
  deriving (GetWorkflowRunProperties -> GetWorkflowRunProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflowRunProperties -> GetWorkflowRunProperties -> Bool
$c/= :: GetWorkflowRunProperties -> GetWorkflowRunProperties -> Bool
== :: GetWorkflowRunProperties -> GetWorkflowRunProperties -> Bool
$c== :: GetWorkflowRunProperties -> GetWorkflowRunProperties -> Bool
Prelude.Eq, ReadPrec [GetWorkflowRunProperties]
ReadPrec GetWorkflowRunProperties
Int -> ReadS GetWorkflowRunProperties
ReadS [GetWorkflowRunProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflowRunProperties]
$creadListPrec :: ReadPrec [GetWorkflowRunProperties]
readPrec :: ReadPrec GetWorkflowRunProperties
$creadPrec :: ReadPrec GetWorkflowRunProperties
readList :: ReadS [GetWorkflowRunProperties]
$creadList :: ReadS [GetWorkflowRunProperties]
readsPrec :: Int -> ReadS GetWorkflowRunProperties
$creadsPrec :: Int -> ReadS GetWorkflowRunProperties
Prelude.Read, Int -> GetWorkflowRunProperties -> ShowS
[GetWorkflowRunProperties] -> ShowS
GetWorkflowRunProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflowRunProperties] -> ShowS
$cshowList :: [GetWorkflowRunProperties] -> ShowS
show :: GetWorkflowRunProperties -> String
$cshow :: GetWorkflowRunProperties -> String
showsPrec :: Int -> GetWorkflowRunProperties -> ShowS
$cshowsPrec :: Int -> GetWorkflowRunProperties -> ShowS
Prelude.Show, forall x.
Rep GetWorkflowRunProperties x -> GetWorkflowRunProperties
forall x.
GetWorkflowRunProperties -> Rep GetWorkflowRunProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetWorkflowRunProperties x -> GetWorkflowRunProperties
$cfrom :: forall x.
GetWorkflowRunProperties -> Rep GetWorkflowRunProperties x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflowRunProperties' 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:
--
-- 'name', 'getWorkflowRunProperties_name' - Name of the workflow which was run.
--
-- 'runId', 'getWorkflowRunProperties_runId' - The ID of the workflow run whose run properties should be returned.
newGetWorkflowRunProperties ::
  -- | 'name'
  Prelude.Text ->
  -- | 'runId'
  Prelude.Text ->
  GetWorkflowRunProperties
newGetWorkflowRunProperties :: Text -> Text -> GetWorkflowRunProperties
newGetWorkflowRunProperties Text
pName_ Text
pRunId_ =
  GetWorkflowRunProperties'
    { $sel:name:GetWorkflowRunProperties' :: Text
name = Text
pName_,
      $sel:runId:GetWorkflowRunProperties' :: Text
runId = Text
pRunId_
    }

-- | Name of the workflow which was run.
getWorkflowRunProperties_name :: Lens.Lens' GetWorkflowRunProperties Prelude.Text
getWorkflowRunProperties_name :: Lens' GetWorkflowRunProperties Text
getWorkflowRunProperties_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowRunProperties' {Text
name :: Text
$sel:name:GetWorkflowRunProperties' :: GetWorkflowRunProperties -> Text
name} -> Text
name) (\s :: GetWorkflowRunProperties
s@GetWorkflowRunProperties' {} Text
a -> GetWorkflowRunProperties
s {$sel:name:GetWorkflowRunProperties' :: Text
name = Text
a} :: GetWorkflowRunProperties)

-- | The ID of the workflow run whose run properties should be returned.
getWorkflowRunProperties_runId :: Lens.Lens' GetWorkflowRunProperties Prelude.Text
getWorkflowRunProperties_runId :: Lens' GetWorkflowRunProperties Text
getWorkflowRunProperties_runId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowRunProperties' {Text
runId :: Text
$sel:runId:GetWorkflowRunProperties' :: GetWorkflowRunProperties -> Text
runId} -> Text
runId) (\s :: GetWorkflowRunProperties
s@GetWorkflowRunProperties' {} Text
a -> GetWorkflowRunProperties
s {$sel:runId:GetWorkflowRunProperties' :: Text
runId = Text
a} :: GetWorkflowRunProperties)

instance Core.AWSRequest GetWorkflowRunProperties where
  type
    AWSResponse GetWorkflowRunProperties =
      GetWorkflowRunPropertiesResponse
  request :: (Service -> Service)
-> GetWorkflowRunProperties -> Request GetWorkflowRunProperties
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 GetWorkflowRunProperties
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetWorkflowRunProperties)))
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 (HashMap Text Text)
-> Int -> GetWorkflowRunPropertiesResponse
GetWorkflowRunPropertiesResponse'
            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
"RunProperties" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetWorkflowRunProperties where
  hashWithSalt :: Int -> GetWorkflowRunProperties -> Int
hashWithSalt Int
_salt GetWorkflowRunProperties' {Text
runId :: Text
name :: Text
$sel:runId:GetWorkflowRunProperties' :: GetWorkflowRunProperties -> Text
$sel:name:GetWorkflowRunProperties' :: GetWorkflowRunProperties -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
runId

instance Prelude.NFData GetWorkflowRunProperties where
  rnf :: GetWorkflowRunProperties -> ()
rnf GetWorkflowRunProperties' {Text
runId :: Text
name :: Text
$sel:runId:GetWorkflowRunProperties' :: GetWorkflowRunProperties -> Text
$sel:name:GetWorkflowRunProperties' :: GetWorkflowRunProperties -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
runId

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

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

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

-- | /See:/ 'newGetWorkflowRunPropertiesResponse' smart constructor.
data GetWorkflowRunPropertiesResponse = GetWorkflowRunPropertiesResponse'
  { -- | The workflow run properties which were set during the specified run.
    GetWorkflowRunPropertiesResponse -> Maybe (HashMap Text Text)
runProperties :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetWorkflowRunPropertiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWorkflowRunPropertiesResponse
-> GetWorkflowRunPropertiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWorkflowRunPropertiesResponse
-> GetWorkflowRunPropertiesResponse -> Bool
$c/= :: GetWorkflowRunPropertiesResponse
-> GetWorkflowRunPropertiesResponse -> Bool
== :: GetWorkflowRunPropertiesResponse
-> GetWorkflowRunPropertiesResponse -> Bool
$c== :: GetWorkflowRunPropertiesResponse
-> GetWorkflowRunPropertiesResponse -> Bool
Prelude.Eq, ReadPrec [GetWorkflowRunPropertiesResponse]
ReadPrec GetWorkflowRunPropertiesResponse
Int -> ReadS GetWorkflowRunPropertiesResponse
ReadS [GetWorkflowRunPropertiesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWorkflowRunPropertiesResponse]
$creadListPrec :: ReadPrec [GetWorkflowRunPropertiesResponse]
readPrec :: ReadPrec GetWorkflowRunPropertiesResponse
$creadPrec :: ReadPrec GetWorkflowRunPropertiesResponse
readList :: ReadS [GetWorkflowRunPropertiesResponse]
$creadList :: ReadS [GetWorkflowRunPropertiesResponse]
readsPrec :: Int -> ReadS GetWorkflowRunPropertiesResponse
$creadsPrec :: Int -> ReadS GetWorkflowRunPropertiesResponse
Prelude.Read, Int -> GetWorkflowRunPropertiesResponse -> ShowS
[GetWorkflowRunPropertiesResponse] -> ShowS
GetWorkflowRunPropertiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWorkflowRunPropertiesResponse] -> ShowS
$cshowList :: [GetWorkflowRunPropertiesResponse] -> ShowS
show :: GetWorkflowRunPropertiesResponse -> String
$cshow :: GetWorkflowRunPropertiesResponse -> String
showsPrec :: Int -> GetWorkflowRunPropertiesResponse -> ShowS
$cshowsPrec :: Int -> GetWorkflowRunPropertiesResponse -> ShowS
Prelude.Show, forall x.
Rep GetWorkflowRunPropertiesResponse x
-> GetWorkflowRunPropertiesResponse
forall x.
GetWorkflowRunPropertiesResponse
-> Rep GetWorkflowRunPropertiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetWorkflowRunPropertiesResponse x
-> GetWorkflowRunPropertiesResponse
$cfrom :: forall x.
GetWorkflowRunPropertiesResponse
-> Rep GetWorkflowRunPropertiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWorkflowRunPropertiesResponse' 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:
--
-- 'runProperties', 'getWorkflowRunPropertiesResponse_runProperties' - The workflow run properties which were set during the specified run.
--
-- 'httpStatus', 'getWorkflowRunPropertiesResponse_httpStatus' - The response's http status code.
newGetWorkflowRunPropertiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWorkflowRunPropertiesResponse
newGetWorkflowRunPropertiesResponse :: Int -> GetWorkflowRunPropertiesResponse
newGetWorkflowRunPropertiesResponse Int
pHttpStatus_ =
  GetWorkflowRunPropertiesResponse'
    { $sel:runProperties:GetWorkflowRunPropertiesResponse' :: Maybe (HashMap Text Text)
runProperties =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWorkflowRunPropertiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The workflow run properties which were set during the specified run.
getWorkflowRunPropertiesResponse_runProperties :: Lens.Lens' GetWorkflowRunPropertiesResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getWorkflowRunPropertiesResponse_runProperties :: Lens' GetWorkflowRunPropertiesResponse (Maybe (HashMap Text Text))
getWorkflowRunPropertiesResponse_runProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowRunPropertiesResponse' {Maybe (HashMap Text Text)
runProperties :: Maybe (HashMap Text Text)
$sel:runProperties:GetWorkflowRunPropertiesResponse' :: GetWorkflowRunPropertiesResponse -> Maybe (HashMap Text Text)
runProperties} -> Maybe (HashMap Text Text)
runProperties) (\s :: GetWorkflowRunPropertiesResponse
s@GetWorkflowRunPropertiesResponse' {} Maybe (HashMap Text Text)
a -> GetWorkflowRunPropertiesResponse
s {$sel:runProperties:GetWorkflowRunPropertiesResponse' :: Maybe (HashMap Text Text)
runProperties = Maybe (HashMap Text Text)
a} :: GetWorkflowRunPropertiesResponse) 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 response's http status code.
getWorkflowRunPropertiesResponse_httpStatus :: Lens.Lens' GetWorkflowRunPropertiesResponse Prelude.Int
getWorkflowRunPropertiesResponse_httpStatus :: Lens' GetWorkflowRunPropertiesResponse Int
getWorkflowRunPropertiesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWorkflowRunPropertiesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetWorkflowRunPropertiesResponse' :: GetWorkflowRunPropertiesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetWorkflowRunPropertiesResponse
s@GetWorkflowRunPropertiesResponse' {} Int
a -> GetWorkflowRunPropertiesResponse
s {$sel:httpStatus:GetWorkflowRunPropertiesResponse' :: Int
httpStatus = Int
a} :: GetWorkflowRunPropertiesResponse)

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