{-# 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.CodePipeline.PutApprovalResult
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides the response to a manual approval request to AWS CodePipeline.
-- Valid responses include Approved and Rejected.
module Amazonka.CodePipeline.PutApprovalResult
  ( -- * Creating a Request
    PutApprovalResult (..),
    newPutApprovalResult,

    -- * Request Lenses
    putApprovalResult_pipelineName,
    putApprovalResult_stageName,
    putApprovalResult_actionName,
    putApprovalResult_result,
    putApprovalResult_token,

    -- * Destructuring the Response
    PutApprovalResultResponse (..),
    newPutApprovalResultResponse,

    -- * Response Lenses
    putApprovalResultResponse_approvedAt,
    putApprovalResultResponse_httpStatus,
  )
where

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

-- | Represents the input of a @PutApprovalResult@ action.
--
-- /See:/ 'newPutApprovalResult' smart constructor.
data PutApprovalResult = PutApprovalResult'
  { -- | The name of the pipeline that contains the action.
    PutApprovalResult -> Text
pipelineName :: Prelude.Text,
    -- | The name of the stage that contains the action.
    PutApprovalResult -> Text
stageName :: Prelude.Text,
    -- | The name of the action for which approval is requested.
    PutApprovalResult -> Text
actionName :: Prelude.Text,
    -- | Represents information about the result of the approval request.
    PutApprovalResult -> ApprovalResult
result :: ApprovalResult,
    -- | The system-generated token used to identify a unique approval request.
    -- The token for each open approval request can be obtained using the
    -- GetPipelineState action. It is used to validate that the approval
    -- request corresponding to this token is still valid.
    PutApprovalResult -> Text
token :: Prelude.Text
  }
  deriving (PutApprovalResult -> PutApprovalResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutApprovalResult -> PutApprovalResult -> Bool
$c/= :: PutApprovalResult -> PutApprovalResult -> Bool
== :: PutApprovalResult -> PutApprovalResult -> Bool
$c== :: PutApprovalResult -> PutApprovalResult -> Bool
Prelude.Eq, ReadPrec [PutApprovalResult]
ReadPrec PutApprovalResult
Int -> ReadS PutApprovalResult
ReadS [PutApprovalResult]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutApprovalResult]
$creadListPrec :: ReadPrec [PutApprovalResult]
readPrec :: ReadPrec PutApprovalResult
$creadPrec :: ReadPrec PutApprovalResult
readList :: ReadS [PutApprovalResult]
$creadList :: ReadS [PutApprovalResult]
readsPrec :: Int -> ReadS PutApprovalResult
$creadsPrec :: Int -> ReadS PutApprovalResult
Prelude.Read, Int -> PutApprovalResult -> ShowS
[PutApprovalResult] -> ShowS
PutApprovalResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutApprovalResult] -> ShowS
$cshowList :: [PutApprovalResult] -> ShowS
show :: PutApprovalResult -> String
$cshow :: PutApprovalResult -> String
showsPrec :: Int -> PutApprovalResult -> ShowS
$cshowsPrec :: Int -> PutApprovalResult -> ShowS
Prelude.Show, forall x. Rep PutApprovalResult x -> PutApprovalResult
forall x. PutApprovalResult -> Rep PutApprovalResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutApprovalResult x -> PutApprovalResult
$cfrom :: forall x. PutApprovalResult -> Rep PutApprovalResult x
Prelude.Generic)

-- |
-- Create a value of 'PutApprovalResult' 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:
--
-- 'pipelineName', 'putApprovalResult_pipelineName' - The name of the pipeline that contains the action.
--
-- 'stageName', 'putApprovalResult_stageName' - The name of the stage that contains the action.
--
-- 'actionName', 'putApprovalResult_actionName' - The name of the action for which approval is requested.
--
-- 'result', 'putApprovalResult_result' - Represents information about the result of the approval request.
--
-- 'token', 'putApprovalResult_token' - The system-generated token used to identify a unique approval request.
-- The token for each open approval request can be obtained using the
-- GetPipelineState action. It is used to validate that the approval
-- request corresponding to this token is still valid.
newPutApprovalResult ::
  -- | 'pipelineName'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  -- | 'actionName'
  Prelude.Text ->
  -- | 'result'
  ApprovalResult ->
  -- | 'token'
  Prelude.Text ->
  PutApprovalResult
newPutApprovalResult :: Text -> Text -> Text -> ApprovalResult -> Text -> PutApprovalResult
newPutApprovalResult
  Text
pPipelineName_
  Text
pStageName_
  Text
pActionName_
  ApprovalResult
pResult_
  Text
pToken_ =
    PutApprovalResult'
      { $sel:pipelineName:PutApprovalResult' :: Text
pipelineName = Text
pPipelineName_,
        $sel:stageName:PutApprovalResult' :: Text
stageName = Text
pStageName_,
        $sel:actionName:PutApprovalResult' :: Text
actionName = Text
pActionName_,
        $sel:result:PutApprovalResult' :: ApprovalResult
result = ApprovalResult
pResult_,
        $sel:token:PutApprovalResult' :: Text
token = Text
pToken_
      }

-- | The name of the pipeline that contains the action.
putApprovalResult_pipelineName :: Lens.Lens' PutApprovalResult Prelude.Text
putApprovalResult_pipelineName :: Lens' PutApprovalResult Text
putApprovalResult_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResult' {Text
pipelineName :: Text
$sel:pipelineName:PutApprovalResult' :: PutApprovalResult -> Text
pipelineName} -> Text
pipelineName) (\s :: PutApprovalResult
s@PutApprovalResult' {} Text
a -> PutApprovalResult
s {$sel:pipelineName:PutApprovalResult' :: Text
pipelineName = Text
a} :: PutApprovalResult)

-- | The name of the stage that contains the action.
putApprovalResult_stageName :: Lens.Lens' PutApprovalResult Prelude.Text
putApprovalResult_stageName :: Lens' PutApprovalResult Text
putApprovalResult_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResult' {Text
stageName :: Text
$sel:stageName:PutApprovalResult' :: PutApprovalResult -> Text
stageName} -> Text
stageName) (\s :: PutApprovalResult
s@PutApprovalResult' {} Text
a -> PutApprovalResult
s {$sel:stageName:PutApprovalResult' :: Text
stageName = Text
a} :: PutApprovalResult)

-- | The name of the action for which approval is requested.
putApprovalResult_actionName :: Lens.Lens' PutApprovalResult Prelude.Text
putApprovalResult_actionName :: Lens' PutApprovalResult Text
putApprovalResult_actionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResult' {Text
actionName :: Text
$sel:actionName:PutApprovalResult' :: PutApprovalResult -> Text
actionName} -> Text
actionName) (\s :: PutApprovalResult
s@PutApprovalResult' {} Text
a -> PutApprovalResult
s {$sel:actionName:PutApprovalResult' :: Text
actionName = Text
a} :: PutApprovalResult)

-- | Represents information about the result of the approval request.
putApprovalResult_result :: Lens.Lens' PutApprovalResult ApprovalResult
putApprovalResult_result :: Lens' PutApprovalResult ApprovalResult
putApprovalResult_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResult' {ApprovalResult
result :: ApprovalResult
$sel:result:PutApprovalResult' :: PutApprovalResult -> ApprovalResult
result} -> ApprovalResult
result) (\s :: PutApprovalResult
s@PutApprovalResult' {} ApprovalResult
a -> PutApprovalResult
s {$sel:result:PutApprovalResult' :: ApprovalResult
result = ApprovalResult
a} :: PutApprovalResult)

-- | The system-generated token used to identify a unique approval request.
-- The token for each open approval request can be obtained using the
-- GetPipelineState action. It is used to validate that the approval
-- request corresponding to this token is still valid.
putApprovalResult_token :: Lens.Lens' PutApprovalResult Prelude.Text
putApprovalResult_token :: Lens' PutApprovalResult Text
putApprovalResult_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResult' {Text
token :: Text
$sel:token:PutApprovalResult' :: PutApprovalResult -> Text
token} -> Text
token) (\s :: PutApprovalResult
s@PutApprovalResult' {} Text
a -> PutApprovalResult
s {$sel:token:PutApprovalResult' :: Text
token = Text
a} :: PutApprovalResult)

instance Core.AWSRequest PutApprovalResult where
  type
    AWSResponse PutApprovalResult =
      PutApprovalResultResponse
  request :: (Service -> Service)
-> PutApprovalResult -> Request PutApprovalResult
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 PutApprovalResult
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutApprovalResult)))
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 POSIX -> Int -> PutApprovalResultResponse
PutApprovalResultResponse'
            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
"approvedAt")
            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 PutApprovalResult where
  hashWithSalt :: Int -> PutApprovalResult -> Int
hashWithSalt Int
_salt PutApprovalResult' {Text
ApprovalResult
token :: Text
result :: ApprovalResult
actionName :: Text
stageName :: Text
pipelineName :: Text
$sel:token:PutApprovalResult' :: PutApprovalResult -> Text
$sel:result:PutApprovalResult' :: PutApprovalResult -> ApprovalResult
$sel:actionName:PutApprovalResult' :: PutApprovalResult -> Text
$sel:stageName:PutApprovalResult' :: PutApprovalResult -> Text
$sel:pipelineName:PutApprovalResult' :: PutApprovalResult -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
actionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ApprovalResult
result
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
token

instance Prelude.NFData PutApprovalResult where
  rnf :: PutApprovalResult -> ()
rnf PutApprovalResult' {Text
ApprovalResult
token :: Text
result :: ApprovalResult
actionName :: Text
stageName :: Text
pipelineName :: Text
$sel:token:PutApprovalResult' :: PutApprovalResult -> Text
$sel:result:PutApprovalResult' :: PutApprovalResult -> ApprovalResult
$sel:actionName:PutApprovalResult' :: PutApprovalResult -> Text
$sel:stageName:PutApprovalResult' :: PutApprovalResult -> Text
$sel:pipelineName:PutApprovalResult' :: PutApprovalResult -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
actionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ApprovalResult
result
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
token

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

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

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

-- | Represents the output of a @PutApprovalResult@ action.
--
-- /See:/ 'newPutApprovalResultResponse' smart constructor.
data PutApprovalResultResponse = PutApprovalResultResponse'
  { -- | The timestamp showing when the approval or rejection was submitted.
    PutApprovalResultResponse -> Maybe POSIX
approvedAt :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    PutApprovalResultResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutApprovalResultResponse -> PutApprovalResultResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutApprovalResultResponse -> PutApprovalResultResponse -> Bool
$c/= :: PutApprovalResultResponse -> PutApprovalResultResponse -> Bool
== :: PutApprovalResultResponse -> PutApprovalResultResponse -> Bool
$c== :: PutApprovalResultResponse -> PutApprovalResultResponse -> Bool
Prelude.Eq, ReadPrec [PutApprovalResultResponse]
ReadPrec PutApprovalResultResponse
Int -> ReadS PutApprovalResultResponse
ReadS [PutApprovalResultResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutApprovalResultResponse]
$creadListPrec :: ReadPrec [PutApprovalResultResponse]
readPrec :: ReadPrec PutApprovalResultResponse
$creadPrec :: ReadPrec PutApprovalResultResponse
readList :: ReadS [PutApprovalResultResponse]
$creadList :: ReadS [PutApprovalResultResponse]
readsPrec :: Int -> ReadS PutApprovalResultResponse
$creadsPrec :: Int -> ReadS PutApprovalResultResponse
Prelude.Read, Int -> PutApprovalResultResponse -> ShowS
[PutApprovalResultResponse] -> ShowS
PutApprovalResultResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutApprovalResultResponse] -> ShowS
$cshowList :: [PutApprovalResultResponse] -> ShowS
show :: PutApprovalResultResponse -> String
$cshow :: PutApprovalResultResponse -> String
showsPrec :: Int -> PutApprovalResultResponse -> ShowS
$cshowsPrec :: Int -> PutApprovalResultResponse -> ShowS
Prelude.Show, forall x.
Rep PutApprovalResultResponse x -> PutApprovalResultResponse
forall x.
PutApprovalResultResponse -> Rep PutApprovalResultResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutApprovalResultResponse x -> PutApprovalResultResponse
$cfrom :: forall x.
PutApprovalResultResponse -> Rep PutApprovalResultResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutApprovalResultResponse' 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:
--
-- 'approvedAt', 'putApprovalResultResponse_approvedAt' - The timestamp showing when the approval or rejection was submitted.
--
-- 'httpStatus', 'putApprovalResultResponse_httpStatus' - The response's http status code.
newPutApprovalResultResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutApprovalResultResponse
newPutApprovalResultResponse :: Int -> PutApprovalResultResponse
newPutApprovalResultResponse Int
pHttpStatus_ =
  PutApprovalResultResponse'
    { $sel:approvedAt:PutApprovalResultResponse' :: Maybe POSIX
approvedAt =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutApprovalResultResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The timestamp showing when the approval or rejection was submitted.
putApprovalResultResponse_approvedAt :: Lens.Lens' PutApprovalResultResponse (Prelude.Maybe Prelude.UTCTime)
putApprovalResultResponse_approvedAt :: Lens' PutApprovalResultResponse (Maybe UTCTime)
putApprovalResultResponse_approvedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResultResponse' {Maybe POSIX
approvedAt :: Maybe POSIX
$sel:approvedAt:PutApprovalResultResponse' :: PutApprovalResultResponse -> Maybe POSIX
approvedAt} -> Maybe POSIX
approvedAt) (\s :: PutApprovalResultResponse
s@PutApprovalResultResponse' {} Maybe POSIX
a -> PutApprovalResultResponse
s {$sel:approvedAt:PutApprovalResultResponse' :: Maybe POSIX
approvedAt = Maybe POSIX
a} :: PutApprovalResultResponse) 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 response's http status code.
putApprovalResultResponse_httpStatus :: Lens.Lens' PutApprovalResultResponse Prelude.Int
putApprovalResultResponse_httpStatus :: Lens' PutApprovalResultResponse Int
putApprovalResultResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutApprovalResultResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutApprovalResultResponse' :: PutApprovalResultResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutApprovalResultResponse
s@PutApprovalResultResponse' {} Int
a -> PutApprovalResultResponse
s {$sel:httpStatus:PutApprovalResultResponse' :: Int
httpStatus = Int
a} :: PutApprovalResultResponse)

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