{-# 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.Transfer.DescribeWorkflow
-- 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 the specified workflow.
module Amazonka.Transfer.DescribeWorkflow
  ( -- * Creating a Request
    DescribeWorkflow (..),
    newDescribeWorkflow,

    -- * Request Lenses
    describeWorkflow_workflowId,

    -- * Destructuring the Response
    DescribeWorkflowResponse (..),
    newDescribeWorkflowResponse,

    -- * Response Lenses
    describeWorkflowResponse_httpStatus,
    describeWorkflowResponse_workflow,
  )
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.Transfer.Types

-- | /See:/ 'newDescribeWorkflow' smart constructor.
data DescribeWorkflow = DescribeWorkflow'
  { -- | A unique identifier for the workflow.
    DescribeWorkflow -> Text
workflowId :: Prelude.Text
  }
  deriving (DescribeWorkflow -> DescribeWorkflow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorkflow -> DescribeWorkflow -> Bool
$c/= :: DescribeWorkflow -> DescribeWorkflow -> Bool
== :: DescribeWorkflow -> DescribeWorkflow -> Bool
$c== :: DescribeWorkflow -> DescribeWorkflow -> Bool
Prelude.Eq, ReadPrec [DescribeWorkflow]
ReadPrec DescribeWorkflow
Int -> ReadS DescribeWorkflow
ReadS [DescribeWorkflow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorkflow]
$creadListPrec :: ReadPrec [DescribeWorkflow]
readPrec :: ReadPrec DescribeWorkflow
$creadPrec :: ReadPrec DescribeWorkflow
readList :: ReadS [DescribeWorkflow]
$creadList :: ReadS [DescribeWorkflow]
readsPrec :: Int -> ReadS DescribeWorkflow
$creadsPrec :: Int -> ReadS DescribeWorkflow
Prelude.Read, Int -> DescribeWorkflow -> ShowS
[DescribeWorkflow] -> ShowS
DescribeWorkflow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorkflow] -> ShowS
$cshowList :: [DescribeWorkflow] -> ShowS
show :: DescribeWorkflow -> String
$cshow :: DescribeWorkflow -> String
showsPrec :: Int -> DescribeWorkflow -> ShowS
$cshowsPrec :: Int -> DescribeWorkflow -> ShowS
Prelude.Show, forall x. Rep DescribeWorkflow x -> DescribeWorkflow
forall x. DescribeWorkflow -> Rep DescribeWorkflow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeWorkflow x -> DescribeWorkflow
$cfrom :: forall x. DescribeWorkflow -> Rep DescribeWorkflow x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorkflow' 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:
--
-- 'workflowId', 'describeWorkflow_workflowId' - A unique identifier for the workflow.
newDescribeWorkflow ::
  -- | 'workflowId'
  Prelude.Text ->
  DescribeWorkflow
newDescribeWorkflow :: Text -> DescribeWorkflow
newDescribeWorkflow Text
pWorkflowId_ =
  DescribeWorkflow' {$sel:workflowId:DescribeWorkflow' :: Text
workflowId = Text
pWorkflowId_}

-- | A unique identifier for the workflow.
describeWorkflow_workflowId :: Lens.Lens' DescribeWorkflow Prelude.Text
describeWorkflow_workflowId :: Lens' DescribeWorkflow Text
describeWorkflow_workflowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkflow' {Text
workflowId :: Text
$sel:workflowId:DescribeWorkflow' :: DescribeWorkflow -> Text
workflowId} -> Text
workflowId) (\s :: DescribeWorkflow
s@DescribeWorkflow' {} Text
a -> DescribeWorkflow
s {$sel:workflowId:DescribeWorkflow' :: Text
workflowId = Text
a} :: DescribeWorkflow)

instance Core.AWSRequest DescribeWorkflow where
  type
    AWSResponse DescribeWorkflow =
      DescribeWorkflowResponse
  request :: (Service -> Service)
-> DescribeWorkflow -> Request DescribeWorkflow
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 DescribeWorkflow
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeWorkflow)))
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 ->
          Int -> DescribedWorkflow -> DescribeWorkflowResponse
DescribeWorkflowResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Workflow")
      )

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

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

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

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

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

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

-- |
-- Create a value of 'DescribeWorkflowResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'describeWorkflowResponse_httpStatus' - The response's http status code.
--
-- 'workflow', 'describeWorkflowResponse_workflow' - The structure that contains the details of the workflow.
newDescribeWorkflowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workflow'
  DescribedWorkflow ->
  DescribeWorkflowResponse
newDescribeWorkflowResponse :: Int -> DescribedWorkflow -> DescribeWorkflowResponse
newDescribeWorkflowResponse Int
pHttpStatus_ DescribedWorkflow
pWorkflow_ =
  DescribeWorkflowResponse'
    { $sel:httpStatus:DescribeWorkflowResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:workflow:DescribeWorkflowResponse' :: DescribedWorkflow
workflow = DescribedWorkflow
pWorkflow_
    }

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

-- | The structure that contains the details of the workflow.
describeWorkflowResponse_workflow :: Lens.Lens' DescribeWorkflowResponse DescribedWorkflow
describeWorkflowResponse_workflow :: Lens' DescribeWorkflowResponse DescribedWorkflow
describeWorkflowResponse_workflow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkflowResponse' {DescribedWorkflow
workflow :: DescribedWorkflow
$sel:workflow:DescribeWorkflowResponse' :: DescribeWorkflowResponse -> DescribedWorkflow
workflow} -> DescribedWorkflow
workflow) (\s :: DescribeWorkflowResponse
s@DescribeWorkflowResponse' {} DescribedWorkflow
a -> DescribeWorkflowResponse
s {$sel:workflow:DescribeWorkflowResponse' :: DescribedWorkflow
workflow = DescribedWorkflow
a} :: DescribeWorkflowResponse)

instance Prelude.NFData DescribeWorkflowResponse where
  rnf :: DescribeWorkflowResponse -> ()
rnf DescribeWorkflowResponse' {Int
DescribedWorkflow
workflow :: DescribedWorkflow
httpStatus :: Int
$sel:workflow:DescribeWorkflowResponse' :: DescribeWorkflowResponse -> DescribedWorkflow
$sel:httpStatus:DescribeWorkflowResponse' :: DescribeWorkflowResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DescribedWorkflow
workflow