{-# 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.MediaConvert.UpdateQueue
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modify one of your existing queues.
module Amazonka.MediaConvert.UpdateQueue
  ( -- * Creating a Request
    UpdateQueue (..),
    newUpdateQueue,

    -- * Request Lenses
    updateQueue_description,
    updateQueue_reservationPlanSettings,
    updateQueue_status,
    updateQueue_name,

    -- * Destructuring the Response
    UpdateQueueResponse (..),
    newUpdateQueueResponse,

    -- * Response Lenses
    updateQueueResponse_queue,
    updateQueueResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateQueue' smart constructor.
data UpdateQueue = UpdateQueue'
  { -- | The new description for the queue, if you are changing it.
    UpdateQueue -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The new details of your pricing plan for your reserved queue. When you
    -- set up a new pricing plan to replace an expired one, you enter into
    -- another 12-month commitment. When you add capacity to your queue by
    -- increasing the number of RTS, you extend the term of your commitment to
    -- 12 months from when you add capacity. After you make these commitments,
    -- you can\'t cancel them.
    UpdateQueue -> Maybe ReservationPlanSettings
reservationPlanSettings :: Prelude.Maybe ReservationPlanSettings,
    -- | Pause or activate a queue by changing its status between ACTIVE and
    -- PAUSED. If you pause a queue, jobs in that queue won\'t begin. Jobs that
    -- are running when you pause the queue continue to run until they finish
    -- or result in an error.
    UpdateQueue -> Maybe QueueStatus
status :: Prelude.Maybe QueueStatus,
    -- | The name of the queue that you are modifying.
    UpdateQueue -> Text
name :: Prelude.Text
  }
  deriving (UpdateQueue -> UpdateQueue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateQueue -> UpdateQueue -> Bool
$c/= :: UpdateQueue -> UpdateQueue -> Bool
== :: UpdateQueue -> UpdateQueue -> Bool
$c== :: UpdateQueue -> UpdateQueue -> Bool
Prelude.Eq, ReadPrec [UpdateQueue]
ReadPrec UpdateQueue
Int -> ReadS UpdateQueue
ReadS [UpdateQueue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateQueue]
$creadListPrec :: ReadPrec [UpdateQueue]
readPrec :: ReadPrec UpdateQueue
$creadPrec :: ReadPrec UpdateQueue
readList :: ReadS [UpdateQueue]
$creadList :: ReadS [UpdateQueue]
readsPrec :: Int -> ReadS UpdateQueue
$creadsPrec :: Int -> ReadS UpdateQueue
Prelude.Read, Int -> UpdateQueue -> ShowS
[UpdateQueue] -> ShowS
UpdateQueue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateQueue] -> ShowS
$cshowList :: [UpdateQueue] -> ShowS
show :: UpdateQueue -> String
$cshow :: UpdateQueue -> String
showsPrec :: Int -> UpdateQueue -> ShowS
$cshowsPrec :: Int -> UpdateQueue -> ShowS
Prelude.Show, forall x. Rep UpdateQueue x -> UpdateQueue
forall x. UpdateQueue -> Rep UpdateQueue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateQueue x -> UpdateQueue
$cfrom :: forall x. UpdateQueue -> Rep UpdateQueue x
Prelude.Generic)

-- |
-- Create a value of 'UpdateQueue' 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', 'updateQueue_description' - The new description for the queue, if you are changing it.
--
-- 'reservationPlanSettings', 'updateQueue_reservationPlanSettings' - The new details of your pricing plan for your reserved queue. When you
-- set up a new pricing plan to replace an expired one, you enter into
-- another 12-month commitment. When you add capacity to your queue by
-- increasing the number of RTS, you extend the term of your commitment to
-- 12 months from when you add capacity. After you make these commitments,
-- you can\'t cancel them.
--
-- 'status', 'updateQueue_status' - Pause or activate a queue by changing its status between ACTIVE and
-- PAUSED. If you pause a queue, jobs in that queue won\'t begin. Jobs that
-- are running when you pause the queue continue to run until they finish
-- or result in an error.
--
-- 'name', 'updateQueue_name' - The name of the queue that you are modifying.
newUpdateQueue ::
  -- | 'name'
  Prelude.Text ->
  UpdateQueue
newUpdateQueue :: Text -> UpdateQueue
newUpdateQueue Text
pName_ =
  UpdateQueue'
    { $sel:description:UpdateQueue' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:reservationPlanSettings:UpdateQueue' :: Maybe ReservationPlanSettings
reservationPlanSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateQueue' :: Maybe QueueStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateQueue' :: Text
name = Text
pName_
    }

-- | The new description for the queue, if you are changing it.
updateQueue_description :: Lens.Lens' UpdateQueue (Prelude.Maybe Prelude.Text)
updateQueue_description :: Lens' UpdateQueue (Maybe Text)
updateQueue_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQueue' {Maybe Text
description :: Maybe Text
$sel:description:UpdateQueue' :: UpdateQueue -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateQueue
s@UpdateQueue' {} Maybe Text
a -> UpdateQueue
s {$sel:description:UpdateQueue' :: Maybe Text
description = Maybe Text
a} :: UpdateQueue)

-- | The new details of your pricing plan for your reserved queue. When you
-- set up a new pricing plan to replace an expired one, you enter into
-- another 12-month commitment. When you add capacity to your queue by
-- increasing the number of RTS, you extend the term of your commitment to
-- 12 months from when you add capacity. After you make these commitments,
-- you can\'t cancel them.
updateQueue_reservationPlanSettings :: Lens.Lens' UpdateQueue (Prelude.Maybe ReservationPlanSettings)
updateQueue_reservationPlanSettings :: Lens' UpdateQueue (Maybe ReservationPlanSettings)
updateQueue_reservationPlanSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQueue' {Maybe ReservationPlanSettings
reservationPlanSettings :: Maybe ReservationPlanSettings
$sel:reservationPlanSettings:UpdateQueue' :: UpdateQueue -> Maybe ReservationPlanSettings
reservationPlanSettings} -> Maybe ReservationPlanSettings
reservationPlanSettings) (\s :: UpdateQueue
s@UpdateQueue' {} Maybe ReservationPlanSettings
a -> UpdateQueue
s {$sel:reservationPlanSettings:UpdateQueue' :: Maybe ReservationPlanSettings
reservationPlanSettings = Maybe ReservationPlanSettings
a} :: UpdateQueue)

-- | Pause or activate a queue by changing its status between ACTIVE and
-- PAUSED. If you pause a queue, jobs in that queue won\'t begin. Jobs that
-- are running when you pause the queue continue to run until they finish
-- or result in an error.
updateQueue_status :: Lens.Lens' UpdateQueue (Prelude.Maybe QueueStatus)
updateQueue_status :: Lens' UpdateQueue (Maybe QueueStatus)
updateQueue_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQueue' {Maybe QueueStatus
status :: Maybe QueueStatus
$sel:status:UpdateQueue' :: UpdateQueue -> Maybe QueueStatus
status} -> Maybe QueueStatus
status) (\s :: UpdateQueue
s@UpdateQueue' {} Maybe QueueStatus
a -> UpdateQueue
s {$sel:status:UpdateQueue' :: Maybe QueueStatus
status = Maybe QueueStatus
a} :: UpdateQueue)

-- | The name of the queue that you are modifying.
updateQueue_name :: Lens.Lens' UpdateQueue Prelude.Text
updateQueue_name :: Lens' UpdateQueue Text
updateQueue_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQueue' {Text
name :: Text
$sel:name:UpdateQueue' :: UpdateQueue -> Text
name} -> Text
name) (\s :: UpdateQueue
s@UpdateQueue' {} Text
a -> UpdateQueue
s {$sel:name:UpdateQueue' :: Text
name = Text
a} :: UpdateQueue)

