{-# 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.GetFile
-- 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 contents of a specified file and its
-- metadata.
module Amazonka.CodeCommit.GetFile
  ( -- * Creating a Request
    GetFile (..),
    newGetFile,

    -- * Request Lenses
    getFile_commitSpecifier,
    getFile_repositoryName,
    getFile_filePath,

    -- * Destructuring the Response
    GetFileResponse (..),
    newGetFileResponse,

    -- * Response Lenses
    getFileResponse_httpStatus,
    getFileResponse_commitId,
    getFileResponse_blobId,
    getFileResponse_filePath,
    getFileResponse_fileMode,
    getFileResponse_fileSize,
    getFileResponse_fileContent,
  )
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

-- | /See:/ 'newGetFile' smart constructor.
data GetFile = GetFile'
  { -- | The fully quaified reference that identifies the commit that contains
    -- the file. For example, you can specify a full commit ID, a tag, a branch
    -- name, or a reference such as refs\/heads\/master. If none is provided,
    -- the head commit is used.
    GetFile -> Maybe Text
commitSpecifier :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository that contains the file.
    GetFile -> Text
repositoryName :: Prelude.Text,
    -- | The fully qualified path to the file, including the full name and
    -- extension of the file. For example, \/examples\/file.md is the fully
    -- qualified path to a file named file.md in a folder named examples.
    GetFile -> Text
filePath :: Prelude.Text
  }
  deriving (GetFile -> GetFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFile -> GetFile -> Bool
$c/= :: GetFile -> GetFile -> Bool
== :: GetFile -> GetFile -> Bool
$c== :: GetFile -> GetFile -> Bool
Prelude.Eq, ReadPrec [GetFile]
ReadPrec GetFile
Int -> ReadS GetFile
ReadS [GetFile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFile]
$creadListPrec :: ReadPrec [GetFile]
readPrec :: ReadPrec GetFile
$creadPrec :: ReadPrec GetFile
readList :: ReadS [GetFile]
$creadList :: ReadS [GetFile]
readsPrec :: Int -> ReadS GetFile
$creadsPrec :: Int -> ReadS GetFile
Prelude.Read, Int -> GetFile -> ShowS
[GetFile] -> ShowS
GetFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFile] -> ShowS
$cshowList :: [GetFile] -> ShowS
show :: GetFile -> String
$cshow :: GetFile -> String
showsPrec :: Int -> GetFile -> ShowS
$cshowsPrec :: Int -> GetFile -> ShowS
Prelude.Show, forall x. Rep GetFile x -> GetFile
forall x. GetFile -> Rep GetFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFile x -> GetFile
$cfrom :: forall x. GetFile -> Rep GetFile x
Prelude.Generic)

-- |
-- Create a value of 'GetFile' 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:
--
-- 'commitSpecifier', 'getFile_commitSpecifier' - The fully quaified reference that identifies the commit that contains
-- the file. For example, you can specify a full commit ID, a tag, a branch
-- name, or a reference such as refs\/heads\/master. If none is provided,
-- the head commit is used.
--
-- 'repositoryName', 'getFile_repositoryName' - The name of the repository that contains the file.
--
-- 'filePath', 'getFile_filePath' - The fully qualified path to the file, including the full name and
-- extension of the file. For example, \/examples\/file.md is the fully
-- qualified path to a file named file.md in a folder named examples.
newGetFile ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'filePath'
  Prelude.Text ->
  GetFile
newGetFile :: Text -> Text -> GetFile
newGetFile Text
pRepositoryName_ Text
pFilePath_ =
  GetFile'
    { $sel:commitSpecifier:GetFile' :: Maybe Text
commitSpecifier = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:GetFile' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:filePath:GetFile' :: Text
filePath = Text
pFilePath_
    }

-- | The fully quaified reference that identifies the commit that contains
-- the file. For example, you can specify a full commit ID, a tag, a branch
-- name, or a reference such as refs\/heads\/master. If none is provided,
-- the head commit is used.
getFile_commitSpecifier :: Lens.Lens' GetFile (Prelude.Maybe Prelude.Text)
getFile_commitSpecifier :: Lens' GetFile (Maybe Text)
getFile_commitSpecifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFile' {Maybe Text
commitSpecifier :: Maybe Text
$sel:commitSpecifier:GetFile' :: GetFile -> Maybe Text
commitSpecifier} -> Maybe Text
commitSpecifier) (\s :: GetFile
s@GetFile' {} Maybe Text
a -> GetFile
s {$sel:commitSpecifier:GetFile' :: Maybe Text
commitSpecifier = Maybe Text
a} :: GetFile)

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

-- | The fully qualified path to the file, including the full name and
-- extension of the file. For example, \/examples\/file.md is the fully
-- qualified path to a file named file.md in a folder named examples.
getFile_filePath :: Lens.Lens' GetFile Prelude.Text
getFile_filePath :: Lens' GetFile Text
getFile_filePath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFile' {Text
filePath :: Text
$sel:filePath:GetFile' :: GetFile -> Text
filePath} -> Text
filePath) (\s :: GetFile
s@GetFile' {} Text
a -> GetFile
s {$sel:filePath:GetFile' :: Text
filePath = Text
a} :: GetFile)

instance Core.AWSRequest GetFile where
  type AWSResponse GetFile = GetFileResponse
  request :: (Service -> Service) -> GetFile -> Request GetFile
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 GetFile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFile)))
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
-> Text
-> Text
-> Text
-> FileModeTypeEnum
-> Integer
-> Base64
-> GetFileResponse
GetFileResponse'
            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
"commitId")
            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
"blobId")
            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
"filePath")
            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
"fileMode")
            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
"fileSize")
            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
"fileContent")
      )

instance Prelude.Hashable GetFile where
  hashWithSalt :: Int -> GetFile -> Int
hashWithSalt Int
_salt GetFile' {Maybe Text
Text
filePath :: Text
repositoryName :: Text
commitSpecifier :: Maybe Text
$sel:filePath:GetFile' :: GetFile -> Text
$sel:repositoryName:GetFile' :: GetFile -> Text
$sel:commitSpecifier:GetFile' :: GetFile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
commitSpecifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filePath

instance Prelude.NFData GetFile where
  rnf :: GetFile -> ()
rnf GetFile' {Maybe Text
Text
filePath :: Text
repositoryName :: Text
commitSpecifier :: Maybe Text
$sel:filePath:GetFile' :: GetFile -> Text
$sel:repositoryName:GetFile' :: GetFile -> Text
$sel:commitSpecifier:GetFile' :: GetFile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
commitSpecifier
      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
filePath

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

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

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

-- | /See:/ 'newGetFileResponse' smart constructor.
data GetFileResponse = GetFileResponse'
  { -- | The response's http status code.
    GetFileResponse -> Int
httpStatus :: Prelude.Int,
    -- | The full commit ID of the commit that contains the content returned by
    -- GetFile.
    GetFileResponse -> Text
commitId :: Prelude.Text,
    -- | The blob ID of the object that represents the file content.
    GetFileResponse -> Text
blobId :: Prelude.Text,
    -- | The fully qualified path to the specified file. Returns the name and
    -- extension of the file.
    GetFileResponse -> Text
filePath :: Prelude.Text,
    -- | The extrapolated file mode permissions of the blob. Valid values include
    -- strings such as EXECUTABLE and not numeric values.
    --
    -- The file mode permissions returned by this API are not the standard file
    -- mode permission values, such as 100644, but rather extrapolated values.
    -- See the supported return values.
    GetFileResponse -> FileModeTypeEnum
fileMode :: FileModeTypeEnum,
    -- | The size of the contents of the file, in bytes.
    GetFileResponse -> Integer
fileSize :: Prelude.Integer,
    -- | The base-64 encoded binary data object that represents the content of
    -- the file.
    GetFileResponse -> Base64
fileContent :: Data.Base64
  }
  deriving (GetFileResponse -> GetFileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFileResponse -> GetFileResponse -> Bool
$c/= :: GetFileResponse -> GetFileResponse -> Bool
== :: GetFileResponse -> GetFileResponse -> Bool
$c== :: GetFileResponse -> GetFileResponse -> Bool
Prelude.Eq, ReadPrec [GetFileResponse]
ReadPrec GetFileResponse
Int -> ReadS GetFileResponse
ReadS [GetFileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFileResponse]
$creadListPrec :: ReadPrec [GetFileResponse]
readPrec :: ReadPrec GetFileResponse
$creadPrec :: ReadPrec GetFileResponse
readList :: ReadS [GetFileResponse]
$creadList :: ReadS [GetFileResponse]
readsPrec :: Int -> ReadS GetFileResponse
$creadsPrec :: Int -> ReadS GetFileResponse
Prelude.Read, Int -> GetFileResponse -> ShowS
[GetFileResponse] -> ShowS
GetFileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFileResponse] -> ShowS
$cshowList :: [GetFileResponse] -> ShowS
show :: GetFileResponse -> String
$cshow :: GetFileResponse -> String
showsPrec :: Int -> GetFileResponse -> ShowS
$cshowsPrec :: Int -> GetFileResponse -> ShowS
Prelude.Show, forall x. Rep GetFileResponse x -> GetFileResponse
forall x. GetFileResponse -> Rep GetFileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFileResponse x -> GetFileResponse
$cfrom :: forall x. GetFileResponse -> Rep GetFileResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFileResponse' 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', 'getFileResponse_httpStatus' - The response's http status code.
--
-- 'commitId', 'getFileResponse_commitId' - The full commit ID of the commit that contains the content returned by
-- GetFile.
--
-- 'blobId', 'getFileResponse_blobId' - The blob ID of the object that represents the file content.
--
-- 'filePath', 'getFileResponse_filePath' - The fully qualified path to the specified file. Returns the name and
-- extension of the file.
--
-- 'fileMode', 'getFileResponse_fileMode' - The extrapolated file mode permissions of the blob. Valid values include
-- strings such as EXECUTABLE and not numeric values.
--
-- The file mode permissions returned by this API are not the standard file
-- mode permission values, such as 100644, but rather extrapolated values.
-- See the supported return values.
--
-- 'fileSize', 'getFileResponse_fileSize' - The size of the contents of the file, in bytes.
--
-- 'fileContent', 'getFileResponse_fileContent' - The base-64 encoded binary data object that represents the content of
-- the 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.
newGetFileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'commitId'
  Prelude.Text ->
  -- | 'blobId'
  Prelude.Text ->
  -- | 'filePath'
  Prelude.Text ->
  -- | 'fileMode'
  FileModeTypeEnum ->
  -- | 'fileSize'
  Prelude.Integer ->
  -- | 'fileContent'
  Prelude.ByteString ->
  GetFileResponse
newGetFileResponse :: Int
-> Text
-> Text
-> Text
-> FileModeTypeEnum
-> Integer
-> ByteString
-> GetFileResponse
newGetFileResponse
  Int
pHttpStatus_
  Text
pCommitId_
  Text
pBlobId_
  Text
pFilePath_
  FileModeTypeEnum
pFileMode_
  Integer
pFileSize_
  ByteString
pFileContent_ =
    GetFileResponse'
      { $sel:httpStatus:GetFileResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:commitId:GetFileResponse' :: Text
commitId = Text
pCommitId_,
        $sel:blobId:GetFileResponse' :: Text
blobId = Text
pBlobId_,
        $sel:filePath:GetFileResponse' :: Text
filePath = Text
pFilePath_,
        $sel:fileMode:GetFileResponse' :: FileModeTypeEnum
fileMode = FileModeTypeEnum
pFileMode_,
        $sel:fileSize:GetFileResponse' :: Integer
fileSize = Integer
pFileSize_,
        $sel:fileContent:GetFileResponse' :: Base64
fileContent = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pFileContent_
      }

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

-- | The full commit ID of the commit that contains the content returned by
-- GetFile.
getFileResponse_commitId :: Lens.Lens' GetFileResponse Prelude.Text
getFileResponse_commitId :: Lens' GetFileResponse Text
getFileResponse_commitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFileResponse' {Text
commitId :: Text
$sel:commitId:GetFileResponse' :: GetFileResponse -> Text
commitId} -> Text
commitId) (\s :: GetFileResponse
s@GetFileResponse' {} Text
a -> GetFileResponse
s {$sel:commitId:GetFileResponse' :: Text
commitId = Text
a} :: GetFileResponse)

-- | The blob ID of the object that represents the file content.
getFileResponse_blobId :: Lens.Lens' GetFileResponse Prelude.Text
getFileResponse_blobId :: Lens' GetFileResponse Text
getFileResponse_blobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFileResponse' {Text
blobId :: Text
$sel:blobId:GetFileResponse' :: GetFileResponse -> Text
blobId} -> Text
blobId) (\s :: GetFileResponse
s@GetFileResponse' {} Text
a -> GetFileResponse
s {$sel:blobId:GetFileResponse' :: Text
blobId = Text
a} :: GetFileResponse)

-- | The fully qualified path to the specified file. Returns the name and
-- extension of the file.
getFileResponse_filePath :: Lens.Lens' GetFileResponse Prelude.Text
getFileResponse_filePath :: Lens' GetFileResponse Text
getFileResponse_filePath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFileResponse' {Text
filePath :: Text
$sel:filePath:GetFileResponse' :: GetFileResponse -> Text
filePath} -> Text
filePath) (\s :: GetFileResponse
s@GetFileResponse' {} Text
a -> GetFileResponse
s {$sel:filePath:GetFileResponse' :: Text
filePath = Text
a} :: GetFileResponse)

-- | The extrapolated file mode permissions of the blob. Valid values include
-- strings such as EXECUTABLE and not numeric values.
--
-- The file mode permissions returned by this API are not the standard file
-- mode permission values, such as 100644, but rather extrapolated values.
-- See the supported return values.
getFileResponse_fileMode :: Lens.Lens' GetFileResponse FileModeTypeEnum
getFileResponse_fileMode :: Lens' GetFileResponse FileModeTypeEnum
getFileResponse_fileMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFileResponse' {FileModeTypeEnum
fileMode :: FileModeTypeEnum
$sel:fileMode:GetFileResponse' :: GetFileResponse -> FileModeTypeEnum
fileMode} -> FileModeTypeEnum
fileMode) (\s :: GetFileResponse
s@GetFileResponse' {} FileModeTypeEnum
a -> GetFileResponse
s {$sel:fileMode:GetFileResponse' :: FileModeTypeEnum
fileMode = FileModeTypeEnum
a} :: GetFileResponse)

-- | The size of the contents of the file, in bytes.
getFileResponse_fileSize :: Lens.Lens' GetFileResponse Prelude.Integer
getFileResponse_fileSize :: Lens' GetFileResponse Integer
getFileResponse_fileSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFileResponse' {Integer
fileSize :: Integer
$sel:fileSize:GetFileResponse' :: GetFileResponse -> Integer
fileSize} -> Integer
fileSize) (\s :: GetFileResponse
s@GetFileResponse' {} Integer
a -> GetFileResponse
s {$sel:fileSize:GetFileResponse' :: Integer
fileSize = Integer
a} :: GetFileResponse)

-- | The base-64 encoded binary data object that represents the content of
-- the 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.
getFileResponse_fileContent :: Lens.Lens' GetFileResponse Prelude.ByteString
getFileResponse_fileContent :: Lens' GetFileResponse ByteString
getFileResponse_fileContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFileResponse' {Base64
fileContent :: Base64
$sel:fileContent:GetFileResponse' :: GetFileResponse -> Base64
fileContent} -> Base64
fileContent) (\s :: GetFileResponse
s@GetFileResponse' {} Base64
a -> GetFileResponse
s {$sel:fileContent:GetFileResponse' :: Base64
fileContent = Base64
a} :: GetFileResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Prelude.NFData GetFileResponse where
  rnf :: GetFileResponse -> ()
rnf GetFileResponse' {Int
Integer
Text
Base64
FileModeTypeEnum
fileContent :: Base64
fileSize :: Integer
fileMode :: FileModeTypeEnum
filePath :: Text
blobId :: Text
commitId :: Text
httpStatus :: Int
$sel:fileContent:GetFileResponse' :: GetFileResponse -> Base64
$sel:fileSize:GetFileResponse' :: GetFileResponse -> Integer
$sel:fileMode:GetFileResponse' :: GetFileResponse -> FileModeTypeEnum
$sel:filePath:GetFileResponse' :: GetFileResponse -> Text
$sel:blobId:GetFileResponse' :: GetFileResponse -> Text
$sel:commitId:GetFileResponse' :: GetFileResponse -> Text
$sel:httpStatus:GetFileResponse' :: GetFileResponse -> 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 Text
commitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
blobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
filePath
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FileModeTypeEnum
fileMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
fileSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
fileContent