{-# 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.DynamoDB.ListTagsOfResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List all tags on an Amazon DynamoDB resource. You can call
-- ListTagsOfResource up to 10 times per second, per account.
--
-- For an overview on tagging DynamoDB resources, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Tagging.html Tagging for DynamoDB>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- This operation returns paginated results.
module Amazonka.DynamoDB.ListTagsOfResource
  ( -- * Creating a Request
    ListTagsOfResource (..),
    newListTagsOfResource,

    -- * Request Lenses
    listTagsOfResource_nextToken,
    listTagsOfResource_resourceArn,

    -- * Destructuring the Response
    ListTagsOfResourceResponse (..),
    newListTagsOfResourceResponse,

    -- * Response Lenses
    listTagsOfResourceResponse_nextToken,
    listTagsOfResourceResponse_tags,
    listTagsOfResourceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListTagsOfResource' smart constructor.
data ListTagsOfResource = ListTagsOfResource'
  { -- | An optional string that, if supplied, must be copied from the output of
    -- a previous call to ListTagOfResource. When provided in this manner, this
    -- API fetches the next page of results.
    ListTagsOfResource -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon DynamoDB resource with tags to be listed. This value is an
    -- Amazon Resource Name (ARN).
    ListTagsOfResource -> Text
resourceArn :: Prelude.Text
  }
  deriving (ListTagsOfResource -> ListTagsOfResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsOfResource -> ListTagsOfResource -> Bool
$c/= :: ListTagsOfResource -> ListTagsOfResource -> Bool
== :: ListTagsOfResource -> ListTagsOfResource -> Bool
$c== :: ListTagsOfResource -> ListTagsOfResource -> Bool
Prelude.Eq, ReadPrec [ListTagsOfResource]
ReadPrec ListTagsOfResource
Int -> ReadS ListTagsOfResource
ReadS [ListTagsOfResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsOfResource]
$creadListPrec :: ReadPrec [ListTagsOfResource]
readPrec :: ReadPrec ListTagsOfResource
$creadPrec :: ReadPrec ListTagsOfResource
readList :: ReadS [ListTagsOfResource]
$creadList :: ReadS [ListTagsOfResource]
readsPrec :: Int -> ReadS ListTagsOfResource
$creadsPrec :: Int -> ReadS ListTagsOfResource
Prelude.Read, Int -> ListTagsOfResource -> ShowS
[ListTagsOfResource] -> ShowS
ListTagsOfResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsOfResource] -> ShowS
$cshowList :: [ListTagsOfResource] -> ShowS
show :: ListTagsOfResource -> String
$cshow :: ListTagsOfResource -> String
showsPrec :: Int -> ListTagsOfResource -> ShowS
$cshowsPrec :: Int -> ListTagsOfResource -> ShowS
Prelude.Show, forall x. Rep ListTagsOfResource x -> ListTagsOfResource
forall x. ListTagsOfResource -> Rep ListTagsOfResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTagsOfResource x -> ListTagsOfResource
$cfrom :: forall x. ListTagsOfResource -> Rep ListTagsOfResource x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsOfResource' 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:
--
-- 'nextToken', 'listTagsOfResource_nextToken' - An optional string that, if supplied, must be copied from the output of
-- a previous call to ListTagOfResource. When provided in this manner, this
-- API fetches the next page of results.
--
-- 'resourceArn', 'listTagsOfResource_resourceArn' - The Amazon DynamoDB resource with tags to be listed. This value is an
-- Amazon Resource Name (ARN).
newListTagsOfResource ::
  -- | 'resourceArn'
  Prelude.Text ->
  ListTagsOfResource
newListTagsOfResource :: Text -> ListTagsOfResource
newListTagsOfResource Text
pResourceArn_ =
  ListTagsOfResource'
    { $sel:nextToken:ListTagsOfResource' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:ListTagsOfResource' :: Text
resourceArn = Text
pResourceArn_
    }

-- | An optional string that, if supplied, must be copied from the output of
-- a previous call to ListTagOfResource. When provided in this manner, this
-- API fetches the next page of results.
listTagsOfResource_nextToken :: Lens.Lens' ListTagsOfResource (Prelude.Maybe Prelude.Text)
listTagsOfResource_nextToken :: Lens' ListTagsOfResource (Maybe Text)
listTagsOfResource_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsOfResource' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTagsOfResource' :: ListTagsOfResource -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTagsOfResource
s@ListTagsOfResource' {} Maybe Text
a -> ListTagsOfResource
s {$sel:nextToken:ListTagsOfResource' :: Maybe Text
nextToken = Maybe Text
a} :: ListTagsOfResource)

-- | The Amazon DynamoDB resource with tags to be listed. This value is an
-- Amazon Resource Name (ARN).
listTagsOfResource_resourceArn :: Lens.Lens' ListTagsOfResource Prelude.Text
listTagsOfResource_resourceArn :: Lens' ListTagsOfResource Text
listTagsOfResource_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsOfResource' {Text
resourceArn :: Text
$sel:resourceArn:ListTagsOfResource' :: ListTagsOfResource -> Text
resourceArn} -> Text
resourceArn) (\s :: ListTagsOfResource
s@ListTagsOfResource' {} Text
a -> ListTagsOfResource
s {$sel:resourceArn:ListTagsOfResource' :: Text
resourceArn = Text
a} :: ListTagsOfResource)

instance Core.AWSPager ListTagsOfResource where
  page :: ListTagsOfResource
-> AWSResponse ListTagsOfResource -> Maybe ListTagsOfResource
page ListTagsOfResource
rq AWSResponse ListTagsOfResource
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTagsOfResource
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTagsOfResourceResponse (Maybe Text)
listTagsOfResourceResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTagsOfResource
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTagsOfResourceResponse (Maybe [Tag])
listTagsOfResourceResponse_tags
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListTagsOfResource
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTagsOfResource (Maybe Text)
listTagsOfResource_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTagsOfResource
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTagsOfResourceResponse (Maybe Text)
listTagsOfResourceResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListTagsOfResource where
  type
    AWSResponse ListTagsOfResource =
      ListTagsOfResourceResponse
  request :: (Service -> Service)
-> ListTagsOfResource -> Request ListTagsOfResource
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 ListTagsOfResource
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTagsOfResource)))
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 [Tag] -> Int -> ListTagsOfResourceResponse
ListTagsOfResourceResponse'
            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
"NextToken")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 ListTagsOfResource where
  hashWithSalt :: Int -> ListTagsOfResource -> Int
hashWithSalt Int
_salt ListTagsOfResource' {Maybe Text
Text
resourceArn :: Text
nextToken :: Maybe Text
$sel:resourceArn:ListTagsOfResource' :: ListTagsOfResource -> Text
$sel:nextToken:ListTagsOfResource' :: ListTagsOfResource -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn

instance Prelude.NFData ListTagsOfResource where
  rnf :: ListTagsOfResource -> ()
rnf ListTagsOfResource' {Maybe Text
Text
resourceArn :: Text
nextToken :: Maybe Text
$sel:resourceArn:ListTagsOfResource' :: ListTagsOfResource -> Text
$sel:nextToken:ListTagsOfResource' :: ListTagsOfResource -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn

instance Data.ToHeaders ListTagsOfResource where
  toHeaders :: ListTagsOfResource -> 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
"DynamoDB_20120810.ListTagsOfResource" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListTagsOfResource where
  toJSON :: ListTagsOfResource -> Value
toJSON ListTagsOfResource' {Maybe Text
Text
resourceArn :: Text
nextToken :: Maybe Text
$sel:resourceArn:ListTagsOfResource' :: ListTagsOfResource -> Text
$sel:nextToken:ListTagsOfResource' :: ListTagsOfResource -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"NextToken" 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
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn)
          ]
      )

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

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

-- | /See:/ 'newListTagsOfResourceResponse' smart constructor.
data ListTagsOfResourceResponse = ListTagsOfResourceResponse'
  { -- | If this value is returned, there are additional results to be displayed.
    -- To retrieve them, call ListTagsOfResource again, with NextToken set to
    -- this value.
    ListTagsOfResourceResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The tags currently associated with the Amazon DynamoDB resource.
    ListTagsOfResourceResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    ListTagsOfResourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTagsOfResourceResponse -> ListTagsOfResourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTagsOfResourceResponse -> ListTagsOfResourceResponse -> Bool
$c/= :: ListTagsOfResourceResponse -> ListTagsOfResourceResponse -> Bool
== :: ListTagsOfResourceResponse -> ListTagsOfResourceResponse -> Bool
$c== :: ListTagsOfResourceResponse -> ListTagsOfResourceResponse -> Bool
Prelude.Eq, ReadPrec [ListTagsOfResourceResponse]
ReadPrec ListTagsOfResourceResponse
Int -> ReadS ListTagsOfResourceResponse
ReadS [ListTagsOfResourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTagsOfResourceResponse]
$creadListPrec :: ReadPrec [ListTagsOfResourceResponse]
readPrec :: ReadPrec ListTagsOfResourceResponse
$creadPrec :: ReadPrec ListTagsOfResourceResponse
readList :: ReadS [ListTagsOfResourceResponse]
$creadList :: ReadS [ListTagsOfResourceResponse]
readsPrec :: Int -> ReadS ListTagsOfResourceResponse
$creadsPrec :: Int -> ReadS ListTagsOfResourceResponse
Prelude.Read, Int -> ListTagsOfResourceResponse -> ShowS
[ListTagsOfResourceResponse] -> ShowS
ListTagsOfResourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTagsOfResourceResponse] -> ShowS
$cshowList :: [ListTagsOfResourceResponse] -> ShowS
show :: ListTagsOfResourceResponse -> String
$cshow :: ListTagsOfResourceResponse -> String
showsPrec :: Int -> ListTagsOfResourceResponse -> ShowS
$cshowsPrec :: Int -> ListTagsOfResourceResponse -> ShowS
Prelude.Show, forall x.
Rep ListTagsOfResourceResponse x -> ListTagsOfResourceResponse
forall x.
ListTagsOfResourceResponse -> Rep ListTagsOfResourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTagsOfResourceResponse x -> ListTagsOfResourceResponse
$cfrom :: forall x.
ListTagsOfResourceResponse -> Rep ListTagsOfResourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTagsOfResourceResponse' 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:
--
-- 'nextToken', 'listTagsOfResourceResponse_nextToken' - If this value is returned, there are additional results to be displayed.
-- To retrieve them, call ListTagsOfResource again, with NextToken set to
-- this value.
--
-- 'tags', 'listTagsOfResourceResponse_tags' - The tags currently associated with the Amazon DynamoDB resource.
--
-- 'httpStatus', 'listTagsOfResourceResponse_httpStatus' - The response's http status code.
newListTagsOfResourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTagsOfResourceResponse
newListTagsOfResourceResponse :: Int -> ListTagsOfResourceResponse
newListTagsOfResourceResponse Int
pHttpStatus_ =
  ListTagsOfResourceResponse'
    { $sel:nextToken:ListTagsOfResourceResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ListTagsOfResourceResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTagsOfResourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If this value is returned, there are additional results to be displayed.
-- To retrieve them, call ListTagsOfResource again, with NextToken set to
-- this value.
listTagsOfResourceResponse_nextToken :: Lens.Lens' ListTagsOfResourceResponse (Prelude.Maybe Prelude.Text)
listTagsOfResourceResponse_nextToken :: Lens' ListTagsOfResourceResponse (Maybe Text)
listTagsOfResourceResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsOfResourceResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTagsOfResourceResponse' :: ListTagsOfResourceResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTagsOfResourceResponse
s@ListTagsOfResourceResponse' {} Maybe Text
a -> ListTagsOfResourceResponse
s {$sel:nextToken:ListTagsOfResourceResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTagsOfResourceResponse)

-- | The tags currently associated with the Amazon DynamoDB resource.
listTagsOfResourceResponse_tags :: Lens.Lens' ListTagsOfResourceResponse (Prelude.Maybe [Tag])
listTagsOfResourceResponse_tags :: Lens' ListTagsOfResourceResponse (Maybe [Tag])
listTagsOfResourceResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTagsOfResourceResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ListTagsOfResourceResponse' :: ListTagsOfResourceResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ListTagsOfResourceResponse
s@ListTagsOfResourceResponse' {} Maybe [Tag]
a -> ListTagsOfResourceResponse
s {$sel:tags:ListTagsOfResourceResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ListTagsOfResourceResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData ListTagsOfResourceResponse where
  rnf :: ListTagsOfResourceResponse -> ()
rnf ListTagsOfResourceResponse' {Int
Maybe [Tag]
Maybe Text
httpStatus :: Int
tags :: Maybe [Tag]
nextToken :: Maybe Text
$sel:httpStatus:ListTagsOfResourceResponse' :: ListTagsOfResourceResponse -> Int
$sel:tags:ListTagsOfResourceResponse' :: ListTagsOfResourceResponse -> Maybe [Tag]
$sel:nextToken:ListTagsOfResourceResponse' :: ListTagsOfResourceResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus