{-# 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.CodeCommit.GetBlob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the base-64 encoded content of an individual blob in a
-- repository.
module Amazonka.CodeCommit.GetBlob
  ( -- * Creating a Request
    GetBlob (..),
    newGetBlob,

    -- * Request Lenses
    getBlob_repositoryName,
    getBlob_blobId,

    -- * Destructuring the Response
    GetBlobResponse (..),
    newGetBlobResponse,

    -- * Response Lenses
    getBlobResponse_httpStatus,
    getBlobResponse_content,
  )
where

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

-- | Represents the input of a get blob operation.
--
-- /See:/ 'newGetBlob' smart constructor.
data GetBlob = GetBlob'
  { -- | The name of the repository that contains the blob.
    GetBlob -> Text
repositoryName :: Prelude.Text,
    -- | The ID of the blob, which is its SHA-1 pointer.
    GetBlob -> Text
blobId :: Prelude.Text
  }
  deriving (GetBlob -> GetBlob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBlob -> GetBlob -> Bool
$c/= :: GetBlob -> GetBlob -> Bool
== :: GetBlob -> GetBlob -> Bool
$c== :: GetBlob -> GetBlob -> Bool
Prelude.Eq, ReadPrec [GetBlob]
ReadPrec GetBlob
Int -> ReadS GetBlob
ReadS [GetBlob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBlob]
$creadListPrec :: ReadPrec [GetBlob]
readPrec :: ReadPrec GetBlob
$creadPrec :: ReadPrec GetBlob
readList :: ReadS [GetBlob]
$creadList :: ReadS [GetBlob]
readsPrec :: Int -> ReadS GetBlob
$creadsPrec :: Int -> ReadS GetBlob
Prelude.Read, Int -> GetBlob -> ShowS
[GetBlob] -> ShowS
GetBlob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBlob] -> ShowS
$cshowList :: [GetBlob] -> ShowS
show :: GetBlob -> String
$cshow :: GetBlob -> String
showsPrec :: Int -> GetBlob -> ShowS
$cshowsPrec :: Int -> GetBlob -> ShowS
Prelude.Show, forall x. Rep GetBlob x -> GetBlob
forall x. GetBlob -> Rep GetBlob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBlob x -> GetBlob
$cfrom :: forall x. GetBlob -> Rep GetBlob x
Prelude.Generic)

-- |
-- Create a value of 'GetBlob' 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:
--
-- 'repositoryName', 'getBlob_repositoryName' - The name of the repository that contains the blob.
--
-- 'blobId', 'getBlob_blobId' - The ID of the blob, which is its SHA-1 pointer.
newGetBlob ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'blobId'
  Prelude.Text ->
  GetBlob
newGetBlob :: Text -> Text -> GetBlob
newGetBlob Text
pRepositoryName_ Text
pBlobId_ =
  GetBlob'
    { $sel:repositoryName:GetBlob' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:blobId:GetBlob' :: Text
blobId = Text
pBlobId_
    }

-- | The name of the repository that contains the blob.
getBlob_repositoryName :: Lens.Lens' GetBlob Prelude.Text
getBlob_repositoryName :: Lens' GetBlob Text
getBlob_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBlob' {Text
repositoryName :: Text
$sel:repositoryName:GetBlob' :: GetBlob -> Text
repositoryName} -> Text
repositoryName) (\s :: GetBlob
s@GetBlob' {} Text
a -> GetBlob
s {$sel:repositoryName:GetBlob' :: Text
repositoryName = Text
a} :: GetBlob)

-- | The ID of the blob, which is its SHA-1 pointer.
getBlob_blobId :: Lens.Lens' GetBlob Prelude.Text
getBlob_blobId :: Lens' GetBlob Text
getBlob_blobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBlob' {Text
blobId :: Text
$sel:blobId:GetBlob' :: GetBlob -> Text
blobId} -> Text
blobId) (\s :: GetBlob
s@GetBlob' {} Text
a -> GetBlob
s {$sel:blobId:GetBlob' :: Text
blobId = Text
a} :: GetBlob)

instance Core.AWSRequest GetBlob where
  type AWSResponse GetBlob = GetBlobResponse
  request :: (Service -> Service) -> GetBlob -> Request GetBlob
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 GetBlob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetBlob)))
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 ->
          Int -> Base64 -> GetBlobResponse
GetBlobResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"content")
      )

instance Prelude.Hashable GetBlob where
  hashWithSalt :: Int -> GetBlob -> Int
hashWithSalt Int
_salt GetBlob' {Text
blobId :: Text
repositoryName :: Text
$sel:blobId:GetBlob' :: GetBlob -> Text
$sel:repositoryName:GetBlob' :: GetBlob -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
blobId

instance Prelude.NFData GetBlob where
  rnf :: GetBlob -> ()
rnf GetBlob' {Text
blobId :: Text
repositoryName :: Text
$sel:blobId:GetBlob' :: GetBlob -> Text
$sel:repositoryName:GetBlob' :: GetBlob -> Text
..} =
    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
blobId

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

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

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

-- | Represents the output of a get blob operation.
--
-- /See:/ 'newGetBlobResponse' smart constructor.
data GetBlobResponse = GetBlobResponse'
  { -- | The response's http status code.
    GetBlobResponse -> Int
httpStatus :: Prelude.Int,
    -- | The content of the blob, usually a file.
    GetBlobResponse -> Base64
content :: Data.Base64
  }
  deriving (GetBlobResponse -> GetBlobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBlobResponse -> GetBlobResponse -> Bool
$c/= :: GetBlobResponse -> GetBlobResponse -> Bool
== :: GetBlobResponse -> GetBlobResponse -> Bool
$c== :: GetBlobResponse -> GetBlobResponse -> Bool
Prelude.Eq, ReadPrec [GetBlobResponse]
ReadPrec GetBlobResponse
Int -> ReadS GetBlobResponse
ReadS [GetBlobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBlobResponse]
$creadListPrec :: ReadPrec [GetBlobResponse]
readPrec :: ReadPrec GetBlobResponse
$creadPrec :: ReadPrec GetBlobResponse
readList :: ReadS [GetBlobResponse]
$creadList :: ReadS [GetBlobResponse]
readsPrec :: Int -> ReadS GetBlobResponse
$creadsPrec :: Int -> ReadS GetBlobResponse
Prelude.Read, Int -> GetBlobResponse -> ShowS
[GetBlobResponse] -> ShowS
GetBlobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBlobResponse] -> ShowS
$cshowList :: [GetBlobResponse] -> ShowS
show :: GetBlobResponse -> String
$cshow :: GetBlobResponse -> String
showsPrec :: Int -> GetBlobResponse -> ShowS
$cshowsPrec :: Int -> GetBlobResponse -> ShowS
Prelude.Show, forall x. Rep GetBlobResponse x -> GetBlobResponse
forall x. GetBlobResponse -> Rep GetBlobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBlobResponse x -> GetBlobResponse
$cfrom :: forall x. GetBlobResponse -> Rep GetBlobResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBlobResponse' 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:
--
-- 'httpStatus', 'getBlobResponse_httpStatus' - The response's http status code.
--
-- 'content', 'getBlobResponse_content' - The content of the blob, usually a file.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
newGetBlobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'content'
  Prelude.ByteString ->
  GetBlobResponse
newGetBlobResponse :: Int -> ByteString -> GetBlobResponse
newGetBlobResponse Int
pHttpStatus_ ByteString
pContent_ =
  GetBlobResponse'
    { $sel:httpStatus:GetBlobResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:content:GetBlobResponse' :: Base64
content = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pContent_
    }

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

-- | The content of the blob, usually a file.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
getBlobResponse_content :: Lens.Lens' GetBlobResponse Prelude.ByteString
getBlobResponse_content :: Lens' GetBlobResponse ByteString
getBlobResponse_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBlobResponse' {Base64
content :: Base64
$sel:content:GetBlobResponse' :: GetBlobResponse -> Base64
content} -> Base64
content) (\s :: GetBlobResponse
s@GetBlobResponse' {} Base64
a -> GetBlobResponse
s {$sel:content:GetBlobResponse' :: Base64
content = Base64
a} :: GetBlobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Prelude.NFData GetBlobResponse where
  rnf :: GetBlobResponse -> ()
rnf GetBlobResponse' {Int
Base64
content :: Base64
httpStatus :: Int
$sel:content:GetBlobResponse' :: GetBlobResponse -> Base64
$sel:httpStatus:GetBlobResponse' :: GetBlobResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
content