{-# 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.SageMaker.DescribeCodeRepository
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets details about the specified Git repository.
module Amazonka.SageMaker.DescribeCodeRepository
  ( -- * Creating a Request
    DescribeCodeRepository (..),
    newDescribeCodeRepository,

    -- * Request Lenses
    describeCodeRepository_codeRepositoryName,

    -- * Destructuring the Response
    DescribeCodeRepositoryResponse (..),
    newDescribeCodeRepositoryResponse,

    -- * Response Lenses
    describeCodeRepositoryResponse_gitConfig,
    describeCodeRepositoryResponse_httpStatus,
    describeCodeRepositoryResponse_codeRepositoryName,
    describeCodeRepositoryResponse_codeRepositoryArn,
    describeCodeRepositoryResponse_creationTime,
    describeCodeRepositoryResponse_lastModifiedTime,
  )
where

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
import Amazonka.SageMaker.Types

-- | /See:/ 'newDescribeCodeRepository' smart constructor.
data DescribeCodeRepository = DescribeCodeRepository'
  { -- | The name of the Git repository to describe.
    DescribeCodeRepository -> Text
codeRepositoryName :: Prelude.Text
  }
  deriving (DescribeCodeRepository -> DescribeCodeRepository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCodeRepository -> DescribeCodeRepository -> Bool
$c/= :: DescribeCodeRepository -> DescribeCodeRepository -> Bool
== :: DescribeCodeRepository -> DescribeCodeRepository -> Bool
$c== :: DescribeCodeRepository -> DescribeCodeRepository -> Bool
Prelude.Eq, ReadPrec [DescribeCodeRepository]
ReadPrec DescribeCodeRepository
Int -> ReadS DescribeCodeRepository
ReadS [DescribeCodeRepository]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCodeRepository]
$creadListPrec :: ReadPrec [DescribeCodeRepository]
readPrec :: ReadPrec DescribeCodeRepository
$creadPrec :: ReadPrec DescribeCodeRepository
readList :: ReadS [DescribeCodeRepository]
$creadList :: ReadS [DescribeCodeRepository]
readsPrec :: Int -> ReadS DescribeCodeRepository
$creadsPrec :: Int -> ReadS DescribeCodeRepository
Prelude.Read, Int -> DescribeCodeRepository -> ShowS
[DescribeCodeRepository] -> ShowS
DescribeCodeRepository -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCodeRepository] -> ShowS
$cshowList :: [DescribeCodeRepository] -> ShowS
show :: DescribeCodeRepository -> String
$cshow :: DescribeCodeRepository -> String
showsPrec :: Int -> DescribeCodeRepository -> ShowS
$cshowsPrec :: Int -> DescribeCodeRepository -> ShowS
Prelude.Show, forall x. Rep DescribeCodeRepository x -> DescribeCodeRepository
forall x. DescribeCodeRepository -> Rep DescribeCodeRepository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeCodeRepository x -> DescribeCodeRepository
$cfrom :: forall x. DescribeCodeRepository -> Rep DescribeCodeRepository x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCodeRepository' 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:
--
-- 'codeRepositoryName', 'describeCodeRepository_codeRepositoryName' - The name of the Git repository to describe.
newDescribeCodeRepository ::
  -- | 'codeRepositoryName'
  Prelude.Text ->
  DescribeCodeRepository
newDescribeCodeRepository :: Text -> DescribeCodeRepository
newDescribeCodeRepository Text
pCodeRepositoryName_ =
  DescribeCodeRepository'
    { $sel:codeRepositoryName:DescribeCodeRepository' :: Text
codeRepositoryName =
        Text
pCodeRepositoryName_
    }

-- | The name of the Git repository to describe.
describeCodeRepository_codeRepositoryName :: Lens.Lens' DescribeCodeRepository Prelude.Text
describeCodeRepository_codeRepositoryName :: Lens' DescribeCodeRepository Text
describeCodeRepository_codeRepositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCodeRepository' {Text
codeRepositoryName :: Text
$sel:codeRepositoryName:DescribeCodeRepository' :: DescribeCodeRepository -> Text
codeRepositoryName} -> Text
codeRepositoryName) (\s :: DescribeCodeRepository
s@DescribeCodeRepository' {} Text
a -> DescribeCodeRepository
s {$sel:codeRepositoryName:DescribeCodeRepository' :: Text
codeRepositoryName = Text
a} :: DescribeCodeRepository)

instance Core.AWSRequest DescribeCodeRepository where
  type
    AWSResponse DescribeCodeRepository =
      DescribeCodeRepositoryResponse
  request :: (Service -> Service)
-> DescribeCodeRepository -> Request DescribeCodeRepository
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 DescribeCodeRepository
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeCodeRepository)))
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 GitConfig
-> Int
-> Text
-> Text
-> POSIX
-> POSIX
-> DescribeCodeRepositoryResponse
DescribeCodeRepositoryResponse'
            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
"GitConfig")
            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))
            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
"CodeRepositoryName")
            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
"CodeRepositoryArn")
            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
"CreationTime")
            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
"LastModifiedTime")
      )

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

instance Prelude.NFData DescribeCodeRepository where
  rnf :: DescribeCodeRepository -> ()
rnf DescribeCodeRepository' {Text
codeRepositoryName :: Text
$sel:codeRepositoryName:DescribeCodeRepository' :: DescribeCodeRepository -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
codeRepositoryName

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

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

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

-- | /See:/ 'newDescribeCodeRepositoryResponse' smart constructor.
data DescribeCodeRepositoryResponse = DescribeCodeRepositoryResponse'
  { -- | Configuration details about the repository, including the URL where the
    -- repository is located, the default branch, and the Amazon Resource Name
    -- (ARN) of the Amazon Web Services Secrets Manager secret that contains
    -- the credentials used to access the repository.
    DescribeCodeRepositoryResponse -> Maybe GitConfig
gitConfig :: Prelude.Maybe GitConfig,
    -- | The response's http status code.
    DescribeCodeRepositoryResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the Git repository.
    DescribeCodeRepositoryResponse -> Text
codeRepositoryName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Git repository.
    DescribeCodeRepositoryResponse -> Text
codeRepositoryArn :: Prelude.Text,
    -- | The date and time that the repository was created.
    DescribeCodeRepositoryResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The date and time that the repository was last changed.
    DescribeCodeRepositoryResponse -> POSIX
lastModifiedTime :: Data.POSIX
  }
  deriving (DescribeCodeRepositoryResponse
-> DescribeCodeRepositoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCodeRepositoryResponse
-> DescribeCodeRepositoryResponse -> Bool
$c/= :: DescribeCodeRepositoryResponse
-> DescribeCodeRepositoryResponse -> Bool
== :: DescribeCodeRepositoryResponse
-> DescribeCodeRepositoryResponse -> Bool
$c== :: DescribeCodeRepositoryResponse
-> DescribeCodeRepositoryResponse -> Bool
Prelude.Eq, ReadPrec [DescribeCodeRepositoryResponse]
ReadPrec DescribeCodeRepositoryResponse
Int -> ReadS DescribeCodeRepositoryResponse
ReadS [DescribeCodeRepositoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCodeRepositoryResponse]
$creadListPrec :: ReadPrec [DescribeCodeRepositoryResponse]
readPrec :: ReadPrec DescribeCodeRepositoryResponse
$creadPrec :: ReadPrec DescribeCodeRepositoryResponse
readList :: ReadS [DescribeCodeRepositoryResponse]
$creadList :: ReadS [DescribeCodeRepositoryResponse]
readsPrec :: Int -> ReadS DescribeCodeRepositoryResponse
$creadsPrec :: Int -> ReadS DescribeCodeRepositoryResponse
Prelude.Read, Int -> DescribeCodeRepositoryResponse -> ShowS
[DescribeCodeRepositoryResponse] -> ShowS
DescribeCodeRepositoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCodeRepositoryResponse] -> ShowS
$cshowList :: [DescribeCodeRepositoryResponse] -> ShowS
show :: DescribeCodeRepositoryResponse -> String
$cshow :: DescribeCodeRepositoryResponse -> String
showsPrec :: Int -> DescribeCodeRepositoryResponse -> ShowS
$cshowsPrec :: Int -> DescribeCodeRepositoryResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeCodeRepositoryResponse x
-> DescribeCodeRepositoryResponse
forall x.
DescribeCodeRepositoryResponse
-> Rep DescribeCodeRepositoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeCodeRepositoryResponse x
-> DescribeCodeRepositoryResponse
$cfrom :: forall x.
DescribeCodeRepositoryResponse
-> Rep DescribeCodeRepositoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCodeRepositoryResponse' 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:
--
-- 'gitConfig', 'describeCodeRepositoryResponse_gitConfig' - Configuration details about the repository, including the URL where the
-- repository is located, the default branch, and the Amazon Resource Name
-- (ARN) of the Amazon Web Services Secrets Manager secret that contains
-- the credentials used to access the repository.
--
-- 'httpStatus', 'describeCodeRepositoryResponse_httpStatus' - The response's http status code.
--
-- 'codeRepositoryName', 'describeCodeRepositoryResponse_codeRepositoryName' - The name of the Git repository.
--
-- 'codeRepositoryArn', 'describeCodeRepositoryResponse_codeRepositoryArn' - The Amazon Resource Name (ARN) of the Git repository.
--
-- 'creationTime', 'describeCodeRepositoryResponse_creationTime' - The date and time that the repository was created.
--
-- 'lastModifiedTime', 'describeCodeRepositoryResponse_lastModifiedTime' - The date and time that the repository was last changed.
newDescribeCodeRepositoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'codeRepositoryName'
  Prelude.Text ->
  -- | 'codeRepositoryArn'
  Prelude.Text ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'lastModifiedTime'
  Prelude.UTCTime ->
  DescribeCodeRepositoryResponse
