-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The requests, the response readers and the verdicts behind
"Ecluse.Runtime.Maintenance.CodeArtifact.Decide", which documents the decisions and re-exports
the curated surface. Importing this module opts out of that stability promise, the convention
@text@ and @bytestring@ use, so production code imports the public one.
-}
module Ecluse.Runtime.Maintenance.CodeArtifact.Decide.Internal (
    -- * Coordinates
    CodeArtifactStore (..),
    CodeArtifactFormat,
    codeArtifactFormat,
    formatEcosystem,
    formatToken,

    -- * What the backend does
    codeArtifactFacts,
    deleteCeiling,

    -- * The npm codec
    packageCoordinates,
    packageNameFrom,

    -- * Requests
    listPackagesRequest,
    listVersionsRequest,
    listVersionsResult,
    deleteRequest,
    describeRepositoryRequest,
    describeUpstreamRequest,
    listTagsRequest,

    -- * The walk cursor
    cursorTagKey,
    cursorTagRequest,
    cursorUntagRequest,
    cursorOfTags,

    -- * Responses
    packagesOfPage,
    presenceOf,
    foldDeleteResponse,
    classifyRepository,
    repositoryOfStore,
    upstreamLinksOf,
    consentOfTags,
    repositoryOfResponse,
    arnOfDescription,

    -- * Consent marker
    consentTagKey,
    consentTagValue,
    consentDescriptor,

    -- * Faults
    classifyStoreFault,
    describeUpstreamRefusal,
    describeRepositoryGrant,
) where

import Amazonka qualified as AWS
import Amazonka.CodeArtifact qualified as CA
import Amazonka.CodeArtifact.Lens qualified as CAL
import Data.HashMap.Strict qualified as HM
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Lens.Micro ((.~), (?~), (^.))
import Network.HTTP.Types (Header, statusCode)
import Network.HTTP.Types.Header (hRetryAfter)

import Ecluse.Core.Ecosystem (Ecosystem (Npm, PyPI, RubyGems), ecosystemName)
import Ecluse.Core.Fault (
    RetryAfter (RetryAfter),
    TransportCause (TransportProtocol),
    tfCause,
    transportFault,
    transportRetryable,
 )
import Ecluse.Core.Package (PackageName, mkPackageName, mkScope, pkgNamespace, unScope, unscopedName)
import Ecluse.Core.Registry.Maintenance (
    CompletionNotion (CompletesOnCall),
    ConsentVerdict (ConsentGranted, ConsentWithheld),
    DeleteCeiling (AtMost),
    RefillPosture (RefillPermitted),
    RetryAdvice (RetryDelayed, RetryFutile, RetryWorthwhile),
    StoreClass (StoreDestroyable, StorePreserved),
    StoreFacts (..),
    StoreFault (..),
    StoreRefusal,
    VersionOutcome (VersionRefused, VersionRemoved),
    VersionPresence (VersionServed, VersionWithdrawn),
    storeRefusal,
 )
import Ecluse.Core.Registry.Maintenance.Budget (
    QuotaDimension (AccountReads, AccountWrites, NameListing, TokenReads, VersionListing),
    QuotaOrigin (QuotaDocumented),
    QuotaScope,
    RequestKind (CursorRead, CursorWrite, DeleteBatch, ListingPage, ManifestRead, PermissionRead, VersionPage),
    StoreBudget (StoreBudget, bgCosts, bgOrigin, bgQuotas, bgScope),
    mkQuotaScope,
 )
import Ecluse.Core.Registry.Maintenance.NameSpace (
    NameAlphabet,
    NamePrefix,
    parseNamePrefix,
    renderNamePrefix,
 )
import Ecluse.Core.Registry.Maintenance.Upstream (
    ExternalConnection (ExternalConnection, externalConnectionText),
    PermissionName (PermissionName),
    RepositoryLinks (RepositoryLinks, rlConnections, rlUpstreams),
    RepositoryName (RepositoryName, repositoryNameText),
    UndecidabilityReason (NetworkFailure),
    UnsafeReason (InsufficientPermissions),
    UpstreamSafety (Undecidable, Unsafe),
 )
import Ecluse.Core.Text (nonBlank, readDecimalText)
import Ecluse.Core.Version (Version, renderVersion)
import Ecluse.Runtime.Aws.Fault (classifyAwsTransport)

{- | Where one CodeArtifact repository lives. The composition root parses these from the
vetted mirror-store URL, so the leaf never sees a URL.
-}
data CodeArtifactStore = CodeArtifactStore
    { CodeArtifactStore -> Text
casDomain :: Text
    , CodeArtifactStore -> Text
casDomainOwner :: Text
    -- ^ The 12-digit account number that owns the domain.
    , CodeArtifactStore -> Text
casRegion :: Text
    , CodeArtifactStore -> Text
casRepository :: Text
    , CodeArtifactStore -> CodeArtifactFormat
casFormat :: CodeArtifactFormat
    }
    deriving stock (CodeArtifactStore -> CodeArtifactStore -> Bool
(CodeArtifactStore -> CodeArtifactStore -> Bool)
-> (CodeArtifactStore -> CodeArtifactStore -> Bool)
-> Eq CodeArtifactStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeArtifactStore -> CodeArtifactStore -> Bool
== :: CodeArtifactStore -> CodeArtifactStore -> Bool
$c/= :: CodeArtifactStore -> CodeArtifactStore -> Bool
/= :: CodeArtifactStore -> CodeArtifactStore -> Bool
Eq, Int -> CodeArtifactStore -> ShowS
[CodeArtifactStore] -> ShowS
CodeArtifactStore -> String
(Int -> CodeArtifactStore -> ShowS)
-> (CodeArtifactStore -> String)
-> ([CodeArtifactStore] -> ShowS)
-> Show CodeArtifactStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeArtifactStore -> ShowS
showsPrec :: Int -> CodeArtifactStore -> ShowS
$cshow :: CodeArtifactStore -> String
show :: CodeArtifactStore -> String
$cshowList :: [CodeArtifactStore] -> ShowS
showList :: [CodeArtifactStore] -> ShowS
Show)

{- | The format token CodeArtifact addresses an ecosystem by, held with the ecosystem it
came from, so a coordinate cannot name one format and mean another ecosystem.
-}
data CodeArtifactFormat = CodeArtifactFormat Ecosystem CA.PackageFormat
    deriving stock (CodeArtifactFormat -> CodeArtifactFormat -> Bool
(CodeArtifactFormat -> CodeArtifactFormat -> Bool)
-> (CodeArtifactFormat -> CodeArtifactFormat -> Bool)
-> Eq CodeArtifactFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeArtifactFormat -> CodeArtifactFormat -> Bool
== :: CodeArtifactFormat -> CodeArtifactFormat -> Bool
$c/= :: CodeArtifactFormat -> CodeArtifactFormat -> Bool
/= :: CodeArtifactFormat -> CodeArtifactFormat -> Bool
Eq, Int -> CodeArtifactFormat -> ShowS
[CodeArtifactFormat] -> ShowS
CodeArtifactFormat -> String
(Int -> CodeArtifactFormat -> ShowS)
-> (CodeArtifactFormat -> String)
-> ([CodeArtifactFormat] -> ShowS)
-> Show CodeArtifactFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeArtifactFormat -> ShowS
showsPrec :: Int -> CodeArtifactFormat -> ShowS
$cshow :: CodeArtifactFormat -> String
show :: CodeArtifactFormat -> String
$cshowList :: [CodeArtifactFormat] -> ShowS
showList :: [CodeArtifactFormat] -> ShowS
Show)

-- | The format CodeArtifact addresses an ecosystem by, 'Nothing' where it has none.
codeArtifactFormat :: Ecosystem -> Maybe CodeArtifactFormat
codeArtifactFormat :: Ecosystem -> Maybe CodeArtifactFormat
codeArtifactFormat = \case
    Ecosystem
Npm -> CodeArtifactFormat -> Maybe CodeArtifactFormat
forall a. a -> Maybe a
Just (Ecosystem -> PackageFormat -> CodeArtifactFormat
CodeArtifactFormat Ecosystem
Npm PackageFormat
CA.PackageFormat_Npm)
    Ecosystem
PyPI -> CodeArtifactFormat -> Maybe CodeArtifactFormat
forall a. a -> Maybe a
Just (Ecosystem -> PackageFormat -> CodeArtifactFormat
CodeArtifactFormat Ecosystem
PyPI PackageFormat
CA.PackageFormat_Pypi)
    Ecosystem
RubyGems -> Maybe CodeArtifactFormat
forall a. Maybe a
Nothing

-- | The ecosystem a format was built from.
formatEcosystem :: CodeArtifactFormat -> Ecosystem
formatEcosystem :: CodeArtifactFormat -> Ecosystem
formatEcosystem (CodeArtifactFormat Ecosystem
eco PackageFormat
_) = Ecosystem
eco

{- | The format as CodeArtifact spells it, which is also the first path segment of a
repository's per-format endpoint.
-}
formatToken :: CodeArtifactFormat -> Text
formatToken :: CodeArtifactFormat -> Text
formatToken (CodeArtifactFormat Ecosystem
_ PackageFormat
token) = PackageFormat -> Text
CA.fromPackageFormat PackageFormat
token

-- The format CodeArtifact addresses a store's own ecosystem by.
storePackageFormat :: CodeArtifactStore -> CA.PackageFormat
storePackageFormat :: CodeArtifactStore -> PackageFormat
storePackageFormat CodeArtifactStore
store = case CodeArtifactStore -> CodeArtifactFormat
casFormat CodeArtifactStore
store of
    CodeArtifactFormat Ecosystem
_ PackageFormat
token -> PackageFormat
token

{- | What CodeArtifact does: it re-admits a version published again after a delete, and has applied
it by the time it answers. The alphabet is the mount ecosystem's, whose grammar spells the names.
-}
codeArtifactFacts :: NameAlphabet -> CodeArtifactStore -> StoreFacts
codeArtifactFacts :: NameAlphabet -> CodeArtifactStore -> StoreFacts
codeArtifactFacts NameAlphabet
alphabet CodeArtifactStore
store =
    StoreFacts
        { factBackend :: Text
factBackend = Text
"codeArtifact"
        , factDeleteCeiling :: DeleteCeiling
factDeleteCeiling = DeleteCeiling
deleteCeiling
        , factRefill :: RefillPosture
factRefill = RefillPosture
RefillPermitted
        , factCompletion :: CompletionNotion
factCompletion = CompletionNotion
CompletesOnCall
        , factNameAlphabet :: NameAlphabet
factNameAlphabet = NameAlphabet
alphabet
        , factBudget :: StoreBudget
factBudget = StoreBudget
codeArtifactBudget{bgScope = codeArtifactScope store}
        }

{- | The pool a repository's requests debit: the account that owns the domain, in the Region the
repository answers in. Every repository of that account and Region shares one set of quotas.
-}
codeArtifactScope :: CodeArtifactStore -> QuotaScope
codeArtifactScope :: CodeArtifactStore -> QuotaScope
codeArtifactScope CodeArtifactStore
store = Text -> QuotaScope
mkQuotaScope (CodeArtifactStore -> Text
casDomainOwner CodeArtifactStore
store Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CodeArtifactStore -> Text
casRegion CodeArtifactStore
store)

{- | The capacity a CodeArtifact account and Region is taken to have: the per-Region defaults AWS
publishes, which this build reads from its documentation rather than discovering.
-}
codeArtifactBudget :: StoreBudget
codeArtifactBudget :: StoreBudget
codeArtifactBudget =
    StoreBudget
        { bgScope :: QuotaScope
bgScope = Text -> QuotaScope
mkQuotaScope Text
""
        , bgQuotas :: Map QuotaDimension Rational
bgQuotas =
            [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (QuotaDimension
NameListing, Rational
200)
                , (QuotaDimension
VersionListing, Rational
200)
                , (QuotaDimension
AccountReads, Rational
800)
                , (QuotaDimension
AccountWrites, Rational
100)
                , (QuotaDimension
TokenReads, Rational
1200)
                ]
        , bgOrigin :: QuotaOrigin
bgOrigin = QuotaOrigin
QuotaDocumented
        , bgCosts :: Map RequestKind (Map QuotaDimension Rational)
bgCosts = [(RequestKind, Map QuotaDimension Rational)]
-> Map RequestKind (Map QuotaDimension Rational)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RequestKind, Map QuotaDimension Rational)]
codeArtifactCosts
        }

