{-# 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.InitiateLayerUpload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Notifies Amazon ECR that you intend to upload an image layer.
--
-- When an image is pushed, the InitiateLayerUpload API is called once per
-- image layer that has not already been uploaded. Whether or not an image
-- layer has been uploaded is determined by the BatchCheckLayerAvailability
-- API action.
--
-- 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.InitiateLayerUpload
  ( -- * Creating a Request
    InitiateLayerUpload (..),
    newInitiateLayerUpload,

    -- * Request Lenses
    initiateLayerUpload_registryId,
    initiateLayerUpload_repositoryName,

    -- * Destructuring the Response
    InitiateLayerUploadResponse (..),
    newInitiateLayerUploadResponse,

    -- * Response Lenses
    initiateLayerUploadResponse_partSize,
    initiateLayerUploadResponse_uploadId,
    initiateLayerUploadResponse_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:/ 'newInitiateLayerUpload' smart constructor.
data InitiateLayerUpload = InitiateLayerUpload'
  { -- | The Amazon Web Services account ID associated with the registry to which
    -- you intend to upload layers. If you do not specify a registry, the
    -- default registry is assumed.
    InitiateLayerUpload -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository to which you intend to upload layers.
    InitiateLayerUpload -> Text
repositoryName :: Prelude.Text
  }
  deriving (InitiateLayerUpload -> InitiateLayerUpload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitiateLayerUpload -> InitiateLayerUpload -> Bool
$c/= :: InitiateLayerUpload -> InitiateLayerUpload -> Bool
== :: InitiateLayerUpload -> InitiateLayerUpload -> Bool
$c== :: InitiateLayerUpload -> InitiateLayerUpload -> Bool
Prelude.Eq, ReadPrec [InitiateLayerUpload]
ReadPrec InitiateLayerUpload
Int -> ReadS InitiateLayerUpload
ReadS [InitiateLayerUpload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitiateLayerUpload]
$creadListPrec :: ReadPrec [InitiateLayerUpload]
readPrec :: ReadPrec InitiateLayerUpload
$creadPrec :: ReadPrec InitiateLayerUpload
readList :: ReadS [InitiateLayerUpload]
$creadList :: ReadS [InitiateLayerUpload]
readsPrec :: Int -> ReadS InitiateLayerUpload
$creadsPrec :: Int -> ReadS InitiateLayerUpload
Prelude.Read, Int -> InitiateLayerUpload -> ShowS
[InitiateLayerUpload] -> ShowS
InitiateLayerUpload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitiateLayerUpload] -> ShowS
$cshowList :: [InitiateLayerUpload] -> ShowS
show :: InitiateLayerUpload -> String
$cshow :: InitiateLayerUpload -> String
showsPrec :: Int -> InitiateLayerUpload -> ShowS
$cshowsPrec :: Int -> InitiateLayerUpload -> ShowS
Prelude.Show, forall x. Rep InitiateLayerUpload x -> InitiateLayerUpload
forall x. InitiateLayerUpload -> Rep InitiateLayerUpload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitiateLayerUpload x -> InitiateLayerUpload
$cfrom :: forall x. InitiateLayerUpload -> Rep InitiateLayerUpload x
Prelude.Generic)

-- |
-- Create a value of 'InitiateLayerUpload' 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', 'initiateLayerUpload_registryId' - The Amazon Web Services account ID associated with the registry to which
-- you intend to upload layers. If you do not specify a registry, the
-- default registry is assumed.
--
-- 'repositoryName', 'initiateLayerUpload_repositoryName' - The name of the repository to which you intend to upload layers.
newInitiateLayerUpload ::
  -- | 'repositoryName'
  Prelude.Text ->
  InitiateLayerUpload
newInitiateLayerUpload :: Text -> InitiateLayerUpload
newInitiateLayerUpload Text
pRepositoryName_ =
  InitiateLayerUpload'
    { $sel:registryId:InitiateLayerUpload' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:InitiateLayerUpload' :: Text
repositoryName = Text
pRepositoryName_
    }

-- | The Amazon Web Services account ID associated with the registry to which
-- you intend to upload layers. If you do not specify a registry, the
-- default registry is assumed.
initiateLayerUpload_registryId :: Lens.Lens' InitiateLayerUpload (Prelude.Maybe Prelude.Text)
initiateLayerUpload_registryId :: Lens' InitiateLayerUpload (Maybe Text)
initiateLayerUpload_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateLayerUpload' {Maybe Text
registryId :: Maybe Text
$sel:registryId:InitiateLayerUpload' :: InitiateLayerUpload -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: InitiateLayerUpload
s@InitiateLayerUpload' {} Maybe Text
a -> InitiateLayerUpload
s {$sel:registryId:InitiateLayerUpload' :: Maybe Text
registryId = Maybe Text
a} :: InitiateLayerUpload)

-- | The name of the repository to which you intend to upload layers.
initiateLayerUpload_repositoryName :: Lens.Lens' InitiateLayerUpload Prelude.Text
initiateLayerUpload_repositoryName :: Lens' InitiateLayerUpload Text
initiateLayerUpload_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateLayerUpload' {Text
repositoryName :: Text
$sel:repositoryName:InitiateLayerUpload' :: InitiateLayerUpload -> Text
repositoryName} -> Text
repositoryName) (\s :: InitiateLayerUpload
s@InitiateLayerUpload' {} Text
a -> InitiateLayerUpload
s {$sel:repositoryName:InitiateLayerUpload' :: Text
repositoryName = Text
a} :: InitiateLayerUpload)

instance Core.AWSRequest InitiateLayerUpload where
  type
    AWSResponse InitiateLayerUpload =
      InitiateLayerUploadResponse
  request :: (Service -> Service)
-> InitiateLayerUpload -> Request InitiateLayerUpload
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 InitiateLayerUpload
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse InitiateLayerUpload)))
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 Natural -> Maybe Text -> Int -> InitiateLayerUploadResponse
InitiateLayerUploadResponse'
            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
"partSize")
            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
"uploadId")
            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 InitiateLayerUpload where
  hashWithSalt :: Int -> InitiateLayerUpload -> Int
hashWithSalt Int
_salt InitiateLayerUpload' {Maybe Text
Text
repositoryName :: Text
registryId :: Maybe Text
$sel:repositoryName:InitiateLayerUpload' :: InitiateLayerUpload -> Text
$sel:registryId:InitiateLayerUpload' :: InitiateLayerUpload -> 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

instance Prelude.NFData InitiateLayerUpload where
  rnf :: InitiateLayerUpload -> ()
rnf InitiateLayerUpload' {Maybe Text
Text
repositoryName :: Text
registryId :: Maybe Text
$sel:repositoryName:InitiateLayerUpload' :: InitiateLayerUpload -> Text
$sel:registryId:InitiateLayerUpload' :: InitiateLayerUpload -> 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

instance Data.ToHeaders InitiateLayerUpload where
  toHeaders :: InitiateLayerUpload -> 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.InitiateLayerUpload" ::
                          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 InitiateLayerUpload where
  toJSON :: InitiateLayerUpload -> Value
toJSON InitiateLayerUpload' {Maybe Text
Text
repositoryName :: Text
registryId :: Maybe Text
$sel:repositoryName:InitiateLayerUpload' :: InitiateLayerUpload -> Text
$sel:registryId:InitiateLayerUpload' :: InitiateLayerUpload -> 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)
          ]
      )

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

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

-- | /See:/ 'newInitiateLayerUploadResponse' smart constructor.
data InitiateLayerUploadResponse = InitiateLayerUploadResponse'
  { -- | The size, in bytes, that Amazon ECR expects future layer part uploads to
    -- be.
    InitiateLayerUploadResponse -> Maybe Natural
partSize :: Prelude.Maybe Prelude.Natural,
    -- | The upload ID for the layer upload. This parameter is passed to further
    -- UploadLayerPart and CompleteLayerUpload operations.
    InitiateLayerUploadResponse -> Maybe Text
uploadId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    InitiateLayerUploadResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (InitiateLayerUploadResponse -> InitiateLayerUploadResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitiateLayerUploadResponse -> InitiateLayerUploadResponse -> Bool
$c/= :: InitiateLayerUploadResponse -> InitiateLayerUploadResponse -> Bool
== :: InitiateLayerUploadResponse -> InitiateLayerUploadResponse -> Bool
$c== :: InitiateLayerUploadResponse -> InitiateLayerUploadResponse -> Bool
Prelude.Eq, ReadPrec [InitiateLayerUploadResponse]
ReadPrec InitiateLayerUploadResponse
Int -> ReadS InitiateLayerUploadResponse
ReadS [InitiateLayerUploadResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitiateLayerUploadResponse]
$creadListPrec :: ReadPrec [InitiateLayerUploadResponse]
readPrec :: ReadPrec InitiateLayerUploadResponse
$creadPrec :: ReadPrec InitiateLayerUploadResponse
readList :: ReadS [InitiateLayerUploadResponse]
$creadList :: ReadS [InitiateLayerUploadResponse]
readsPrec :: Int -> ReadS InitiateLayerUploadResponse
$creadsPrec :: Int -> ReadS InitiateLayerUploadResponse
Prelude.Read, Int -> InitiateLayerUploadResponse -> ShowS
[InitiateLayerUploadResponse] -> ShowS
InitiateLayerUploadResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitiateLayerUploadResponse] -> ShowS
$cshowList :: [InitiateLayerUploadResponse] -> ShowS
show :: InitiateLayerUploadResponse -> String
$cshow :: InitiateLayerUploadResponse -> String
showsPrec :: Int -> InitiateLayerUploadResponse -> ShowS
$cshowsPrec :: Int -> InitiateLayerUploadResponse -> ShowS
Prelude.Show, forall x.
Rep InitiateLayerUploadResponse x -> InitiateLayerUploadResponse
forall x.
InitiateLayerUploadResponse -> Rep InitiateLayerUploadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InitiateLayerUploadResponse x -> InitiateLayerUploadResponse
$cfrom :: forall x.
InitiateLayerUploadResponse -> Rep InitiateLayerUploadResponse x
Prelude.Generic)

