{-# 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.WellArchitected.CreateLensVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Create a new lens version.
--
-- A lens can have up to 100 versions.
--
-- After a lens has been imported, create a new lens version to publish it.
-- The owner of a lens can share the lens with other Amazon Web Services
-- accounts and IAM users in the same Amazon Web Services Region. Only the
-- owner of a lens can delete it.
module Amazonka.WellArchitected.CreateLensVersion
  ( -- * Creating a Request
    CreateLensVersion (..),
    newCreateLensVersion,

    -- * Request Lenses
    createLensVersion_isMajorVersion,
    createLensVersion_lensAlias,
    createLensVersion_lensVersion,
    createLensVersion_clientRequestToken,

    -- * Destructuring the Response
    CreateLensVersionResponse (..),
    newCreateLensVersionResponse,

    -- * Response Lenses
    createLensVersionResponse_lensArn,
    createLensVersionResponse_lensVersion,
    createLensVersionResponse_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.WellArchitected.Types

-- | /See:/ 'newCreateLensVersion' smart constructor.
data CreateLensVersion = CreateLensVersion'
  { -- | Set to true if this new major lens version.
    CreateLensVersion -> Maybe Bool
isMajorVersion :: Prelude.Maybe Prelude.Bool,
    CreateLensVersion -> Text
lensAlias :: Prelude.Text,
    -- | The version of the lens being created.
    CreateLensVersion -> Text
lensVersion :: Prelude.Text,
    CreateLensVersion -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (CreateLensVersion -> CreateLensVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLensVersion -> CreateLensVersion -> Bool
$c/= :: CreateLensVersion -> CreateLensVersion -> Bool
== :: CreateLensVersion -> CreateLensVersion -> Bool
$c== :: CreateLensVersion -> CreateLensVersion -> Bool
Prelude.Eq, ReadPrec [CreateLensVersion]
ReadPrec CreateLensVersion
Int -> ReadS CreateLensVersion
ReadS [CreateLensVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLensVersion]
$creadListPrec :: ReadPrec [CreateLensVersion]
readPrec :: ReadPrec CreateLensVersion
$creadPrec :: ReadPrec CreateLensVersion
readList :: ReadS [CreateLensVersion]
$creadList :: ReadS [CreateLensVersion]
readsPrec :: Int -> ReadS CreateLensVersion
$creadsPrec :: Int -> ReadS CreateLensVersion
Prelude.Read, Int -> CreateLensVersion -> ShowS
[CreateLensVersion] -> ShowS
CreateLensVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLensVersion] -> ShowS
$cshowList :: [CreateLensVersion] -> ShowS
show :: CreateLensVersion -> String
$cshow :: CreateLensVersion -> String
showsPrec :: Int -> CreateLensVersion -> ShowS
$cshowsPrec :: Int -> CreateLensVersion -> ShowS
Prelude.Show, forall x. Rep CreateLensVersion x -> CreateLensVersion
forall x. CreateLensVersion -> Rep CreateLensVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLensVersion x -> CreateLensVersion
$cfrom :: forall x. CreateLensVersion -> Rep CreateLensVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateLensVersion' 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:
--
-- 'isMajorVersion', 'createLensVersion_isMajorVersion' - Set to true if this new major lens version.
--
-- 'lensAlias', 'createLensVersion_lensAlias' - Undocumented member.
--
-- 'lensVersion', 'createLensVersion_lensVersion' - The version of the lens being created.
--
-- 'clientRequestToken', 'createLensVersion_clientRequestToken' - Undocumented member.
newCreateLensVersion ::
  -- | 'lensAlias'
  Prelude.Text ->
  -- | 'lensVersion'
  Prelude.Text ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateLensVersion
newCreateLensVersion :: Text -> Text -> Text -> CreateLensVersion
newCreateLensVersion
  Text
pLensAlias_
  Text
pLensVersion_
  Text
pClientRequestToken_ =
    CreateLensVersion'
      { $sel:isMajorVersion:CreateLensVersion' :: Maybe Bool
isMajorVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:lensAlias:CreateLensVersion' :: Text
lensAlias = Text
pLensAlias_,
        $sel:lensVersion:CreateLensVersion' :: Text
lensVersion = Text
pLensVersion_,
        $sel:clientRequestToken:CreateLensVersion' :: Text
clientRequestToken = Text
pClientRequestToken_
      }

-- | Set to true if this new major lens version.
createLensVersion_isMajorVersion :: Lens.Lens' CreateLensVersion (Prelude.Maybe Prelude.Bool)
createLensVersion_isMajorVersion :: Lens' CreateLensVersion (Maybe Bool)
createLensVersion_isMajorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLensVersion' {Maybe Bool
isMajorVersion :: Maybe Bool
$sel:isMajorVersion:CreateLensVersion' :: CreateLensVersion -> Maybe Bool
isMajorVersion} -> Maybe Bool
isMajorVersion) (\s :: CreateLensVersion
s@CreateLensVersion' {} Maybe Bool
a -> CreateLensVersion
s {$sel:isMajorVersion:CreateLensVersion' :: Maybe Bool
isMajorVersion = Maybe Bool
a} :: CreateLensVersion)

-- | Undocumented member.
createLensVersion_lensAlias :: Lens.Lens' CreateLensVersion Prelude.Text
createLensVersion_lensAlias :: Lens' CreateLensVersion Text
createLensVersion_lensAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLensVersion' {Text
lensAlias :: Text
$sel:lensAlias:CreateLensVersion' :: CreateLensVersion -> Text
lensAlias} -> Text
lensAlias) (\s :: CreateLensVersion
s@CreateLensVersion' {} Text
a -> CreateLensVersion
s {$sel:lensAlias:CreateLensVersion' :: Text
lensAlias = Text
a} :: CreateLensVersion)