{- The pools each call is charged to. Assigning the account read and write dimensions to the IAM
access level is a conservative inference: AWS publishes no exhaustive operation-to-quota map. -}
codeArtifactCosts :: [(RequestKind, Map QuotaDimension Rational)]
codeArtifactCosts :: [(RequestKind, Map QuotaDimension Rational)]
codeArtifactCosts =
    [ (RequestKind
ListingPage, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
NameListing, Rational
1), (QuotaDimension
AccountReads, Rational
1)])
    , (RequestKind
VersionPage, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
VersionListing, Rational
1), (QuotaDimension
AccountReads, Rational
1)])
    , (RequestKind
ManifestRead, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
AccountReads, Rational
1), (QuotaDimension
TokenReads, Rational
1)])
    , (RequestKind
PermissionRead, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
AccountReads, Rational
1)])
    , (RequestKind
CursorRead, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
AccountReads, Rational
1)])
    , (RequestKind
CursorWrite, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
AccountWrites, Rational
1)])
    , (RequestKind
DeleteBatch, [(QuotaDimension, Rational)] -> Map QuotaDimension Rational
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(QuotaDimension
AccountWrites, Rational
1)])
    ]

-- | The most versions one @DeletePackageVersions@ call accepts.
deleteCeiling :: DeleteCeiling
deleteCeiling :: DeleteCeiling
deleteCeiling = Int -> DeleteCeiling
AtMost Int
100

{- | The namespace and package CodeArtifact addresses a name by. An npm scope is the
namespace, without its sigil, and the unscoped name is the package.
-}
packageCoordinates :: PackageName -> (Maybe Text, Text)
packageCoordinates :: PackageName -> (Maybe Text, Text)
packageCoordinates PackageName
name = (Scope -> Text
unScope (Scope -> Text) -> Maybe Scope -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageName -> Maybe Scope
pkgNamespace PackageName
name, PackageName -> Text
unscopedName PackageName
name)

{- | Rebuild a name from the namespace and package a listing returned. A blank namespace
reads as none, so an empty string cannot become an empty scope.
-}
packageNameFrom :: Ecosystem -> Maybe Text -> Text -> PackageName
packageNameFrom :: Ecosystem -> Maybe Text -> Text -> PackageName
packageNameFrom Ecosystem
eco Maybe Text
namespace = Ecosystem -> Maybe Scope -> Text -> PackageName
mkPackageName Ecosystem
eco (Text -> Scope
mkScope (Text -> Scope) -> Maybe Text -> Maybe Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
nonBlank (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
namespace))

{- | One page of one bucket, continuing from a page token when there is one. @packagePrefix@
matches the package component alone and never a namespace, and the empty bucket filters nothing.
-}
listPackagesRequest :: CodeArtifactStore -> NamePrefix -> Maybe Text -> CA.ListPackages
listPackagesRequest :: CodeArtifactStore -> NamePrefix -> Maybe Text -> ListPackages
listPackagesRequest CodeArtifactStore
store NamePrefix
prefix Maybe Text
token =
    Text -> Text -> ListPackages
CA.newListPackages (CodeArtifactStore -> Text
casDomain CodeArtifactStore
store) (CodeArtifactStore -> Text
casRepository CodeArtifactStore
store)
        ListPackages -> (ListPackages -> ListPackages) -> ListPackages
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> ListPackages -> Identity ListPackages
Lens' ListPackages (Maybe Text)
CAL.listPackages_domainOwner ((Maybe Text -> Identity (Maybe Text))
 -> ListPackages -> Identity ListPackages)
-> Text -> ListPackages -> ListPackages
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CodeArtifactStore -> Text
casDomainOwner CodeArtifactStore
store)
        ListPackages -> (ListPackages -> ListPackages) -> ListPackages
forall a b. a -> (a -> b) -> b
& ((Maybe PackageFormat -> Identity (Maybe PackageFormat))
-> ListPackages -> Identity ListPackages
Lens' ListPackages (Maybe PackageFormat)
CAL.listPackages_format ((Maybe PackageFormat -> Identity (Maybe PackageFormat))
 -> ListPackages -> Identity ListPackages)
-> PackageFormat -> ListPackages -> ListPackages
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CodeArtifactStore -> PackageFormat
storePackageFormat CodeArtifactStore
store)
        ListPackages -> (ListPackages -> ListPackages) -> ListPackages
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> ListPackages -> Identity ListPackages
Lens' ListPackages (Maybe Text)
CAL.listPackages_packagePrefix ((Maybe Text -> Identity (Maybe Text))
 -> ListPackages -> Identity ListPackages)
-> Maybe Text -> ListPackages -> ListPackages
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Maybe Text
nonBlank (NamePrefix -> Text
renderNamePrefix NamePrefix
prefix))
        ListPackages -> (ListPackages -> ListPackages) -> ListPackages
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> ListPackages -> Identity ListPackages
Lens' ListPackages (Maybe Text)
CAL.listPackages_nextToken ((Maybe Text -> Identity (Maybe Text))
 -> ListPackages -> Identity ListPackages)
-> Maybe Text -> ListPackages -> ListPackages
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
token)

-- | List one page of a package's versions, continuing from a page token when there is one.
listVersionsRequest :: CodeArtifactStore -> PackageName -> Maybe Text -> CA.ListPackageVersions
listVersionsRequest :: CodeArtifactStore
-> PackageName -> Maybe Text -> ListPackageVersions
listVersionsRequest CodeArtifactStore
store PackageName
name Maybe Text
token =
    Text -> Text -> PackageFormat -> Text -> ListPackageVersions
CA.newListPackageVersions (CodeArtifactStore -> Text
casDomain CodeArtifactStore
store) (CodeArtifactStore -> Text
casRepository CodeArtifactStore
store) (CodeArtifactStore -> PackageFormat
storePackageFormat CodeArtifactStore
store) Text
package
        ListPackageVersions
-> (ListPackageVersions -> ListPackageVersions)
-> ListPackageVersions
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> ListPackageVersions -> Identity ListPackageVersions
Lens' ListPackageVersions (Maybe Text)
CAL.listPackageVersions_domainOwner ((Maybe Text -> Identity (Maybe Text))
 -> ListPackageVersions -> Identity ListPackageVersions)
-> Text -> ListPackageVersions -> ListPackageVersions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CodeArtifactStore -> Text
casDomainOwner CodeArtifactStore
store)
        ListPackageVersions
-> (ListPackageVersions -> ListPackageVersions)
-> ListPackageVersions
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> ListPackageVersions -> Identity ListPackageVersions
Lens' ListPackageVersions (Maybe Text)
CAL.listPackageVersions_namespace ((Maybe Text -> Identity (Maybe Text))
 -> ListPackageVersions -> Identity ListPackageVersions)
-> Maybe Text -> ListPackageVersions -> ListPackageVersions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
namespace)
        ListPackageVersions
-> (ListPackageVersions -> ListPackageVersions)
-> ListPackageVersions
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> ListPackageVersions -> Identity ListPackageVersions
Lens' ListPackageVersions (Maybe Text)
CAL.listPackageVersions_nextToken ((Maybe Text -> Identity (Maybe Text))
 -> ListPackageVersions -> Identity ListPackageVersions)
-> Maybe Text -> ListPackageVersions -> ListPackageVersions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
token)
  where
    (Maybe Text
namespace, Text
package) = PackageName -> (Maybe Text, Text)
packageCoordinates PackageName
name

-- | A missing package has an empty local inventory. Other service faults retain their retry advice.
listVersionsResult :: Either AWS.Error CA.ListPackageVersionsResponse -> Either StoreFault CA.ListPackageVersionsResponse
listVersionsResult :: Either Error ListPackageVersionsResponse
-> Either StoreFault ListPackageVersionsResponse
listVersionsResult = \case
    Left (AWS.ServiceError ServiceError
service)
        | ServiceError
service ServiceError
-> Getting ErrorCode ServiceError ErrorCode -> ErrorCode
forall s a. s -> Getting a s a -> a
^. Getting ErrorCode ServiceError ErrorCode
Lens' ServiceError ErrorCode
AWS.serviceError_code ErrorCode -> ErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ErrorCode
AWS.newErrorCode Text
"ResourceNotFoundException" ->
            ListPackageVersionsResponse
-> Either StoreFault ListPackageVersionsResponse
forall a b. b -> Either a b
Right (Int -> ListPackageVersionsResponse
CA.newListPackageVersionsResponse Int
200)
    Either Error ListPackageVersionsResponse
result -> (Error -> StoreFault)
-> Either Error ListPackageVersionsResponse
-> Either StoreFault ListPackageVersionsResponse
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Error -> StoreFault
classifyStoreFault Either Error ListPackageVersionsResponse
result

{- | Delete one chunk of a package's versions. The caller has already split the batch to
'deleteCeiling', because CodeArtifact refuses a larger one outright.
-}
deleteRequest :: CodeArtifactStore -> PackageName -> [Version] -> CA.DeletePackageVersions
deleteRequest :: CodeArtifactStore
-> PackageName -> [Version] -> DeletePackageVersions
deleteRequest CodeArtifactStore
store PackageName
name [Version]
versions =
    Text -> Text -> PackageFormat -> Text -> DeletePackageVersions
CA.newDeletePackageVersions (CodeArtifactStore -> Text
casDomain CodeArtifactStore
store) (CodeArtifactStore -> Text
casRepository CodeArtifactStore
store) (CodeArtifactStore -> PackageFormat
storePackageFormat CodeArtifactStore
store) Text
package
        DeletePackageVersions
-> (DeletePackageVersions -> DeletePackageVersions)
-> DeletePackageVersions
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> DeletePackageVersions -> Identity DeletePackageVersions
Lens' DeletePackageVersions (Maybe Text)
CAL.deletePackageVersions_domainOwner ((Maybe Text -> Identity (Maybe Text))
 -> DeletePackageVersions -> Identity DeletePackageVersions)
-> Text -> DeletePackageVersions -> DeletePackageVersions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CodeArtifactStore -> Text
casDomainOwner CodeArtifactStore
store)
        DeletePackageVersions
-> (DeletePackageVersions -> DeletePackageVersions)
-> DeletePackageVersions
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> DeletePackageVersions -> Identity DeletePackageVersions
Lens' DeletePackageVersions (Maybe Text)
CAL.deletePackageVersions_namespace ((Maybe Text -> Identity (Maybe Text))
 -> DeletePackageVersions -> Identity DeletePackageVersions)
-> Maybe Text -> DeletePackageVersions -> DeletePackageVersions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
namespace)
        DeletePackageVersions
-> (DeletePackageVersions -> DeletePackageVersions)
-> DeletePackageVersions
forall a b. a -> (a -> b) -> b
& (([Text] -> Identity [Text])
-> DeletePackageVersions -> Identity DeletePackageVersions
Lens' DeletePackageVersions [Text]
CAL.deletePackageVersions_versions (([Text] -> Identity [Text])
 -> DeletePackageVersions -> Identity DeletePackageVersions)
-> [Text] -> DeletePackageVersions -> DeletePackageVersions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Version -> Text) -> [Version] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Version -> Text
renderVersion [Version]
versions)
        DeletePackageVersions
-> (DeletePackageVersions -> DeletePackageVersions)
-> DeletePackageVersions
forall a b. a -> (a -> b) -> b
& ((Maybe PackageVersionStatus
 -> Identity (Maybe PackageVersionStatus))
-> DeletePackageVersions -> Identity DeletePackageVersions
Lens' DeletePackageVersions (Maybe PackageVersionStatus)
CAL.deletePackageVersions_expectedStatus ((Maybe PackageVersionStatus
  -> Identity (Maybe PackageVersionStatus))
 -> DeletePackageVersions -> Identity DeletePackageVersions)
-> PackageVersionStatus
-> DeletePackageVersions
-> DeletePackageVersions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PackageVersionStatus
CA.PackageVersionStatus_Published)
  where
    (Maybe Text
namespace, Text
package) = PackageName -> (Maybe Text, Text)
packageCoordinates PackageName
name

-- | Describe the repository, which carries both its ARN and its refill posture.
describeRepositoryRequest :: CodeArtifactStore -> CA.DescribeRepository
describeRepositoryRequest :: CodeArtifactStore -> DescribeRepository
describeRepositoryRequest CodeArtifactStore
store =
    Text -> Text -> DescribeRepository
CA.newDescribeRepository (CodeArtifactStore -> Text
casDomain CodeArtifactStore
store) (CodeArtifactStore -> Text
casRepository CodeArtifactStore
store)
        DescribeRepository
-> (DescribeRepository -> DescribeRepository) -> DescribeRepository
forall a b. a -> (a -> b) -> b
& ((Maybe Text -> Identity (Maybe Text))
-> DescribeRepository -> Identity DescribeRepository
Lens' DescribeRepository (Maybe Text)
CAL.describeRepository_domainOwner ((Maybe Text -> Identity (Maybe Text))
 -> DescribeRepository -> Identity DescribeRepository)
-> Text -> DescribeRepository -> DescribeRepository
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CodeArtifactStore -> Text
casDomainOwner CodeArtifactStore
store)

-- | Describe another repository in the same domain, which is how the probe walks a chain.
describeUpstreamRequest :: CodeArtifactStore -> RepositoryName -> CA.DescribeRepository
describeUpstreamRequest :: CodeArtifactStore -> RepositoryName -> DescribeRepository
describeUpstreamRequest CodeArtifactStore
store RepositoryName
repository =
    CodeArtifactStore -> DescribeRepository
describeRepositoryRequest CodeArtifactStore
store{casRepository = repositoryNameText repository}

-- | The repository a store's coordinates name, where a probe of its chain starts.
repositoryOfStore :: CodeArtifactStore -> RepositoryName
repositoryOfStore :: CodeArtifactStore -> RepositoryName
repositoryOfStore = Text -> RepositoryName
RepositoryName (Text -> RepositoryName)
-> (CodeArtifactStore -> Text)
-> CodeArtifactStore
-> RepositoryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeArtifactStore -> Text
casRepository

-- | Read a repository's tags, which is where CodeArtifact carries the consent marker.
listTagsRequest :: Text -> CA.ListTagsForResource
listTagsRequest :: Text -> ListTagsForResource
listTagsRequest = Text -> ListTagsForResource
CA.newListTagsForResource

{- | The one tag key the Dredger writes, per ecosystem, so two mounts sharing one repository as
their mirror target keep their own walk. The grant admits this prefix and nothing else.
-}
cursorTagKey :: Ecosystem -> Text
cursorTagKey :: Ecosystem -> Text
cursorTagKey Ecosystem
eco = Text
"ecluse-dredger-cursor-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco

{- | Record a completed bucket. @TagResource@ adds and updates the keys it names and replaces no
others, so this cannot disturb the consent tag beside it.
-}
cursorTagRequest :: Ecosystem -> Text -> NamePrefix -> CA.TagResource
cursorTagRequest :: Ecosystem -> Text -> NamePrefix -> TagResource
cursorTagRequest Ecosystem
eco Text
arn NamePrefix
prefix =
    Text -> TagResource
CA.newTagResource Text
arn
        TagResource -> (TagResource -> TagResource) -> TagResource
forall a b. a -> (a -> b) -> b
& (([Tag] -> Identity [Tag]) -> TagResource -> Identity TagResource
Lens' TagResource [Tag]
CAL.tagResource_tags (([Tag] -> Identity [Tag]) -> TagResource -> Identity TagResource)
-> [Tag] -> TagResource -> TagResource
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Text -> Tag
CA.newTag (Ecosystem -> Text
cursorTagKey Ecosystem
eco) (NamePrefix -> Text
renderNamePrefix NamePrefix
prefix)])

-- | Forget the walk, which a completed one does.
cursorUntagRequest :: Ecosystem -> Text -> CA.UntagResource
cursorUntagRequest :: Ecosystem -> Text -> UntagResource
cursorUntagRequest Ecosystem
eco Text
arn =
    Text -> UntagResource
CA.newUntagResource Text
arn UntagResource -> (UntagResource -> UntagResource) -> UntagResource
forall a b. a -> (a -> b) -> b
& (([Text] -> Identity [Text])
-> UntagResource -> Identity UntagResource
Lens' UntagResource [Text]
CAL.untagResource_tagKeys (([Text] -> Identity [Text])
 -> UntagResource -> Identity UntagResource)
-> [Text] -> UntagResource -> UntagResource
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Ecosystem -> Text
cursorTagKey Ecosystem
eco])

{- | The bucket a repository's tags record, 'Nothing' when none is recorded or when the recorded
one is no prefix this alphabet spells, which is how an alphabet change restarts the walk.
-}
cursorOfTags :: NameAlphabet -> Ecosystem -> [CA.Tag] -> Maybe NamePrefix
cursorOfTags :: NameAlphabet -> Ecosystem -> [Tag] -> Maybe NamePrefix
cursorOfTags NameAlphabet
alphabet Ecosystem
eco [Tag]
tags = do
    tag <- (Tag -> Bool) -> [Tag] -> Maybe Tag
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Ecosystem -> Text
cursorTagKey Ecosystem
eco) (Text -> Bool) -> (Tag -> Text) -> Tag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag -> Getting Text Tag Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Tag Text
Lens' Tag Text
CAL.tag_key)) [Tag]
tags
    parseNamePrefix alphabet =<< nonBlank (tag ^. CAL.tag_value)

{- | The description @DescribeRepository@ carried. It is optional on the wire, and a verdict
on a repository the store did not describe would be invented rather than read.
-}
repositoryOfResponse :: CA.DescribeRepositoryResponse -> Either StoreFault CA.RepositoryDescription
repositoryOfResponse :: DescribeRepositoryResponse
-> Either StoreFault RepositoryDescription
repositoryOfResponse DescribeRepositoryResponse
response =
    StoreFault
-> Maybe RepositoryDescription
-> Either StoreFault RepositoryDescription
forall l r. l -> Maybe r -> Either l r
maybeToRight
        (Text -> StoreFault
descriptionFault Text
"the store described no repository")
        (DescribeRepositoryResponse
response DescribeRepositoryResponse
-> Getting
     (Maybe RepositoryDescription)
     DescribeRepositoryResponse
     (Maybe RepositoryDescription)
-> Maybe RepositoryDescription
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe RepositoryDescription)
  DescribeRepositoryResponse
  (Maybe RepositoryDescription)
Lens' DescribeRepositoryResponse (Maybe RepositoryDescription)
CAL.describeRepositoryResponse_repository)

{- | The repository ARN, which is how CodeArtifact addresses a tag read. It is optional on
the wire, and without it there is no marker to read and so no verdict to give.
-}
arnOfDescription :: CA.RepositoryDescription -> Either StoreFault Text
arnOfDescription :: RepositoryDescription -> Either StoreFault Text
arnOfDescription RepositoryDescription
description =
    StoreFault -> Maybe Text -> Either StoreFault Text
forall l r. l -> Maybe r -> Either l r
maybeToRight
        (Text -> StoreFault
descriptionFault Text
"the store described the repository without an ARN")
        (Text -> Maybe Text
nonBlank (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RepositoryDescription
description RepositoryDescription
-> Getting (Maybe Text) RepositoryDescription (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) RepositoryDescription (Maybe Text)
Lens' RepositoryDescription (Maybe Text)
CAL.repositoryDescription_arn)

-- A description that answers nothing is a protocol fault, and a second call reads the same.
descriptionFault :: Text -> StoreFault
descriptionFault :: Text -> StoreFault
descriptionFault Text
detail =
    StoreFault
        { faultTransport :: TransportFault
faultTransport = TransportCause -> Text -> TransportFault
transportFault TransportCause
TransportProtocol Text
detail
        , faultRetry :: RetryAdvice
faultRetry = RetryAdvice
RetryFutile
        }

{- | The names in one listing page. CodeArtifact types a summary's package name optional,
and an entry without one names nothing to sweep, so it is dropped rather than guessed at.
-}
packagesOfPage :: Ecosystem -> [CA.PackageSummary] -> [PackageName]
packagesOfPage :: Ecosystem -> [PackageSummary] -> [PackageName]
packagesOfPage Ecosystem
eco = (PackageSummary -> Maybe PackageName)
-> [PackageSummary] -> [PackageName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PackageSummary -> Maybe PackageName
named
  where
    named :: PackageSummary -> Maybe PackageName
named PackageSummary
summary =
        Ecosystem -> Maybe Text -> Text -> PackageName
packageNameFrom Ecosystem
eco (PackageSummary
summary PackageSummary
-> Getting (Maybe Text) PackageSummary (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PackageSummary (Maybe Text)
Lens' PackageSummary (Maybe Text)
CAL.packageSummary_namespace)
            (Text -> PackageName) -> Maybe Text -> Maybe PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
nonBlank (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PackageSummary
summary PackageSummary
-> Getting (Maybe Text) PackageSummary (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PackageSummary (Maybe Text)
Lens' PackageSummary (Maybe Text)
CAL.packageSummary_package)

{- | Whether the store still serves an install of a version in this status. @Published@ and
@Unlisted@ are the two statuses it does, and every other status is a record it keeps.
-}
presenceOf :: CA.PackageVersionStatus -> VersionPresence
presenceOf :: PackageVersionStatus -> VersionPresence
presenceOf PackageVersionStatus
status
    | PackageVersionStatus
status PackageVersionStatus -> PackageVersionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== PackageVersionStatus
CA.PackageVersionStatus_Published = VersionPresence
VersionServed
    | PackageVersionStatus
status PackageVersionStatus -> PackageVersionStatus -> Bool
forall a. Eq a => a -> a -> Bool
== PackageVersionStatus
CA.PackageVersionStatus_Unlisted = VersionPresence
VersionServed
    | Bool
otherwise = VersionPresence
VersionWithdrawn

{- | Read a delete response back against the versions submitted, so each gets one outcome.
CodeArtifact may report a version neither way, which is a refusal, never a silent success.
-}
foldDeleteResponse :: [Version] -> CA.DeletePackageVersionsResponse -> [(Version, VersionOutcome)]
foldDeleteResponse :: [Version]
-> DeletePackageVersionsResponse -> [(Version, VersionOutcome)]
foldDeleteResponse [Version]
submitted DeletePackageVersionsResponse
response =
    [(Version
version, Text -> VersionOutcome
outcomeOf (Version -> Text
renderVersion Version
version)) | Version
version <- [Version]
submitted]
  where
    failures :: HashMap Text PackageVersionError
failures = HashMap Text PackageVersionError
-> Maybe (HashMap Text PackageVersionError)
-> HashMap Text PackageVersionError
forall a. a -> Maybe a -> a
fromMaybe HashMap Text PackageVersionError
forall k v. HashMap k v
HM.empty (DeletePackageVersionsResponse
response DeletePackageVersionsResponse
-> Getting
     (Maybe (HashMap Text PackageVersionError))
     DeletePackageVersionsResponse
     (Maybe (HashMap Text PackageVersionError))
-> Maybe (HashMap Text PackageVersionError)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (HashMap Text PackageVersionError))
  DeletePackageVersionsResponse
  (Maybe (HashMap Text PackageVersionError))
Lens'
  DeletePackageVersionsResponse
  (Maybe (HashMap Text PackageVersionError))
CAL.deletePackageVersionsResponse_failedVersions)
    successes :: HashMap Text SuccessfulPackageVersionInfo
successes = HashMap Text SuccessfulPackageVersionInfo
-> Maybe (HashMap Text SuccessfulPackageVersionInfo)
-> HashMap Text SuccessfulPackageVersionInfo
forall a. a -> Maybe a -> a
fromMaybe HashMap Text SuccessfulPackageVersionInfo
forall k v. HashMap k v
HM.empty (DeletePackageVersionsResponse
response DeletePackageVersionsResponse
-> Getting
     (Maybe (HashMap Text SuccessfulPackageVersionInfo))
     DeletePackageVersionsResponse
     (Maybe (HashMap Text SuccessfulPackageVersionInfo))
-> Maybe (HashMap Text SuccessfulPackageVersionInfo)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (HashMap Text SuccessfulPackageVersionInfo))
  DeletePackageVersionsResponse
  (Maybe (HashMap Text SuccessfulPackageVersionInfo))
Lens'
  DeletePackageVersionsResponse
  (Maybe (HashMap Text SuccessfulPackageVersionInfo))
CAL.deletePackageVersionsResponse_successfulVersions)

    outcomeOf :: Text -> VersionOutcome
outcomeOf Text
raw = case Text
-> HashMap Text PackageVersionError -> Maybe PackageVersionError
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
raw HashMap Text PackageVersionError
failures of
        Just PackageVersionError
failure -> StoreRefusal -> VersionOutcome
VersionRefused (PackageVersionError -> StoreRefusal
refusalOf PackageVersionError
failure)
        Maybe PackageVersionError
Nothing
            | Text -> HashMap Text SuccessfulPackageVersionInfo -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member Text
raw HashMap Text SuccessfulPackageVersionInfo
successes -> VersionOutcome
VersionRemoved
            | Bool
otherwise ->
                StoreRefusal -> VersionOutcome
VersionRefused
                    (Text -> Text -> StoreRefusal
storeRefusal Text
"UNREPORTED" Text
"the store answered with no outcome for this version")

-- The error code an operator looks up, with CodeArtifact's own message beside it.
refusalOf :: CA.PackageVersionError -> StoreRefusal
refusalOf :: PackageVersionError -> StoreRefusal
refusalOf PackageVersionError
failure =
    Text -> Text -> StoreRefusal
storeRefusal
        (Text
-> (PackageVersionErrorCode -> Text)
-> Maybe PackageVersionErrorCode
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"UNKNOWN" PackageVersionErrorCode -> Text
CA.fromPackageVersionErrorCode (PackageVersionError
failure PackageVersionError
-> Getting
     (Maybe PackageVersionErrorCode)
     PackageVersionError
     (Maybe PackageVersionErrorCode)
-> Maybe PackageVersionErrorCode
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe PackageVersionErrorCode)
  PackageVersionError
  (Maybe PackageVersionErrorCode)
Lens' PackageVersionError (Maybe PackageVersionErrorCode)
CAL.packageVersionError_errorCode))
        (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (PackageVersionError
failure PackageVersionError
-> Getting (Maybe Text) PackageVersionError (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) PackageVersionError (Maybe Text)
Lens' PackageVersionError (Maybe Text)
CAL.packageVersionError_errorMessage))

{- | Whether deleting from this repository destroys anything. An external connection or an
upstream serves a deleted version again from elsewhere, so neither is worth sweeping.
-}
classifyRepository :: CA.RepositoryDescription -> StoreClass
classifyRepository :: RepositoryDescription -> StoreClass
classifyRepository RepositoryDescription
description
    | Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
connections) =
        Text -> StoreClass
StorePreserved
            ( Text
"the repository has an external connection ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
connections
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"), which serves a deleted version again on the next request"
            )
    | Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
upstreams) =
        Text -> StoreClass
StorePreserved
            ( Text
"the repository has an upstream ("
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
upstreams
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"), which serves a deleted version from another repository"
            )
    | Bool
otherwise = StoreClass
StoreDestroyable
  where
    links :: RepositoryLinks
links = RepositoryDescription -> RepositoryLinks
upstreamLinksOf RepositoryDescription
description
    connections :: [Text]
connections = (ExternalConnection -> Text) -> [ExternalConnection] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ExternalConnection -> Text
externalConnectionText (RepositoryLinks -> [ExternalConnection]
rlConnections RepositoryLinks
links)
    upstreams :: [Text]
upstreams = (RepositoryName -> Text) -> [RepositoryName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map RepositoryName -> Text
repositoryNameText (RepositoryLinks -> [RepositoryName]
rlUpstreams RepositoryLinks
links)

{- | What one description says about the content it admits: the public registries it connects to,
and the repositories it forwards a miss to. An entry the store named nothing in carries no name.
-}
upstreamLinksOf :: CA.RepositoryDescription -> RepositoryLinks
upstreamLinksOf :: RepositoryDescription -> RepositoryLinks
upstreamLinksOf RepositoryDescription
description =
    RepositoryLinks
        { rlConnections :: [ExternalConnection]
rlConnections =
            (Text -> ExternalConnection) -> [Text] -> [ExternalConnection]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ExternalConnection
ExternalConnection ([Text] -> [ExternalConnection])
-> ([RepositoryExternalConnectionInfo] -> [Text])
-> [RepositoryExternalConnectionInfo]
-> [ExternalConnection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RepositoryExternalConnectionInfo -> Maybe Text)
-> [RepositoryExternalConnectionInfo] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (RepositoryExternalConnectionInfo
-> Getting
     (Maybe Text) RepositoryExternalConnectionInfo (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) RepositoryExternalConnectionInfo (Maybe Text)
Lens' RepositoryExternalConnectionInfo (Maybe Text)
CAL.repositoryExternalConnectionInfo_externalConnectionName) ([RepositoryExternalConnectionInfo] -> [ExternalConnection])
-> [RepositoryExternalConnectionInfo] -> [ExternalConnection]
forall a b. (a -> b) -> a -> b
$
                [RepositoryExternalConnectionInfo]
-> Maybe [RepositoryExternalConnectionInfo]
-> [RepositoryExternalConnectionInfo]
forall a. a -> Maybe a -> a
fromMaybe [] (RepositoryDescription
description RepositoryDescription
-> Getting
     (Maybe [RepositoryExternalConnectionInfo])
     RepositoryDescription
     (Maybe [RepositoryExternalConnectionInfo])
-> Maybe [RepositoryExternalConnectionInfo]
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe [RepositoryExternalConnectionInfo])
  RepositoryDescription
  (Maybe [RepositoryExternalConnectionInfo])
Lens'
  RepositoryDescription (Maybe [RepositoryExternalConnectionInfo])
CAL.repositoryDescription_externalConnections)
        , rlUpstreams :: [RepositoryName]
rlUpstreams =
            (Text -> RepositoryName) -> [Text] -> [RepositoryName]
forall a b. (a -> b) -> [a] -> [b]
map Text -> RepositoryName
RepositoryName ([Text] -> [RepositoryName])
-> ([UpstreamRepositoryInfo] -> [Text])
-> [UpstreamRepositoryInfo]
-> [RepositoryName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UpstreamRepositoryInfo -> Maybe Text)
-> [UpstreamRepositoryInfo] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (UpstreamRepositoryInfo
-> Getting (Maybe Text) UpstreamRepositoryInfo (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) UpstreamRepositoryInfo (Maybe Text)
Lens' UpstreamRepositoryInfo (Maybe Text)
CAL.upstreamRepositoryInfo_repositoryName) ([UpstreamRepositoryInfo] -> [RepositoryName])
-> [UpstreamRepositoryInfo] -> [RepositoryName]
forall a b. (a -> b) -> a -> b
$
                [UpstreamRepositoryInfo]
-> Maybe [UpstreamRepositoryInfo] -> [UpstreamRepositoryInfo]
forall a. a -> Maybe a -> a
fromMaybe [] (RepositoryDescription
description RepositoryDescription
-> Getting
     (Maybe [UpstreamRepositoryInfo])
     RepositoryDescription
     (Maybe [UpstreamRepositoryInfo])
-> Maybe [UpstreamRepositoryInfo]
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe [UpstreamRepositoryInfo])
  RepositoryDescription
  (Maybe [UpstreamRepositoryInfo])
Lens' RepositoryDescription (Maybe [UpstreamRepositoryInfo])
CAL.repositoryDescription_upstreams)
        }

-- | The tag key that carries the operator's consent on CodeArtifact.
consentTagKey :: Text
consentTagKey :: Text
consentTagKey = Text
"ecluse-dredger-consent"

-- | The value that key must hold for consent to count.
consentTagValue :: Text
consentTagValue :: Text
consentTagValue = Text
"true"

-- | How an operator attaches the marker, logged verbatim when consent is withheld.
consentDescriptor :: Text
consentDescriptor :: Text
consentDescriptor =
    Text
"attach the tag "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
consentTagKey
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
consentTagValue
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to the mirror repository in CodeArtifact: the Dredger deletes nothing from a store that does not carry it"

-- | Whether a repository's tags carry the consent marker.
consentOfTags :: [CA.Tag] -> ConsentVerdict
consentOfTags :: [Tag] -> ConsentVerdict
consentOfTags [Tag]
tags
    | (Tag -> Bool) -> [Tag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Tag -> Bool
marker [Tag]
tags = ConsentVerdict
ConsentGranted
    | Bool
otherwise = Text -> ConsentVerdict
ConsentWithheld Text
consentDescriptor
  where
    marker :: Tag -> Bool
marker Tag
tag =
        Tag
tag Tag -> Getting Text Tag Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Tag Text
Lens' Tag Text
CAL.tag_key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
consentTagKey Bool -> Bool -> Bool
&& Tag
tag Tag -> Getting Text Tag Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Tag Text
Lens' Tag Text
CAL.tag_value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
consentTagValue

{- | Classify an @amazonka@ error for a maintenance call, refining the shared transport
classification, which reports a throttle and a denied permission as the same fault.
-}
classifyStoreFault :: AWS.Error -> StoreFault
classifyStoreFault :: Error -> StoreFault
classifyStoreFault Error
err =
    StoreFault{faultTransport :: TransportFault
faultTransport = TransportFault
fault, faultRetry :: RetryAdvice
faultRetry = RetryAdvice
advice}
  where
    fault :: TransportFault
fault = Error -> TransportFault
classifyAwsTransport Error
err
    advice :: RetryAdvice
advice = case Error
err of
        AWS.ServiceError ServiceError
service -> ServiceError -> RetryAdvice
serviceRetryAdvice ServiceError
service
        Error
_ | TransportCause -> Bool
transportRetryable (TransportFault -> TransportCause
tfCause TransportFault
fault) -> RetryAdvice
RetryWorthwhile
        Error
_ -> RetryAdvice
RetryFutile

{- | Read a failed probe read. An identity that may not ask cannot clear the repository, so its
refusal is an unsafe answer rather than a fault, and every other failure leaves the question open.
-}
describeUpstreamRefusal :: AWS.Error -> UpstreamSafety
describeUpstreamRefusal :: Error -> UpstreamSafety
describeUpstreamRefusal = \case
    AWS.ServiceError ServiceError
service
        | ErrorCode -> Bool
isAccessDeniedCode (ServiceError
service ServiceError
-> Getting ErrorCode ServiceError ErrorCode -> ErrorCode
forall s a. s -> Getting a s a -> a
^. Getting ErrorCode ServiceError ErrorCode
Lens' ServiceError ErrorCode
AWS.serviceError_code) ->
            UnsafeReason -> UpstreamSafety
Unsafe (PermissionName -> UnsafeReason
InsufficientPermissions PermissionName
describeRepositoryGrant)
    Error
_ -> UndecidabilityReason -> UpstreamSafety
Undecidable UndecidabilityReason
NetworkFailure

-- | The grant the probe needs on the private upstream and on every repository in its chain.
describeRepositoryGrant :: PermissionName
describeRepositoryGrant :: PermissionName
describeRepositoryGrant = Text -> PermissionName
PermissionName Text
"codeartifact:DescribeRepository"

-- A refusal of the identity itself, rather than of the request it carried.
isAccessDeniedCode :: AWS.ErrorCode -> Bool
isAccessDeniedCode :: ErrorCode -> Bool
isAccessDeniedCode ErrorCode
code = ErrorCode -> Text
errorCodeText ErrorCode
code Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
accessDeniedCodes

accessDeniedCodes :: [Text]
accessDeniedCodes :: [Text]
accessDeniedCodes =
    [ Text
"accessdenied"
    , Text
"unauthorized"
    , Text
"unrecognizedclient"
    , Text
"invalidclienttokenid"
    , Text
"missingauthenticationtoken"
    ]

{- A throttle and a server-side failure clear on their own. Every other refusal (a denied
permission, a missing repository, a malformed request) fails the same way next time. -}
serviceRetryAdvice :: AWS.ServiceError -> RetryAdvice
serviceRetryAdvice :: ServiceError -> RetryAdvice
serviceRetryAdvice ServiceError
service
    | Bool
throttled Bool -> Bool -> Bool
|| Bool
serverSide = RetryAdvice
-> (RetryAfter -> RetryAdvice) -> Maybe RetryAfter -> RetryAdvice
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RetryAdvice
RetryWorthwhile RetryAfter -> RetryAdvice
RetryDelayed ([Header] -> Maybe RetryAfter
retryAfterSeconds [Header]
headers)
    | Bool
otherwise = RetryAdvice
RetryFutile
  where
    headers :: [Header]
headers = ServiceError
service ServiceError -> Getting [Header] ServiceError [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] ServiceError [Header]
Lens' ServiceError [Header]
AWS.serviceError_headers
    status :: Int
status = Status -> Int
statusCode (ServiceError
service ServiceError -> Getting Status ServiceError Status -> Status
forall s a. s -> Getting a s a -> a
^. Getting Status ServiceError Status
Lens' ServiceError Status
AWS.serviceError_status)
    serverSide :: Bool
serverSide = Int
status Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500
    throttled :: Bool
throttled = Int
status Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
429 Bool -> Bool -> Bool
|| ErrorCode -> Bool
isThrottlingCode (ServiceError
service ServiceError
-> Getting ErrorCode ServiceError ErrorCode -> ErrorCode
forall s a. s -> Getting a s a -> a
^. Getting ErrorCode ServiceError ErrorCode
Lens' ServiceError ErrorCode
AWS.serviceError_code)

{- @amazonka@ strips the @Exception@ suffix from a service's error code, so
@ThrottlingException@ arrives as @Throttling@. -}
isThrottlingCode :: AWS.ErrorCode -> Bool
isThrottlingCode :: ErrorCode -> Bool
isThrottlingCode ErrorCode
code = ErrorCode -> Text
errorCodeText ErrorCode
code Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
throttlingCodes

-- Lowercased, so no comparison here turns on a service's own casing.
errorCodeText :: AWS.ErrorCode -> Text
errorCodeText :: ErrorCode -> Text
errorCodeText (AWS.ErrorCode Text
code) = Text -> Text
T.toLower Text
code

throttlingCodes :: [Text]
throttlingCodes :: [Text]
throttlingCodes =
    [ Text
"throttling"
    , Text
"throttled"
    , Text
"toomanyrequests"
    , Text
"requestthrottled"
    , Text
"requestlimitexceeded"
    , Text
"slowdown"
    , Text
"provisionedthroughputexceeded"
    ]

{- Only the delta-seconds form of @Retry-After@ is read, because turning its HTTP-date form
into a delay needs the current time and this stays pure. -}
retryAfterSeconds :: [Header] -> Maybe RetryAfter
retryAfterSeconds :: [Header] -> Maybe RetryAfter
retryAfterSeconds [Header]
headers = do
    raw <- ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (Header -> ByteString) -> Header -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> ByteString
forall a b. (a, b) -> b
snd (Header -> Text) -> Maybe Header -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Header -> Bool) -> [Header] -> Maybe Header
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
hRetryAfter) (HeaderName -> Bool) -> (Header -> HeaderName) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> HeaderName
forall a b. (a, b) -> a
fst) [Header]
headers
    RetryAfter <$> readDecimalText raw