{-# 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.SSOAdmin.UpdatePermissionSet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing permission set.
module Amazonka.SSOAdmin.UpdatePermissionSet
  ( -- * Creating a Request
    UpdatePermissionSet (..),
    newUpdatePermissionSet,

    -- * Request Lenses
    updatePermissionSet_description,
    updatePermissionSet_relayState,
    updatePermissionSet_sessionDuration,
    updatePermissionSet_instanceArn,
    updatePermissionSet_permissionSetArn,

    -- * Destructuring the Response
    UpdatePermissionSetResponse (..),
    newUpdatePermissionSetResponse,

    -- * Response Lenses
    updatePermissionSetResponse_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.SSOAdmin.Types

-- | /See:/ 'newUpdatePermissionSet' smart constructor.
data UpdatePermissionSet = UpdatePermissionSet'
  { -- | The description of the PermissionSet.
    UpdatePermissionSet -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Used to redirect users within the application during the federation
    -- authentication process.
    UpdatePermissionSet -> Maybe Text
relayState :: Prelude.Maybe Prelude.Text,
    -- | The length of time that the application user sessions are valid for in
    -- the ISO-8601 standard.
    UpdatePermissionSet -> Maybe Text
sessionDuration :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the IAM Identity Center instance under which the operation
    -- will be executed. For more information about ARNs, see
    -- </general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and AWS Service Namespaces>
    -- in the /AWS General Reference/.
    UpdatePermissionSet -> Text
instanceArn :: Prelude.Text,
    -- | The ARN of the permission set.
    UpdatePermissionSet -> Text
permissionSetArn :: Prelude.Text
  }
  deriving (UpdatePermissionSet -> UpdatePermissionSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePermissionSet -> UpdatePermissionSet -> Bool
$c/= :: UpdatePermissionSet -> UpdatePermissionSet -> Bool
== :: UpdatePermissionSet -> UpdatePermissionSet -> Bool
$c== :: UpdatePermissionSet -> UpdatePermissionSet -> Bool
Prelude.Eq, ReadPrec [UpdatePermissionSet]
ReadPrec UpdatePermissionSet
Int -> ReadS UpdatePermissionSet
ReadS [UpdatePermissionSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePermissionSet]
$creadListPrec :: ReadPrec [UpdatePermissionSet]
readPrec :: ReadPrec UpdatePermissionSet
$creadPrec :: ReadPrec UpdatePermissionSet
readList :: ReadS [UpdatePermissionSet]
$creadList :: ReadS [UpdatePermissionSet]
readsPrec :: Int -> ReadS UpdatePermissionSet
$creadsPrec :: Int -> ReadS UpdatePermissionSet
Prelude.Read, Int -> UpdatePermissionSet -> ShowS
[UpdatePermissionSet] -> ShowS
UpdatePermissionSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePermissionSet] -> ShowS
$cshowList :: [UpdatePermissionSet] -> ShowS
show :: UpdatePermissionSet -> String
$cshow :: UpdatePermissionSet -> String
showsPrec :: Int -> UpdatePermissionSet -> ShowS
$cshowsPrec :: Int -> UpdatePermissionSet -> ShowS
Prelude.Show, forall x. Rep UpdatePermissionSet x -> UpdatePermissionSet
forall x. UpdatePermissionSet -> Rep UpdatePermissionSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePermissionSet x -> UpdatePermissionSet
$cfrom :: forall x. UpdatePermissionSet -> Rep UpdatePermissionSet x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePermissionSet' 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:
--
-- 'description', 'updatePermissionSet_description' - The description of the PermissionSet.
--
-- 'relayState', 'updatePermissionSet_relayState' - Used to redirect users within the application during the federation
-- authentication process.
--
-- 'sessionDuration', 'updatePermissionSet_sessionDuration' - The length of time that the application user sessions are valid for in
-- the ISO-8601 standard.
--
-- 'instanceArn', 'updatePermissionSet_instanceArn' - The ARN of the IAM Identity Center instance under which the operation
-- will be executed. For more information about ARNs, see
-- </general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and AWS Service Namespaces>
-- in the /AWS General Reference/.
--
-- 'permissionSetArn', 'updatePermissionSet_permissionSetArn' - The ARN of the permission set.
newUpdatePermissionSet ::
  -- | 'instanceArn'
  Prelude.Text ->
  -- | 'permissionSetArn'
  Prelude.Text ->
  UpdatePermissionSet
newUpdatePermissionSet :: Text -> Text -> UpdatePermissionSet
newUpdatePermissionSet
  Text
pInstanceArn_
  Text
pPermissionSetArn_ =
    UpdatePermissionSet'
      { $sel:description:UpdatePermissionSet' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:relayState:UpdatePermissionSet' :: Maybe Text
relayState = forall a. Maybe a
Prelude.Nothing,
        $sel:sessionDuration:UpdatePermissionSet' :: Maybe Text
sessionDuration = forall a. Maybe a
Prelude.Nothing,
        $sel:instanceArn:UpdatePermissionSet' :: Text
instanceArn = Text
pInstanceArn_,
        $sel:permissionSetArn:UpdatePermissionSet' :: Text
permissionSetArn = Text
pPermissionSetArn_
      }

-- | The description of the PermissionSet.
updatePermissionSet_description :: Lens.Lens' UpdatePermissionSet (Prelude.Maybe Prelude.Text)
updatePermissionSet_description :: Lens' UpdatePermissionSet (Maybe Text)
updatePermissionSet_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePermissionSet' {Maybe Text
description :: Maybe Text
$sel:description:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdatePermissionSet
s@UpdatePermissionSet' {} Maybe Text
a -> UpdatePermissionSet
s {$sel:description:UpdatePermissionSet' :: Maybe Text
description = Maybe Text
a} :: UpdatePermissionSet)

-- | Used to redirect users within the application during the federation
-- authentication process.
updatePermissionSet_relayState :: Lens.Lens' UpdatePermissionSet (Prelude.Maybe Prelude.Text)
updatePermissionSet_relayState :: Lens' UpdatePermissionSet (Maybe Text)
updatePermissionSet_relayState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePermissionSet' {Maybe Text
relayState :: Maybe Text
$sel:relayState:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
relayState} -> Maybe Text
relayState) (\s :: UpdatePermissionSet
s@UpdatePermissionSet' {} Maybe Text
a -> UpdatePermissionSet
s {$sel:relayState:UpdatePermissionSet' :: Maybe Text
relayState = Maybe Text
a} :: UpdatePermissionSet)

-- | The length of time that the application user sessions are valid for in
-- the ISO-8601 standard.
updatePermissionSet_sessionDuration :: Lens.Lens' UpdatePermissionSet (Prelude.Maybe Prelude.Text)
updatePermissionSet_sessionDuration :: Lens' UpdatePermissionSet (Maybe Text)
updatePermissionSet_sessionDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePermissionSet' {Maybe Text
sessionDuration :: Maybe Text
$sel:sessionDuration:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
sessionDuration} -> Maybe Text
sessionDuration) (\s :: UpdatePermissionSet
s@UpdatePermissionSet' {} Maybe Text
a -> UpdatePermissionSet
s {$sel:sessionDuration:UpdatePermissionSet' :: Maybe Text
sessionDuration = Maybe Text
a} :: UpdatePermissionSet)

-- | The ARN of the IAM Identity Center instance under which the operation
-- will be executed. For more information about ARNs, see
-- </general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and AWS Service Namespaces>
-- in the /AWS General Reference/.
updatePermissionSet_instanceArn :: Lens.Lens' UpdatePermissionSet Prelude.Text
updatePermissionSet_instanceArn :: Lens' UpdatePermissionSet Text
updatePermissionSet_instanceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePermissionSet' {Text
instanceArn :: Text
$sel:instanceArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
instanceArn} -> Text
instanceArn) (\s :: UpdatePermissionSet
s@UpdatePermissionSet' {} Text
a -> UpdatePermissionSet
s {$sel:instanceArn:UpdatePermissionSet' :: Text
instanceArn = Text
a} :: UpdatePermissionSet)

-- | The ARN of the permission set.
updatePermissionSet_permissionSetArn :: Lens.Lens' UpdatePermissionSet Prelude.Text
updatePermissionSet_permissionSetArn :: Lens' UpdatePermissionSet Text
updatePermissionSet_permissionSetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePermissionSet' {Text
permissionSetArn :: Text
$sel:permissionSetArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
permissionSetArn} -> Text
permissionSetArn) (\s :: UpdatePermissionSet
s@UpdatePermissionSet' {} Text
a -> UpdatePermissionSet
s {$sel:permissionSetArn:UpdatePermissionSet' :: Text
permissionSetArn = Text
a} :: UpdatePermissionSet)

instance Core.AWSRequest UpdatePermissionSet where
  type
    AWSResponse UpdatePermissionSet =
      UpdatePermissionSetResponse
  request :: (Service -> Service)
-> UpdatePermissionSet -> Request UpdatePermissionSet
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 UpdatePermissionSet
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdatePermissionSet)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdatePermissionSetResponse
UpdatePermissionSetResponse'
            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))
      )

instance Prelude.Hashable UpdatePermissionSet where
  hashWithSalt :: Int -> UpdatePermissionSet -> Int
hashWithSalt Int
_salt UpdatePermissionSet' {Maybe Text
Text
permissionSetArn :: Text
instanceArn :: Text
sessionDuration :: Maybe Text
relayState :: Maybe Text
description :: Maybe Text
$sel:permissionSetArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
$sel:instanceArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
$sel:sessionDuration:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
$sel:relayState:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
$sel:description:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
relayState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sessionDuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
permissionSetArn

instance Prelude.NFData UpdatePermissionSet where
  rnf :: UpdatePermissionSet -> ()
rnf UpdatePermissionSet' {Maybe Text
Text
permissionSetArn :: Text
instanceArn :: Text
sessionDuration :: Maybe Text
relayState :: Maybe Text
description :: Maybe Text
$sel:permissionSetArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
$sel:instanceArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
$sel:sessionDuration:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
$sel:relayState:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
$sel:description:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
..} =
    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 Text
relayState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
permissionSetArn

instance Data.ToHeaders UpdatePermissionSet where
  toHeaders :: UpdatePermissionSet -> 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
"SWBExternalService.UpdatePermissionSet" ::
                          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 UpdatePermissionSet where
  toJSON :: UpdatePermissionSet -> Value
toJSON UpdatePermissionSet' {Maybe Text
Text
permissionSetArn :: Text
instanceArn :: Text
sessionDuration :: Maybe Text
relayState :: Maybe Text
description :: Maybe Text
$sel:permissionSetArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
$sel:instanceArn:UpdatePermissionSet' :: UpdatePermissionSet -> Text
$sel:sessionDuration:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
$sel:relayState:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
$sel:description:UpdatePermissionSet' :: UpdatePermissionSet -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"RelayState" 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
relayState,
            (Key
"SessionDuration" 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
sessionDuration,
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PermissionSetArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
permissionSetArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdatePermissionSetResponse' 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', 'updatePermissionSetResponse_httpStatus' - The response's http status code.
newUpdatePermissionSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePermissionSetResponse
newUpdatePermissionSetResponse :: Int -> UpdatePermissionSetResponse
newUpdatePermissionSetResponse Int
pHttpStatus_ =
  UpdatePermissionSetResponse'
    { $sel:httpStatus:UpdatePermissionSetResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdatePermissionSetResponse where
  rnf :: UpdatePermissionSetResponse -> ()
rnf UpdatePermissionSetResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdatePermissionSetResponse' :: UpdatePermissionSetResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus