{-# 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.CodeArtifact.GetAuthorizationToken
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Generates a temporary authorization token for accessing repositories in
-- the domain. This API requires the @codeartifact:GetAuthorizationToken@
-- and @sts:GetServiceBearerToken@ permissions. For more information about
-- authorization tokens, see
-- <https://docs.aws.amazon.com/codeartifact/latest/ug/tokens-authentication.html CodeArtifact authentication and tokens>.
--
-- CodeArtifact authorization tokens are valid for a period of 12 hours
-- when created with the @login@ command. You can call @login@ periodically
-- to refresh the token. When you create an authorization token with the
-- @GetAuthorizationToken@ API, you can set a custom authorization period,
-- up to a maximum of 12 hours, with the @durationSeconds@ parameter.
--
-- The authorization period begins after @login@ or @GetAuthorizationToken@
-- is called. If @login@ or @GetAuthorizationToken@ is called while
-- assuming a role, the token lifetime is independent of the maximum
-- session duration of the role. For example, if you call @sts assume-role@
-- and specify a session duration of 15 minutes, then generate a
-- CodeArtifact authorization token, the token will be valid for the full
-- authorization period even though this is longer than the 15-minute
-- session duration.
--
-- See
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_use.html Using IAM Roles>
-- for more information on controlling session duration.
module Amazonka.CodeArtifact.GetAuthorizationToken
  ( -- * Creating a Request
    GetAuthorizationToken (..),
    newGetAuthorizationToken,

    -- * Request Lenses
    getAuthorizationToken_domainOwner,
    getAuthorizationToken_durationSeconds,
    getAuthorizationToken_domain,

    -- * Destructuring the Response
    GetAuthorizationTokenResponse (..),
    newGetAuthorizationTokenResponse,

    -- * Response Lenses
    getAuthorizationTokenResponse_authorizationToken,
    getAuthorizationTokenResponse_expiration,
    getAuthorizationTokenResponse_httpStatus,
  )
where

import Amazonka.CodeArtifact.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

-- | /See:/ 'newGetAuthorizationToken' smart constructor.
data GetAuthorizationToken = GetAuthorizationToken'
  { -- | The 12-digit account number of the Amazon Web Services account that owns
    -- the domain. It does not include dashes or spaces.
    GetAuthorizationToken -> Maybe Text
domainOwner :: Prelude.Maybe Prelude.Text,
    -- | The time, in seconds, that the generated authorization token is valid.
    -- Valid values are @0@ and any number between @900@ (15 minutes) and
    -- @43200@ (12 hours). A value of @0@ will set the expiration of the
    -- authorization token to the same expiration of the user\'s role\'s
    -- temporary credentials.
    GetAuthorizationToken -> Maybe Natural
durationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The name of the domain that is in scope for the generated authorization
    -- token.
    GetAuthorizationToken -> Text
domain :: Prelude.Text
  }
  deriving (GetAuthorizationToken -> GetAuthorizationToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAuthorizationToken -> GetAuthorizationToken -> Bool
$c/= :: GetAuthorizationToken -> GetAuthorizationToken -> Bool
== :: GetAuthorizationToken -> GetAuthorizationToken -> Bool
$c== :: GetAuthorizationToken -> GetAuthorizationToken -> Bool
Prelude.Eq, ReadPrec [GetAuthorizationToken]
ReadPrec GetAuthorizationToken
Int -> ReadS GetAuthorizationToken
ReadS [GetAuthorizationToken]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAuthorizationToken]
$creadListPrec :: ReadPrec [GetAuthorizationToken]
readPrec :: ReadPrec GetAuthorizationToken
$creadPrec :: ReadPrec GetAuthorizationToken
readList :: ReadS [GetAuthorizationToken]
$creadList :: ReadS [GetAuthorizationToken]
readsPrec :: Int -> ReadS GetAuthorizationToken
$creadsPrec :: Int -> ReadS GetAuthorizationToken
Prelude.Read, Int -> GetAuthorizationToken -> ShowS
[GetAuthorizationToken] -> ShowS
GetAuthorizationToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAuthorizationToken] -> ShowS
$cshowList :: [GetAuthorizationToken] -> ShowS
show :: GetAuthorizationToken -> String
$cshow :: GetAuthorizationToken -> String
showsPrec :: Int -> GetAuthorizationToken -> ShowS
$cshowsPrec :: Int -> GetAuthorizationToken -> ShowS
Prelude.Show, forall x. Rep GetAuthorizationToken x -> GetAuthorizationToken
forall x. GetAuthorizationToken -> Rep GetAuthorizationToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAuthorizationToken x -> GetAuthorizationToken
$cfrom :: forall x. GetAuthorizationToken -> Rep GetAuthorizationToken x
Prelude.Generic)

-- |
-- Create a value of 'GetAuthorizationToken' 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:
--
-- 'domainOwner', 'getAuthorizationToken_domainOwner' - The 12-digit account number of the Amazon Web Services account that owns
-- the domain. It does not include dashes or spaces.
--
-- 'durationSeconds', 'getAuthorizationToken_durationSeconds' - The time, in seconds, that the generated authorization token is valid.
-- Valid values are @0@ and any number between @900@ (15 minutes) and
-- @43200@ (12 hours). A value of @0@ will set the expiration of the
-- authorization token to the same expiration of the user\'s role\'s
-- temporary credentials.
--
-- 'domain', 'getAuthorizationToken_domain' - The name of the domain that is in scope for the generated authorization
-- token.
newGetAuthorizationToken ::
  -- | 'domain'
  Prelude.Text ->
  GetAuthorizationToken
newGetAuthorizationToken :: Text -> GetAuthorizationToken
newGetAuthorizationToken Text
pDomain_ =
  GetAuthorizationToken'
    { $sel:domainOwner:GetAuthorizationToken' :: Maybe Text
domainOwner =
        forall a. Maybe a
Prelude.Nothing,
      $sel:durationSeconds:GetAuthorizationToken' :: Maybe Natural
durationSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:GetAuthorizationToken' :: Text
domain = Text
pDomain_
    }

-- | The 12-digit account number of the Amazon Web Services account that owns
-- the domain. It does not include dashes or spaces.
getAuthorizationToken_domainOwner :: Lens.Lens' GetAuthorizationToken (Prelude.Maybe Prelude.Text)
getAuthorizationToken_domainOwner :: Lens' GetAuthorizationToken (Maybe Text)
getAuthorizationToken_domainOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAuthorizationToken' {Maybe Text
domainOwner :: Maybe Text
$sel:domainOwner:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Text
domainOwner} -> Maybe Text
domainOwner) (\s :: GetAuthorizationToken
s@GetAuthorizationToken' {} Maybe Text
a -> GetAuthorizationToken
s {$sel:domainOwner:GetAuthorizationToken' :: Maybe Text
domainOwner = Maybe Text
a} :: GetAuthorizationToken)

-- | The time, in seconds, that the generated authorization token is valid.
-- Valid values are @0@ and any number between @900@ (15 minutes) and
-- @43200@ (12 hours). A value of @0@ will set the expiration of the
-- authorization token to the same expiration of the user\'s role\'s
-- temporary credentials.
getAuthorizationToken_durationSeconds :: Lens.Lens' GetAuthorizationToken (Prelude.Maybe Prelude.Natural)
getAuthorizationToken_durationSeconds :: Lens' GetAuthorizationToken (Maybe Natural)
getAuthorizationToken_durationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAuthorizationToken' {Maybe Natural
durationSeconds :: Maybe Natural
$sel:durationSeconds:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Natural
durationSeconds} -> Maybe Natural
durationSeconds) (\s :: GetAuthorizationToken
s@GetAuthorizationToken' {} Maybe Natural
a -> GetAuthorizationToken
s {$sel:durationSeconds:GetAuthorizationToken' :: Maybe Natural
durationSeconds = Maybe Natural
a} :: GetAuthorizationToken)

-- | The name of the domain that is in scope for the generated authorization
-- token.
getAuthorizationToken_domain :: Lens.Lens' GetAuthorizationToken Prelude.Text
getAuthorizationToken_domain :: Lens' GetAuthorizationToken Text
getAuthorizationToken_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAuthorizationToken' {Text
domain :: Text
$sel:domain:GetAuthorizationToken' :: GetAuthorizationToken -> Text
domain} -> Text
domain) (\s :: GetAuthorizationToken
s@GetAuthorizationToken' {} Text
a -> GetAuthorizationToken
s {$sel:domain:GetAuthorizationToken' :: Text
domain = Text
a} :: GetAuthorizationToken)

instance Core.AWSRequest GetAuthorizationToken where
  type
    AWSResponse GetAuthorizationToken =
      GetAuthorizationTokenResponse
  request :: (Service -> Service)
-> GetAuthorizationToken -> Request GetAuthorizationToken
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 GetAuthorizationToken
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetAuthorizationToken)))
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 POSIX -> Int -> GetAuthorizationTokenResponse
GetAuthorizationTokenResponse'
            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
"authorizationToken")
            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
"expiration")
            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 GetAuthorizationToken where
  hashWithSalt :: Int -> GetAuthorizationToken -> Int
hashWithSalt Int
_salt GetAuthorizationToken' {Maybe Natural
Maybe Text
Text
domain :: Text
durationSeconds :: Maybe Natural
domainOwner :: Maybe Text
$sel:domain:GetAuthorizationToken' :: GetAuthorizationToken -> Text
$sel:durationSeconds:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Natural
$sel:domainOwner:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domainOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
durationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domain

instance Prelude.NFData GetAuthorizationToken where
  rnf :: GetAuthorizationToken -> ()
rnf GetAuthorizationToken' {Maybe Natural
Maybe Text
Text
domain :: Text
durationSeconds :: Maybe Natural
domainOwner :: Maybe Text
$sel:domain:GetAuthorizationToken' :: GetAuthorizationToken -> Text
$sel:durationSeconds:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Natural
$sel:domainOwner:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
durationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domain

instance Data.ToHeaders GetAuthorizationToken where
  toHeaders :: GetAuthorizationToken -> 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 GetAuthorizationToken where
  toJSON :: GetAuthorizationToken -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath GetAuthorizationToken where
  toPath :: GetAuthorizationToken -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/authorization-token"

instance Data.ToQuery GetAuthorizationToken where
  toQuery :: GetAuthorizationToken -> QueryString
toQuery GetAuthorizationToken' {Maybe Natural
Maybe Text
Text
domain :: Text
durationSeconds :: Maybe Natural
domainOwner :: Maybe Text
$sel:domain:GetAuthorizationToken' :: GetAuthorizationToken -> Text
$sel:durationSeconds:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Natural
$sel:domainOwner:GetAuthorizationToken' :: GetAuthorizationToken -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"domain-owner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
domainOwner,
        ByteString
"duration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
durationSeconds,
        ByteString
"domain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domain
      ]

-- | /See:/ 'newGetAuthorizationTokenResponse' smart constructor.
data GetAuthorizationTokenResponse = GetAuthorizationTokenResponse'
  { -- | The returned authentication token.
    GetAuthorizationTokenResponse -> Maybe Text
authorizationToken :: Prelude.Maybe Prelude.Text,
    -- | A timestamp that specifies the date and time the authorization token
    -- expires.
    GetAuthorizationTokenResponse -> Maybe POSIX
expiration :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    GetAuthorizationTokenResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetAuthorizationTokenResponse
-> GetAuthorizationTokenResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAuthorizationTokenResponse
-> GetAuthorizationTokenResponse -> Bool
$c/= :: GetAuthorizationTokenResponse
-> GetAuthorizationTokenResponse -> Bool
== :: GetAuthorizationTokenResponse
-> GetAuthorizationTokenResponse -> Bool
$c== :: GetAuthorizationTokenResponse
-> GetAuthorizationTokenResponse -> Bool
Prelude.Eq, ReadPrec [GetAuthorizationTokenResponse]
ReadPrec GetAuthorizationTokenResponse
Int -> ReadS GetAuthorizationTokenResponse
ReadS [GetAuthorizationTokenResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAuthorizationTokenResponse]
$creadListPrec :: ReadPrec [GetAuthorizationTokenResponse]
readPrec :: ReadPrec GetAuthorizationTokenResponse
$creadPrec :: ReadPrec GetAuthorizationTokenResponse
readList :: ReadS [GetAuthorizationTokenResponse]
$creadList :: ReadS [GetAuthorizationTokenResponse]
readsPrec :: Int -> ReadS GetAuthorizationTokenResponse
$creadsPrec :: Int -> ReadS GetAuthorizationTokenResponse
Prelude.Read, Int -> GetAuthorizationTokenResponse -> ShowS
[GetAuthorizationTokenResponse] -> ShowS
GetAuthorizationTokenResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAuthorizationTokenResponse] -> ShowS
$cshowList :: [GetAuthorizationTokenResponse] -> ShowS
show :: GetAuthorizationTokenResponse -> String
$cshow :: GetAuthorizationTokenResponse -> String
showsPrec :: Int -> GetAuthorizationTokenResponse -> ShowS
$cshowsPrec :: Int -> GetAuthorizationTokenResponse -> ShowS
Prelude.Show, forall x.
Rep GetAuthorizationTokenResponse x
-> GetAuthorizationTokenResponse
forall x.
GetAuthorizationTokenResponse
-> Rep GetAuthorizationTokenResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAuthorizationTokenResponse x
-> GetAuthorizationTokenResponse
$cfrom :: forall x.
GetAuthorizationTokenResponse
-> Rep GetAuthorizationTokenResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAuthorizationTokenResponse' 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:
--
-- 'authorizationToken', 'getAuthorizationTokenResponse_authorizationToken' - The returned authentication token.
--
-- 'expiration', 'getAuthorizationTokenResponse_expiration' - A timestamp that specifies the date and time the authorization token
-- expires.
--
-- 'httpStatus', 'getAuthorizationTokenResponse_httpStatus' - The response's http status code.
newGetAuthorizationTokenResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAuthorizationTokenResponse
newGetAuthorizationTokenResponse :: Int -> GetAuthorizationTokenResponse
newGetAuthorizationTokenResponse Int
pHttpStatus_ =
  GetAuthorizationTokenResponse'
    { $sel:authorizationToken:GetAuthorizationTokenResponse' :: Maybe Text
authorizationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:expiration:GetAuthorizationTokenResponse' :: Maybe POSIX
expiration = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAuthorizationTokenResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The returned authentication token.
getAuthorizationTokenResponse_authorizationToken :: Lens.Lens' GetAuthorizationTokenResponse (Prelude.Maybe Prelude.Text)
getAuthorizationTokenResponse_authorizationToken :: Lens' GetAuthorizationTokenResponse (Maybe Text)
getAuthorizationTokenResponse_authorizationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAuthorizationTokenResponse' {Maybe Text
authorizationToken :: Maybe Text
$sel:authorizationToken:GetAuthorizationTokenResponse' :: GetAuthorizationTokenResponse -> Maybe Text
authorizationToken} -> Maybe Text
authorizationToken) (\s :: GetAuthorizationTokenResponse
s@GetAuthorizationTokenResponse' {} Maybe Text
a -> GetAuthorizationTokenResponse
s {$sel:authorizationToken:GetAuthorizationTokenResponse' :: Maybe Text
authorizationToken = Maybe Text
a} :: GetAuthorizationTokenResponse)

-- | A timestamp that specifies the date and time the authorization token
-- expires.
getAuthorizationTokenResponse_expiration :: Lens.Lens' GetAuthorizationTokenResponse (Prelude.Maybe Prelude.UTCTime)
getAuthorizationTokenResponse_expiration :: Lens' GetAuthorizationTokenResponse (Maybe UTCTime)
getAuthorizationTokenResponse_expiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAuthorizationTokenResponse' {Maybe POSIX
expiration :: Maybe POSIX
$sel:expiration:GetAuthorizationTokenResponse' :: GetAuthorizationTokenResponse -> Maybe POSIX
expiration} -> Maybe POSIX
expiration) (\s :: GetAuthorizationTokenResponse
s@GetAuthorizationTokenResponse' {} Maybe POSIX
a -> GetAuthorizationTokenResponse
s {$sel:expiration:GetAuthorizationTokenResponse' :: Maybe POSIX
expiration = Maybe POSIX
a} :: GetAuthorizationTokenResponse) 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.
getAuthorizationTokenResponse_httpStatus :: Lens.Lens' GetAuthorizationTokenResponse Prelude.Int
getAuthorizationTokenResponse_httpStatus :: Lens' GetAuthorizationTokenResponse Int
getAuthorizationTokenResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAuthorizationTokenResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetAuthorizationTokenResponse' :: GetAuthorizationTokenResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetAuthorizationTokenResponse
s@GetAuthorizationTokenResponse' {} Int
a -> GetAuthorizationTokenResponse
s {$sel:httpStatus:GetAuthorizationTokenResponse' :: Int
httpStatus = Int
a} :: GetAuthorizationTokenResponse)

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