-- | The version of the lens being created.
createLensVersion_lensVersion :: Lens.Lens' CreateLensVersion Prelude.Text
createLensVersion_lensVersion :: Lens' CreateLensVersion Text
createLensVersion_lensVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLensVersion' {Text
lensVersion :: Text
$sel:lensVersion:CreateLensVersion' :: CreateLensVersion -> Text
lensVersion} -> Text
lensVersion) (\s :: CreateLensVersion
s@CreateLensVersion' {} Text
a -> CreateLensVersion
s {$sel:lensVersion:CreateLensVersion' :: Text
lensVersion = Text
a} :: CreateLensVersion)

-- | Undocumented member.
createLensVersion_clientRequestToken :: Lens.Lens' CreateLensVersion Prelude.Text
createLensVersion_clientRequestToken :: Lens' CreateLensVersion Text
createLensVersion_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLensVersion' {Text
clientRequestToken :: Text
$sel:clientRequestToken:CreateLensVersion' :: CreateLensVersion -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: CreateLensVersion
s@CreateLensVersion' {} Text
a -> CreateLensVersion
s {$sel:clientRequestToken:CreateLensVersion' :: Text
clientRequestToken = Text
a} :: CreateLensVersion)

instance Core.AWSRequest CreateLensVersion where
  type
    AWSResponse CreateLensVersion =
      CreateLensVersionResponse
  request :: (Service -> Service)
-> CreateLensVersion -> Request CreateLensVersion
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 CreateLensVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLensVersion)))
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 -> Int -> CreateLensVersionResponse
CreateLensVersionResponse'
            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
"LensArn")
            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
"LensVersion")
            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 CreateLensVersion where
  hashWithSalt :: Int -> CreateLensVersion -> Int
hashWithSalt Int
_salt CreateLensVersion' {Maybe Bool
Text
clientRequestToken :: Text
lensVersion :: Text
lensAlias :: Text
isMajorVersion :: Maybe Bool
$sel:clientRequestToken:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensVersion:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensAlias:CreateLensVersion' :: CreateLensVersion -> Text
$sel:isMajorVersion:CreateLensVersion' :: CreateLensVersion -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isMajorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lensAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lensVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData CreateLensVersion where
  rnf :: CreateLensVersion -> ()
rnf CreateLensVersion' {Maybe Bool
Text
clientRequestToken :: Text
lensVersion :: Text
lensAlias :: Text
isMajorVersion :: Maybe Bool
$sel:clientRequestToken:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensVersion:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensAlias:CreateLensVersion' :: CreateLensVersion -> Text
$sel:isMajorVersion:CreateLensVersion' :: CreateLensVersion -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isMajorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lensAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lensVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

instance Data.ToHeaders CreateLensVersion where
  toHeaders :: CreateLensVersion -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateLensVersion where
  toJSON :: CreateLensVersion -> Value
toJSON CreateLensVersion' {Maybe Bool
Text
clientRequestToken :: Text
lensVersion :: Text
lensAlias :: Text
isMajorVersion :: Maybe Bool
$sel:clientRequestToken:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensVersion:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensAlias:CreateLensVersion' :: CreateLensVersion -> Text
$sel:isMajorVersion:CreateLensVersion' :: CreateLensVersion -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IsMajorVersion" 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 Bool
isMajorVersion,
            forall a. a -> Maybe a
Prelude.Just (Key
"LensVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
lensVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

instance Data.ToPath CreateLensVersion where
  toPath :: CreateLensVersion -> ByteString
toPath CreateLensVersion' {Maybe Bool
Text
clientRequestToken :: Text
lensVersion :: Text
lensAlias :: Text
isMajorVersion :: Maybe Bool
$sel:clientRequestToken:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensVersion:CreateLensVersion' :: CreateLensVersion -> Text
$sel:lensAlias:CreateLensVersion' :: CreateLensVersion -> Text
$sel:isMajorVersion:CreateLensVersion' :: CreateLensVersion -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/lenses/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
lensAlias, ByteString
"/versions"]

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

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

-- |
-- Create a value of 'CreateLensVersionResponse' 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:
--
-- 'lensArn', 'createLensVersionResponse_lensArn' - The ARN for the lens.
--
-- 'lensVersion', 'createLensVersionResponse_lensVersion' - The version of the lens.
--
-- 'httpStatus', 'createLensVersionResponse_httpStatus' - The response's http status code.
newCreateLensVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLensVersionResponse
newCreateLensVersionResponse :: Int -> CreateLensVersionResponse
newCreateLensVersionResponse Int
pHttpStatus_ =
  CreateLensVersionResponse'
    { $sel:lensArn:CreateLensVersionResponse' :: Maybe Text
lensArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lensVersion:CreateLensVersionResponse' :: Maybe Text
lensVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLensVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN for the lens.
createLensVersionResponse_lensArn :: Lens.Lens' CreateLensVersionResponse (Prelude.Maybe Prelude.Text)
createLensVersionResponse_lensArn :: Lens' CreateLensVersionResponse (Maybe Text)
createLensVersionResponse_lensArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLensVersionResponse' {Maybe Text
lensArn :: Maybe Text
$sel:lensArn:CreateLensVersionResponse' :: CreateLensVersionResponse -> Maybe Text
lensArn} -> Maybe Text
lensArn) (\s :: CreateLensVersionResponse
s@CreateLensVersionResponse' {} Maybe Text
a -> CreateLensVersionResponse
s {$sel:lensArn:CreateLensVersionResponse' :: Maybe Text
lensArn = Maybe Text
a} :: CreateLensVersionResponse)

-- | The version of the lens.
createLensVersionResponse_lensVersion :: Lens.Lens' CreateLensVersionResponse (Prelude.Maybe Prelude.Text)
createLensVersionResponse_lensVersion :: Lens' CreateLensVersionResponse (Maybe Text)
createLensVersionResponse_lensVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLensVersionResponse' {Maybe Text
lensVersion :: Maybe Text
$sel:lensVersion:CreateLensVersionResponse' :: CreateLensVersionResponse -> Maybe Text
lensVersion} -> Maybe Text
lensVersion) (\s :: CreateLensVersionResponse
s@CreateLensVersionResponse' {} Maybe Text
a -> CreateLensVersionResponse
s {$sel:lensVersion:CreateLensVersionResponse' :: Maybe Text
lensVersion = Maybe Text
a} :: CreateLensVersionResponse)

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

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