instance Core.AWSRequest UpdateQueue where
  type AWSResponse UpdateQueue = UpdateQueueResponse
  request :: (Service -> Service) -> UpdateQueue -> Request UpdateQueue
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateQueue
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateQueue)))
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 Queue -> Int -> UpdateQueueResponse
UpdateQueueResponse'
            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
"queue")
            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 UpdateQueue where
  hashWithSalt :: Int -> UpdateQueue -> Int
hashWithSalt Int
_salt UpdateQueue' {Maybe Text
Maybe QueueStatus
Maybe ReservationPlanSettings
Text
name :: Text
status :: Maybe QueueStatus
reservationPlanSettings :: Maybe ReservationPlanSettings
description :: Maybe Text
$sel:name:UpdateQueue' :: UpdateQueue -> Text
$sel:status:UpdateQueue' :: UpdateQueue -> Maybe QueueStatus
$sel:reservationPlanSettings:UpdateQueue' :: UpdateQueue -> Maybe ReservationPlanSettings
$sel:description:UpdateQueue' :: UpdateQueue -> 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 ReservationPlanSettings
reservationPlanSettings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QueueStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateQueue where
  rnf :: UpdateQueue -> ()
rnf UpdateQueue' {Maybe Text
Maybe QueueStatus
Maybe ReservationPlanSettings
Text
name :: Text
status :: Maybe QueueStatus
reservationPlanSettings :: Maybe ReservationPlanSettings
description :: Maybe Text
$sel:name:UpdateQueue' :: UpdateQueue -> Text
$sel:status:UpdateQueue' :: UpdateQueue -> Maybe QueueStatus
$sel:reservationPlanSettings:UpdateQueue' :: UpdateQueue -> Maybe ReservationPlanSettings
$sel:description:UpdateQueue' :: UpdateQueue -> 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 ReservationPlanSettings
reservationPlanSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QueueStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders UpdateQueue where
  toHeaders :: UpdateQueue -> 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 UpdateQueue where
  toJSON :: UpdateQueue -> Value
toJSON UpdateQueue' {Maybe Text
Maybe QueueStatus
Maybe ReservationPlanSettings
Text
name :: Text
status :: Maybe QueueStatus
reservationPlanSettings :: Maybe ReservationPlanSettings
description :: Maybe Text
$sel:name:UpdateQueue' :: UpdateQueue -> Text
$sel:status:UpdateQueue' :: UpdateQueue -> Maybe QueueStatus
$sel:reservationPlanSettings:UpdateQueue' :: UpdateQueue -> Maybe ReservationPlanSettings
$sel:description:UpdateQueue' :: UpdateQueue -> 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
"reservationPlanSettings" 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 ReservationPlanSettings
reservationPlanSettings,
            (Key
"status" 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 QueueStatus
status
          ]
      )

instance Data.ToPath UpdateQueue where
  toPath :: UpdateQueue -> ByteString
toPath UpdateQueue' {Maybe Text
Maybe QueueStatus
Maybe ReservationPlanSettings
Text
name :: Text
status :: Maybe QueueStatus
reservationPlanSettings :: Maybe ReservationPlanSettings
description :: Maybe Text
$sel:name:UpdateQueue' :: UpdateQueue -> Text
$sel:status:UpdateQueue' :: UpdateQueue -> Maybe QueueStatus
$sel:reservationPlanSettings:UpdateQueue' :: UpdateQueue -> Maybe ReservationPlanSettings
$sel:description:UpdateQueue' :: UpdateQueue -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2017-08-29/queues/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newUpdateQueueResponse' smart constructor.
data UpdateQueueResponse = UpdateQueueResponse'
  { -- | You can use queues to manage the resources that are available to your
    -- AWS account for running multiple transcoding jobs at the same time. If
    -- you don\'t specify a queue, the service sends all jobs through the
    -- default queue. For more information, see
    -- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/working-with-queues.html.
    UpdateQueueResponse -> Maybe Queue
queue :: Prelude.Maybe Queue,
    -- | The response's http status code.
    UpdateQueueResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateQueueResponse -> UpdateQueueResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateQueueResponse -> UpdateQueueResponse -> Bool
$c/= :: UpdateQueueResponse -> UpdateQueueResponse -> Bool
== :: UpdateQueueResponse -> UpdateQueueResponse -> Bool
$c== :: UpdateQueueResponse -> UpdateQueueResponse -> Bool
Prelude.Eq, ReadPrec [UpdateQueueResponse]
ReadPrec UpdateQueueResponse
Int -> ReadS UpdateQueueResponse
ReadS [UpdateQueueResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateQueueResponse]
$creadListPrec :: ReadPrec [UpdateQueueResponse]
readPrec :: ReadPrec UpdateQueueResponse
$creadPrec :: ReadPrec UpdateQueueResponse
readList :: ReadS [UpdateQueueResponse]
$creadList :: ReadS [UpdateQueueResponse]
readsPrec :: Int -> ReadS UpdateQueueResponse
$creadsPrec :: Int -> ReadS UpdateQueueResponse
Prelude.Read, Int -> UpdateQueueResponse -> ShowS
[UpdateQueueResponse] -> ShowS
UpdateQueueResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateQueueResponse] -> ShowS
$cshowList :: [UpdateQueueResponse] -> ShowS
show :: UpdateQueueResponse -> String
$cshow :: UpdateQueueResponse -> String
showsPrec :: Int -> UpdateQueueResponse -> ShowS
$cshowsPrec :: Int -> UpdateQueueResponse -> ShowS
Prelude.Show, forall x. Rep UpdateQueueResponse x -> UpdateQueueResponse
forall x. UpdateQueueResponse -> Rep UpdateQueueResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateQueueResponse x -> UpdateQueueResponse
$cfrom :: forall x. UpdateQueueResponse -> Rep UpdateQueueResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateQueueResponse' 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:
--
-- 'queue', 'updateQueueResponse_queue' - You can use queues to manage the resources that are available to your
-- AWS account for running multiple transcoding jobs at the same time. If
-- you don\'t specify a queue, the service sends all jobs through the
-- default queue. For more information, see
-- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/working-with-queues.html.
--
-- 'httpStatus', 'updateQueueResponse_httpStatus' - The response's http status code.
newUpdateQueueResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateQueueResponse
newUpdateQueueResponse :: Int -> UpdateQueueResponse
newUpdateQueueResponse Int
pHttpStatus_ =
  UpdateQueueResponse'
    { $sel:queue:UpdateQueueResponse' :: Maybe Queue
queue = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateQueueResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | You can use queues to manage the resources that are available to your
-- AWS account for running multiple transcoding jobs at the same time. If
-- you don\'t specify a queue, the service sends all jobs through the
-- default queue. For more information, see
-- https:\/\/docs.aws.amazon.com\/mediaconvert\/latest\/ug\/working-with-queues.html.
updateQueueResponse_queue :: Lens.Lens' UpdateQueueResponse (Prelude.Maybe Queue)
updateQueueResponse_queue :: Lens' UpdateQueueResponse (Maybe Queue)
updateQueueResponse_queue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQueueResponse' {Maybe Queue
queue :: Maybe Queue
$sel:queue:UpdateQueueResponse' :: UpdateQueueResponse -> Maybe Queue
queue} -> Maybe Queue
queue) (\s :: UpdateQueueResponse
s@UpdateQueueResponse' {} Maybe Queue
a -> UpdateQueueResponse
s {$sel:queue:UpdateQueueResponse' :: Maybe Queue
queue = Maybe Queue
a} :: UpdateQueueResponse)

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

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