newDescribeCodeRepositoryResponse :: Int
-> Text
-> Text
-> UTCTime
-> UTCTime
-> DescribeCodeRepositoryResponse
newDescribeCodeRepositoryResponse
  Int
pHttpStatus_
  Text
pCodeRepositoryName_
  Text
pCodeRepositoryArn_
  UTCTime
pCreationTime_
  UTCTime
pLastModifiedTime_ =
    DescribeCodeRepositoryResponse'
      { $sel:gitConfig:DescribeCodeRepositoryResponse' :: Maybe GitConfig
gitConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeCodeRepositoryResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:codeRepositoryName:DescribeCodeRepositoryResponse' :: Text
codeRepositoryName = Text
pCodeRepositoryName_,
        $sel:codeRepositoryArn:DescribeCodeRepositoryResponse' :: Text
codeRepositoryArn = Text
pCodeRepositoryArn_,
        $sel:creationTime:DescribeCodeRepositoryResponse' :: POSIX
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:lastModifiedTime:DescribeCodeRepositoryResponse' :: POSIX
lastModifiedTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastModifiedTime_
      }

-- | Configuration details about the repository, including the URL where the
-- repository is located, the default branch, and the Amazon Resource Name
-- (ARN) of the Amazon Web Services Secrets Manager secret that contains
-- the credentials used to access the repository.
describeCodeRepositoryResponse_gitConfig :: Lens.Lens' DescribeCodeRepositoryResponse (Prelude.Maybe GitConfig)
describeCodeRepositoryResponse_gitConfig :: Lens' DescribeCodeRepositoryResponse (Maybe GitConfig)
describeCodeRepositoryResponse_gitConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCodeRepositoryResponse' {Maybe GitConfig
gitConfig :: Maybe GitConfig
$sel:gitConfig:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Maybe GitConfig
gitConfig} -> Maybe GitConfig
gitConfig) (\s :: DescribeCodeRepositoryResponse
s@DescribeCodeRepositoryResponse' {} Maybe GitConfig
a -> DescribeCodeRepositoryResponse
s {$sel:gitConfig:DescribeCodeRepositoryResponse' :: Maybe GitConfig
gitConfig = Maybe GitConfig
a} :: DescribeCodeRepositoryResponse)

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

-- | The name of the Git repository.
describeCodeRepositoryResponse_codeRepositoryName :: Lens.Lens' DescribeCodeRepositoryResponse Prelude.Text
describeCodeRepositoryResponse_codeRepositoryName :: Lens' DescribeCodeRepositoryResponse Text
describeCodeRepositoryResponse_codeRepositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCodeRepositoryResponse' {Text
codeRepositoryName :: Text
$sel:codeRepositoryName:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Text
codeRepositoryName} -> Text
codeRepositoryName) (\s :: DescribeCodeRepositoryResponse
s@DescribeCodeRepositoryResponse' {} Text
a -> DescribeCodeRepositoryResponse
s {$sel:codeRepositoryName:DescribeCodeRepositoryResponse' :: Text
codeRepositoryName = Text
a} :: DescribeCodeRepositoryResponse)

-- | The Amazon Resource Name (ARN) of the Git repository.
describeCodeRepositoryResponse_codeRepositoryArn :: Lens.Lens' DescribeCodeRepositoryResponse Prelude.Text
describeCodeRepositoryResponse_codeRepositoryArn :: Lens' DescribeCodeRepositoryResponse Text
describeCodeRepositoryResponse_codeRepositoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCodeRepositoryResponse' {Text
codeRepositoryArn :: Text
$sel:codeRepositoryArn:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Text
codeRepositoryArn} -> Text
codeRepositoryArn) (\s :: DescribeCodeRepositoryResponse
s@DescribeCodeRepositoryResponse' {} Text
a -> DescribeCodeRepositoryResponse
s {$sel:codeRepositoryArn:DescribeCodeRepositoryResponse' :: Text
codeRepositoryArn = Text
a} :: DescribeCodeRepositoryResponse)

-- | The date and time that the repository was created.
describeCodeRepositoryResponse_creationTime :: Lens.Lens' DescribeCodeRepositoryResponse Prelude.UTCTime
describeCodeRepositoryResponse_creationTime :: Lens' DescribeCodeRepositoryResponse UTCTime
describeCodeRepositoryResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCodeRepositoryResponse' {POSIX
creationTime :: POSIX
$sel:creationTime:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> POSIX
creationTime} -> POSIX
creationTime) (\s :: DescribeCodeRepositoryResponse
s@DescribeCodeRepositoryResponse' {} POSIX
a -> DescribeCodeRepositoryResponse
s {$sel:creationTime:DescribeCodeRepositoryResponse' :: POSIX
creationTime = POSIX
a} :: DescribeCodeRepositoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date and time that the repository was last changed.
describeCodeRepositoryResponse_lastModifiedTime :: Lens.Lens' DescribeCodeRepositoryResponse Prelude.UTCTime
describeCodeRepositoryResponse_lastModifiedTime :: Lens' DescribeCodeRepositoryResponse UTCTime
describeCodeRepositoryResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCodeRepositoryResponse' {POSIX
lastModifiedTime :: POSIX
$sel:lastModifiedTime:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> POSIX
lastModifiedTime} -> POSIX
lastModifiedTime) (\s :: DescribeCodeRepositoryResponse
s@DescribeCodeRepositoryResponse' {} POSIX
a -> DescribeCodeRepositoryResponse
s {$sel:lastModifiedTime:DescribeCodeRepositoryResponse' :: POSIX
lastModifiedTime = POSIX
a} :: DescribeCodeRepositoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance
  Prelude.NFData
    DescribeCodeRepositoryResponse
  where
  rnf :: DescribeCodeRepositoryResponse -> ()
rnf DescribeCodeRepositoryResponse' {Int
Maybe GitConfig
Text
POSIX
lastModifiedTime :: POSIX
creationTime :: POSIX
codeRepositoryArn :: Text
codeRepositoryName :: Text
httpStatus :: Int
gitConfig :: Maybe GitConfig
$sel:lastModifiedTime:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> POSIX
$sel:creationTime:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> POSIX
$sel:codeRepositoryArn:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Text
$sel:codeRepositoryName:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Text
$sel:httpStatus:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Int
$sel:gitConfig:DescribeCodeRepositoryResponse' :: DescribeCodeRepositoryResponse -> Maybe GitConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe GitConfig
gitConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
codeRepositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
codeRepositoryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastModifiedTime