{-# 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.ECR.GetDownloadUrlForLayer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the pre-signed Amazon S3 download URL corresponding to an
-- image layer. You can only get URLs for image layers that are referenced
-- in an image.
--
-- When an image is pulled, the GetDownloadUrlForLayer API is called once
-- per image layer that is not already cached.
--
-- This operation is used by the Amazon ECR proxy and is not generally used
-- by customers for pulling and pushing images. In most cases, you should
-- use the @docker@ CLI to pull, tag, and push images.
module Amazonka.ECR.GetDownloadUrlForLayer
  ( -- * Creating a Request
    GetDownloadUrlForLayer (..),
    newGetDownloadUrlForLayer,

    -- * Request Lenses
    getDownloadUrlForLayer_registryId,
    getDownloadUrlForLayer_repositoryName,
    getDownloadUrlForLayer_layerDigest,

    -- * Destructuring the Response
    GetDownloadUrlForLayerResponse (..),
    newGetDownloadUrlForLayerResponse,

    -- * Response Lenses
    getDownloadUrlForLayerResponse_downloadUrl,
    getDownloadUrlForLayerResponse_layerDigest,
    getDownloadUrlForLayerResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetDownloadUrlForLayer' smart constructor.
data GetDownloadUrlForLayer = GetDownloadUrlForLayer'
  { -- | The Amazon Web Services account ID associated with the registry that
    -- contains the image layer to download. If you do not specify a registry,
    -- the default registry is assumed.
    GetDownloadUrlForLayer -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository that is associated with the image layer to
    -- download.
    GetDownloadUrlForLayer -> Text
repositoryName :: Prelude.Text,
    -- | The digest of the image layer to download.
    GetDownloadUrlForLayer -> Text
layerDigest :: Prelude.Text
  }
  deriving (GetDownloadUrlForLayer -> GetDownloadUrlForLayer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDownloadUrlForLayer -> GetDownloadUrlForLayer -> Bool
$c/= :: GetDownloadUrlForLayer -> GetDownloadUrlForLayer -> Bool
== :: GetDownloadUrlForLayer -> GetDownloadUrlForLayer -> Bool
$c== :: GetDownloadUrlForLayer -> GetDownloadUrlForLayer -> Bool
Prelude.Eq, ReadPrec [GetDownloadUrlForLayer]
ReadPrec GetDownloadUrlForLayer
Int -> ReadS GetDownloadUrlForLayer
ReadS [GetDownloadUrlForLayer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDownloadUrlForLayer]
$creadListPrec :: ReadPrec [GetDownloadUrlForLayer]
readPrec :: ReadPrec GetDownloadUrlForLayer
$creadPrec :: ReadPrec GetDownloadUrlForLayer
readList :: ReadS [GetDownloadUrlForLayer]
$creadList :: ReadS [GetDownloadUrlForLayer]
readsPrec :: Int -> ReadS GetDownloadUrlForLayer
$creadsPrec :: Int -> ReadS GetDownloadUrlForLayer
Prelude.Read, Int -> GetDownloadUrlForLayer -> ShowS
[GetDownloadUrlForLayer] -> ShowS
GetDownloadUrlForLayer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDownloadUrlForLayer] -> ShowS
$cshowList :: [GetDownloadUrlForLayer] -> ShowS
show :: GetDownloadUrlForLayer -> String
$cshow :: GetDownloadUrlForLayer -> String
showsPrec :: Int -> GetDownloadUrlForLayer -> ShowS
$cshowsPrec :: Int -> GetDownloadUrlForLayer -> ShowS
Prelude.Show, forall x. Rep GetDownloadUrlForLayer x -> GetDownloadUrlForLayer
forall x. GetDownloadUrlForLayer -> Rep GetDownloadUrlForLayer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDownloadUrlForLayer x -> GetDownloadUrlForLayer
$cfrom :: forall x. GetDownloadUrlForLayer -> Rep GetDownloadUrlForLayer x
Prelude.Generic)

-- |
-- Create a value of 'GetDownloadUrlForLayer' 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:
--
-- 'registryId', 'getDownloadUrlForLayer_registryId' - The Amazon Web Services account ID associated with the registry that
-- contains the image layer to download. If you do not specify a registry,
-- the default registry is assumed.
--
-- 'repositoryName', 'getDownloadUrlForLayer_repositoryName' - The name of the repository that is associated with the image layer to
-- download.
--
-- 'layerDigest', 'getDownloadUrlForLayer_layerDigest' - The digest of the image layer to download.
newGetDownloadUrlForLayer ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'layerDigest'
  Prelude.Text ->
  GetDownloadUrlForLayer
newGetDownloadUrlForLayer :: Text -> Text -> GetDownloadUrlForLayer
newGetDownloadUrlForLayer
  Text
pRepositoryName_
  Text
pLayerDigest_ =
    GetDownloadUrlForLayer'
      { $sel:registryId:GetDownloadUrlForLayer' :: Maybe Text
registryId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:GetDownloadUrlForLayer' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:layerDigest:GetDownloadUrlForLayer' :: Text
layerDigest = Text
pLayerDigest_
      }

-- | The Amazon Web Services account ID associated with the registry that
-- contains the image layer to download. If you do not specify a registry,
-- the default registry is assumed.
getDownloadUrlForLayer_registryId :: Lens.Lens' GetDownloadUrlForLayer (Prelude.Maybe Prelude.Text)
getDownloadUrlForLayer_registryId :: Lens' GetDownloadUrlForLayer (Maybe Text)
getDownloadUrlForLayer_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDownloadUrlForLayer' {Maybe Text
registryId :: Maybe Text
$sel:registryId:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: GetDownloadUrlForLayer
s@GetDownloadUrlForLayer' {} Maybe Text
a -> GetDownloadUrlForLayer
s {$sel:registryId:GetDownloadUrlForLayer' :: Maybe Text
registryId = Maybe Text
a} :: GetDownloadUrlForLayer)

-- | The name of the repository that is associated with the image layer to
-- download.
getDownloadUrlForLayer_repositoryName :: Lens.Lens' GetDownloadUrlForLayer Prelude.Text
getDownloadUrlForLayer_repositoryName :: Lens' GetDownloadUrlForLayer Text
getDownloadUrlForLayer_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDownloadUrlForLayer' {Text
repositoryName :: Text
$sel:repositoryName:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
repositoryName} -> Text
repositoryName) (\s :: GetDownloadUrlForLayer
s@GetDownloadUrlForLayer' {} Text
a -> GetDownloadUrlForLayer
s {$sel:repositoryName:GetDownloadUrlForLayer' :: Text
repositoryName = Text
a} :: GetDownloadUrlForLayer)

-- | The digest of the image layer to download.
getDownloadUrlForLayer_layerDigest :: Lens.Lens' GetDownloadUrlForLayer Prelude.Text
getDownloadUrlForLayer_layerDigest :: Lens' GetDownloadUrlForLayer Text
getDownloadUrlForLayer_layerDigest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDownloadUrlForLayer' {Text
layerDigest :: Text
$sel:layerDigest:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
layerDigest} -> Text
layerDigest) (\s :: GetDownloadUrlForLayer
s@GetDownloadUrlForLayer' {} Text
a -> GetDownloadUrlForLayer
s {$sel:layerDigest:GetDownloadUrlForLayer' :: Text
layerDigest = Text
a} :: GetDownloadUrlForLayer)

instance Core.AWSRequest GetDownloadUrlForLayer where
  type
    AWSResponse GetDownloadUrlForLayer =
      GetDownloadUrlForLayerResponse
  request :: (Service -> Service)
-> GetDownloadUrlForLayer -> Request GetDownloadUrlForLayer
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 GetDownloadUrlForLayer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDownloadUrlForLayer)))
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 -> GetDownloadUrlForLayerResponse
GetDownloadUrlForLayerResponse'
            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
"downloadUrl")
            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
"layerDigest")
            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 GetDownloadUrlForLayer where
  hashWithSalt :: Int -> GetDownloadUrlForLayer -> Int
hashWithSalt Int
_salt GetDownloadUrlForLayer' {Maybe Text
Text
layerDigest :: Text
repositoryName :: Text
registryId :: Maybe Text
$sel:layerDigest:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
$sel:repositoryName:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
$sel:registryId:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
registryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
layerDigest

instance Prelude.NFData GetDownloadUrlForLayer where
  rnf :: GetDownloadUrlForLayer -> ()
rnf GetDownloadUrlForLayer' {Maybe Text
Text
layerDigest :: Text
repositoryName :: Text
registryId :: Maybe Text
$sel:layerDigest:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
$sel:repositoryName:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
$sel:registryId:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
layerDigest

instance Data.ToHeaders GetDownloadUrlForLayer where
  toHeaders :: GetDownloadUrlForLayer -> 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
"AmazonEC2ContainerRegistry_V20150921.GetDownloadUrlForLayer" ::
                          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 GetDownloadUrlForLayer where
  toJSON :: GetDownloadUrlForLayer -> Value
toJSON GetDownloadUrlForLayer' {Maybe Text
Text
layerDigest :: Text
repositoryName :: Text
registryId :: Maybe Text
$sel:layerDigest:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
$sel:repositoryName:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Text
$sel:registryId:GetDownloadUrlForLayer' :: GetDownloadUrlForLayer -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"registryId" 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
registryId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just (Key
"layerDigest" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
layerDigest)
          ]
      )

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

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

-- | /See:/ 'newGetDownloadUrlForLayerResponse' smart constructor.
data GetDownloadUrlForLayerResponse = GetDownloadUrlForLayerResponse'
  { -- | The pre-signed Amazon S3 download URL for the requested layer.
    GetDownloadUrlForLayerResponse -> Maybe Text
downloadUrl :: Prelude.Maybe Prelude.Text,
    -- | The digest of the image layer to download.
    GetDownloadUrlForLayerResponse -> Maybe Text
layerDigest :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDownloadUrlForLayerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDownloadUrlForLayerResponse
-> GetDownloadUrlForLayerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDownloadUrlForLayerResponse
-> GetDownloadUrlForLayerResponse -> Bool
$c/= :: GetDownloadUrlForLayerResponse
-> GetDownloadUrlForLayerResponse -> Bool
== :: GetDownloadUrlForLayerResponse
-> GetDownloadUrlForLayerResponse -> Bool
$c== :: GetDownloadUrlForLayerResponse
-> GetDownloadUrlForLayerResponse -> Bool
Prelude.Eq, ReadPrec [GetDownloadUrlForLayerResponse]
ReadPrec GetDownloadUrlForLayerResponse
Int -> ReadS GetDownloadUrlForLayerResponse
ReadS [GetDownloadUrlForLayerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDownloadUrlForLayerResponse]
$creadListPrec :: ReadPrec [GetDownloadUrlForLayerResponse]
readPrec :: ReadPrec GetDownloadUrlForLayerResponse
$creadPrec :: ReadPrec GetDownloadUrlForLayerResponse
readList :: ReadS [GetDownloadUrlForLayerResponse]
$creadList :: ReadS [GetDownloadUrlForLayerResponse]
readsPrec :: Int -> ReadS GetDownloadUrlForLayerResponse
$creadsPrec :: Int -> ReadS GetDownloadUrlForLayerResponse
Prelude.Read, Int -> GetDownloadUrlForLayerResponse -> ShowS
[GetDownloadUrlForLayerResponse] -> ShowS
GetDownloadUrlForLayerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDownloadUrlForLayerResponse] -> ShowS
$cshowList :: [GetDownloadUrlForLayerResponse] -> ShowS
show :: GetDownloadUrlForLayerResponse -> String
$cshow :: GetDownloadUrlForLayerResponse -> String
showsPrec :: Int -> GetDownloadUrlForLayerResponse -> ShowS
$cshowsPrec :: Int -> GetDownloadUrlForLayerResponse -> ShowS
Prelude.Show, forall x.
Rep GetDownloadUrlForLayerResponse x
-> GetDownloadUrlForLayerResponse
forall x.
GetDownloadUrlForLayerResponse
-> Rep GetDownloadUrlForLayerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDownloadUrlForLayerResponse x
-> GetDownloadUrlForLayerResponse
$cfrom :: forall x.
GetDownloadUrlForLayerResponse
-> Rep GetDownloadUrlForLayerResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDownloadUrlForLayerResponse' 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:
--
-- 'downloadUrl', 'getDownloadUrlForLayerResponse_downloadUrl' - The pre-signed Amazon S3 download URL for the requested layer.
--
-- 'layerDigest', 'getDownloadUrlForLayerResponse_layerDigest' - The digest of the image layer to download.
--
-- 'httpStatus', 'getDownloadUrlForLayerResponse_httpStatus' - The response's http status code.
newGetDownloadUrlForLayerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDownloadUrlForLayerResponse
newGetDownloadUrlForLayerResponse :: Int -> GetDownloadUrlForLayerResponse
newGetDownloadUrlForLayerResponse Int
pHttpStatus_ =
  GetDownloadUrlForLayerResponse'
    { $sel:downloadUrl:GetDownloadUrlForLayerResponse' :: Maybe Text
downloadUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:layerDigest:GetDownloadUrlForLayerResponse' :: Maybe Text
layerDigest = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDownloadUrlForLayerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The pre-signed Amazon S3 download URL for the requested layer.
getDownloadUrlForLayerResponse_downloadUrl :: Lens.Lens' GetDownloadUrlForLayerResponse (Prelude.Maybe Prelude.Text)
getDownloadUrlForLayerResponse_downloadUrl :: Lens' GetDownloadUrlForLayerResponse (Maybe Text)
getDownloadUrlForLayerResponse_downloadUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDownloadUrlForLayerResponse' {Maybe Text
downloadUrl :: Maybe Text
$sel:downloadUrl:GetDownloadUrlForLayerResponse' :: GetDownloadUrlForLayerResponse -> Maybe Text
downloadUrl} -> Maybe Text
downloadUrl) (\s :: GetDownloadUrlForLayerResponse
s@GetDownloadUrlForLayerResponse' {} Maybe Text
a -> GetDownloadUrlForLayerResponse
s {$sel:downloadUrl:GetDownloadUrlForLayerResponse' :: Maybe Text
downloadUrl = Maybe Text
a} :: GetDownloadUrlForLayerResponse)

-- | The digest of the image layer to download.
getDownloadUrlForLayerResponse_layerDigest :: Lens.Lens' GetDownloadUrlForLayerResponse (Prelude.Maybe Prelude.Text)
getDownloadUrlForLayerResponse_layerDigest :: Lens' GetDownloadUrlForLayerResponse (Maybe Text)
getDownloadUrlForLayerResponse_layerDigest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDownloadUrlForLayerResponse' {Maybe Text
layerDigest :: Maybe Text
$sel:layerDigest:GetDownloadUrlForLayerResponse' :: GetDownloadUrlForLayerResponse -> Maybe Text
layerDigest} -> Maybe Text
layerDigest) (\s :: GetDownloadUrlForLayerResponse
s@GetDownloadUrlForLayerResponse' {} Maybe Text
a -> GetDownloadUrlForLayerResponse
s {$sel:layerDigest:GetDownloadUrlForLayerResponse' :: Maybe Text
layerDigest = Maybe Text
a} :: GetDownloadUrlForLayerResponse)

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

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