-- |
-- Create a value of 'InitiateLayerUploadResponse' 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:
--
-- 'partSize', 'initiateLayerUploadResponse_partSize' - The size, in bytes, that Amazon ECR expects future layer part uploads to
-- be.
--
-- 'uploadId', 'initiateLayerUploadResponse_uploadId' - The upload ID for the layer upload. This parameter is passed to further
-- UploadLayerPart and CompleteLayerUpload operations.
--
-- 'httpStatus', 'initiateLayerUploadResponse_httpStatus' - The response's http status code.
newInitiateLayerUploadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  InitiateLayerUploadResponse
newInitiateLayerUploadResponse :: Int -> InitiateLayerUploadResponse
newInitiateLayerUploadResponse Int
pHttpStatus_ =
  InitiateLayerUploadResponse'
    { $sel:partSize:InitiateLayerUploadResponse' :: Maybe Natural
partSize =
        forall a. Maybe a
Prelude.Nothing,
      $sel:uploadId:InitiateLayerUploadResponse' :: Maybe Text
uploadId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:InitiateLayerUploadResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The size, in bytes, that Amazon ECR expects future layer part uploads to
-- be.
initiateLayerUploadResponse_partSize :: Lens.Lens' InitiateLayerUploadResponse (Prelude.Maybe Prelude.Natural)
initiateLayerUploadResponse_partSize :: Lens' InitiateLayerUploadResponse (Maybe Natural)
initiateLayerUploadResponse_partSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateLayerUploadResponse' {Maybe Natural
partSize :: Maybe Natural
$sel:partSize:InitiateLayerUploadResponse' :: InitiateLayerUploadResponse -> Maybe Natural
partSize} -> Maybe Natural
partSize) (\s :: InitiateLayerUploadResponse
s@InitiateLayerUploadResponse' {} Maybe Natural
a -> InitiateLayerUploadResponse
s {$sel:partSize:InitiateLayerUploadResponse' :: Maybe Natural
partSize = Maybe Natural
a} :: InitiateLayerUploadResponse)

-- | The upload ID for the layer upload. This parameter is passed to further
-- UploadLayerPart and CompleteLayerUpload operations.
initiateLayerUploadResponse_uploadId :: Lens.Lens' InitiateLayerUploadResponse (Prelude.Maybe Prelude.Text)
initiateLayerUploadResponse_uploadId :: Lens' InitiateLayerUploadResponse (Maybe Text)
initiateLayerUploadResponse_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateLayerUploadResponse' {Maybe Text
uploadId :: Maybe Text
$sel:uploadId:InitiateLayerUploadResponse' :: InitiateLayerUploadResponse -> Maybe Text
uploadId} -> Maybe Text
uploadId) (\s :: InitiateLayerUploadResponse
s@InitiateLayerUploadResponse' {} Maybe Text
a -> InitiateLayerUploadResponse
s {$sel:uploadId:InitiateLayerUploadResponse' :: Maybe Text
uploadId = Maybe Text
a} :: InitiateLayerUploadResponse)

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

instance Prelude.NFData InitiateLayerUploadResponse where
  rnf :: InitiateLayerUploadResponse -> ()
rnf InitiateLayerUploadResponse' {Int
Maybe Natural
Maybe Text
httpStatus :: Int
uploadId :: Maybe Text
partSize :: Maybe Natural
$sel:httpStatus:InitiateLayerUploadResponse' :: InitiateLayerUploadResponse -> Int
$sel:uploadId:InitiateLayerUploadResponse' :: InitiateLayerUploadResponse -> Maybe Text
$sel:partSize:InitiateLayerUploadResponse' :: InitiateLayerUploadResponse -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
partSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uploadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus