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

{- | The control-plane record and the handle bodies behind
"Ecluse.Runtime.Maintenance.CodeArtifact", which documents the leaf 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.Internal (
    newCodeArtifactMaintenance,
    newCodeArtifactObservation,
    newCodeArtifactUpstreamProbe,
    newCodeArtifactCacheMaintenance,
    newCodeArtifactCacheObservation,
    cacheMaintenanceFor,

    -- * The calls the handle makes
    ControlPlane (..),
    controlPlaneFor,
    maintenanceFor,
    observationFor,
    boundedObservationFor,
    probeUpstreamSafety,
) where

import Amazonka qualified as AWS
import Amazonka.CodeArtifact qualified as CA
import Amazonka.CodeArtifact.Lens qualified as CAL
import Ecluse.Core.Registry.Exchange (singleAttemptSettings)
import Lens.Micro ((^.))
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import UnliftIO (tryAny)

import Ecluse.Core.Ecosystem (Ecosystem)
import Ecluse.Core.Package (PackageName)
import Ecluse.Core.Registry.Maintenance (
    ConsentVerdict,
    DeleteGuard,
    StoreClass (StoreDestroyable),
    StoreCursor (..),
    StoreDeletion (..),
    StoreFault,
    StoreMaintenance (..),
    StoreManifestRead,
    StoreObservation (..),
    StoredVersion,
    VersionOutcome,
    chunksOfCeiling,
    collectPagesBounded,
    deleteAll,
    maintenanceOf,
    pageAll,
    pageSource,
 )
import Ecluse.Core.Registry.Maintenance.NameSpace (
    NameAlphabet,
    NamePrefix,
 )
import Ecluse.Core.Registry.Maintenance.Upstream (
    RepositoryLinks,
    UndecidabilityReason (NetworkFailure),
    UnsafeReason (InsufficientPermissions),
    UpstreamSafety (Undecidable, Unsafe),
    walkUpstreamChain,
 )
import Ecluse.Core.Version (Version)
import Ecluse.Runtime.Aws.Env (newAwsEnv)
import Ecluse.Runtime.Aws.Fault (sendClassified)
import Ecluse.Runtime.Maintenance.CodeArtifact.Decide (
    CodeArtifactStore (..),
    arnOfDescription,
    classifyRepository,
    classifyStoreFault,
    codeArtifactFacts,
    consentOfTags,
    cursorOfTags,
    cursorTagRequest,
    cursorUntagRequest,
    deleteCeiling,
    deleteRequest,
    describeRepositoryGrant,
    describeRepositoryRequest,
    describeUpstreamRefusal,
    describeUpstreamRequest,
    foldDeleteResponse,
    formatEcosystem,
    listPackagesRequest,
    listTagsRequest,
    listVersionsRequest,
    listVersionsResult,
    packagesOfPage,
    repositoryOfResponse,
    repositoryOfStore,
    upstreamLinksOf,
 )
import Ecluse.Runtime.Maintenance.CodeArtifact.Read (
    ReadPlane (..),
    identityOfStore,
    versionsOfPage,
 )

{- | The control-plane calls this leaf makes, so the sequencing around them is drivable from
response values of @amazonka@'s own types. The reads are held apart from the writes.
-}
data ControlPlane = ControlPlane
    { ControlPlane -> ReadPlane
cpRead :: ReadPlane
    , ControlPlane
-> DeletePackageVersions
-> IO (Either StoreFault DeletePackageVersionsResponse)
cpDeleteVersions :: CA.DeletePackageVersions -> IO (Either StoreFault CA.DeletePackageVersionsResponse)
    , ControlPlane
-> TagResource -> IO (Either StoreFault TagResourceResponse)
cpTagResource :: CA.TagResource -> IO (Either StoreFault CA.TagResourceResponse)
    , ControlPlane
-> UntagResource -> IO (Either StoreFault UntagResourceResponse)
cpUntagResource :: CA.UntagResource -> IO (Either StoreFault CA.UntagResourceResponse)
    }

{- | Build the maintenance handle for one CodeArtifact repository, over an environment whose AWS
credentials are discovered the standard way.
-}
newCodeArtifactMaintenance :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> IO StoreMaintenance
newCodeArtifactMaintenance :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> IO StoreMaintenance
newCodeArtifactMaintenance Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store = do
    env <- CodeArtifactStore -> IO Env
newMaintenanceEnv CodeArtifactStore
store
    boundedMaintenance limit alphabet readManifest store <$> controlPlaneFor env

{- | Build the observing calls alone for one repository, over an environment discovered the same
way. No deletion, no tag write, and no publication is built, so the caller holds none.
-}
newCodeArtifactObservation :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> IO StoreObservation
newCodeArtifactObservation :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> IO StoreObservation
newCodeArtifactObservation Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store =
    Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ReadPlane
-> StoreObservation
boundedObservationFor Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store (ReadPlane -> StoreObservation)
-> (Env -> ReadPlane) -> Env -> StoreObservation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> ReadPlane
readPlaneFor (Env -> StoreObservation) -> IO Env -> IO StoreObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeArtifactStore -> IO Env
newMaintenanceEnv CodeArtifactStore
store

{- | Probe one repository's chain over an environment discovered the standard way, for a role
that holds no maintenance handle for the repository it serves private content from.
-}
newCodeArtifactUpstreamProbe :: CodeArtifactStore -> IO UpstreamSafety
newCodeArtifactUpstreamProbe :: CodeArtifactStore -> IO UpstreamSafety
newCodeArtifactUpstreamProbe CodeArtifactStore
store = IO UpstreamSafety -> IO UpstreamSafety
withReadableIdentity (IO UpstreamSafety -> IO UpstreamSafety)
-> IO UpstreamSafety -> IO UpstreamSafety
forall a b. (a -> b) -> a -> b
$ do
    -- This wrap covers the environment build. The walk below carries its own, for a caller
    -- holding a plane this never built.
    env <- CodeArtifactStore -> IO Env
newMaintenanceEnv CodeArtifactStore
store
    probeUpstreamSafety (readPlaneFor env) store

-- | Build cache deletion with target-local reads and consent, allowing its declared refill role.
newCodeArtifactCacheMaintenance :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> IO StoreMaintenance
newCodeArtifactCacheMaintenance :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> IO StoreMaintenance
newCodeArtifactCacheMaintenance Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store = do
    env <- CodeArtifactStore -> IO Env
newMaintenanceEnv CodeArtifactStore
store
    plane <- controlPlaneFor env
    pure (cacheMaintenanceFor limit alphabet readManifest store plane)

-- | Observe the configured cache under its distinct refill classification without constructing writes.
newCodeArtifactCacheObservation :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> IO StoreObservation
newCodeArtifactCacheObservation :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> IO StoreObservation
newCodeArtifactCacheObservation Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store = do
    env <- CodeArtifactStore -> IO Env
newMaintenanceEnv CodeArtifactStore
store
    let readCalls = Env -> ReadPlane
readPlaneFor Env
env
    pure (boundedObservationFor limit alphabet readManifest store readCalls){obClassifyStore = cacheClassification readCalls store}

-- | Build the configured cache capability over injected calls without relaxing the mirror constructor.
cacheMaintenanceFor :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> ControlPlane -> StoreMaintenance
cacheMaintenanceFor :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ControlPlane
-> StoreMaintenance
cacheMaintenanceFor Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ControlPlane
plane =
    (Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ControlPlane
-> StoreMaintenance
boundedMaintenance Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ControlPlane
plane){classifyStore = cacheClassification (cpRead plane) store, storeCursor = Nothing}

boundedMaintenance :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> ControlPlane -> StoreMaintenance
boundedMaintenance :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ControlPlane
-> StoreMaintenance
boundedMaintenance Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ControlPlane
plane =
    (NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ControlPlane
-> StoreMaintenance
maintenanceFor NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ControlPlane
plane)
        { enumerateVersions = obEnumerateVersions (boundedObservationFor limit alphabet readManifest store (cpRead plane))
        }

cacheClassification :: ReadPlane -> CodeArtifactStore -> IO (Either StoreFault StoreClass)
cacheClassification :: ReadPlane -> CodeArtifactStore -> IO (Either StoreFault StoreClass)
cacheClassification ReadPlane
readCalls CodeArtifactStore
store = (RepositoryDescription -> StoreClass)
-> Either StoreFault RepositoryDescription
-> Either StoreFault StoreClass
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StoreClass -> RepositoryDescription -> StoreClass
forall a b. a -> b -> a
const StoreClass
StoreDestroyable) (Either StoreFault RepositoryDescription
 -> Either StoreFault StoreClass)
-> IO (Either StoreFault RepositoryDescription)
-> IO (Either StoreFault StoreClass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> CodeArtifactStore
-> IO (Either StoreFault RepositoryDescription)
describeStore ReadPlane
readCalls CodeArtifactStore
store

{- The env every maintenance call is sent over. Its manager drops http-client's hidden replay on a
reused connection, so an attempt the SDK did not make is not made below it either. -}
newMaintenanceEnv :: CodeArtifactStore -> IO AWS.Env
newMaintenanceEnv :: CodeArtifactStore -> IO Env
newMaintenanceEnv CodeArtifactStore
store = do
    env <- Maybe Text -> Maybe AwsEndpoint -> Service -> IO Env
newAwsEnv (Text -> Maybe Text
forall a. a -> Maybe a
Just (CodeArtifactStore -> Text
casRegion CodeArtifactStore
store)) Maybe AwsEndpoint
forall a. Maybe a
Nothing Service
CA.defaultService
    manager <- newManager (singleAttemptSettings tlsManagerSettings)
    pure env{AWS.manager = manager}

-- | Every call sent over one env, with the AWS error folded into a 'StoreFault'.
controlPlaneFor :: AWS.Env -> IO ControlPlane
controlPlaneFor :: Env -> IO ControlPlane
controlPlaneFor Env
env = do
    deletionManager <- ManagerSettings -> IO Manager
newManager (ManagerSettings -> ManagerSettings
singleAttemptSettings ManagerSettings
tlsManagerSettings)
    pure
        ControlPlane
            { cpRead = readPlaneFor env
            , cpDeleteVersions = sendStore (AWS.once env{AWS.retryCheck = \Int
_ HttpException
_ -> Bool
False, AWS.manager = deletionManager})
            , cpTagResource = sendStore env
            , cpUntagResource = sendStore env
            }

-- The observing calls alone, over one env, so a caller handed these can change nothing.
readPlaneFor :: AWS.Env -> ReadPlane
readPlaneFor :: Env -> ReadPlane
readPlaneFor Env
env =
    ReadPlane
        { rpListPackages :: ListPackages -> IO (Either StoreFault ListPackagesResponse)
rpListPackages = Env
-> ListPackages
-> IO (Either StoreFault (AWSResponse ListPackages))
forall a.
AWSRequest a =>
Env -> a -> IO (Either StoreFault (AWSResponse a))
sendStore Env
env
        , rpListVersions :: ListPackageVersions
-> IO (Either StoreFault ListPackageVersionsResponse)
rpListVersions = (Either Error ListPackageVersionsResponse
 -> Either StoreFault ListPackageVersionsResponse)
-> IO (Either Error ListPackageVersionsResponse)
-> IO (Either StoreFault ListPackageVersionsResponse)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Error ListPackageVersionsResponse
-> Either StoreFault ListPackageVersionsResponse
listVersionsResult (IO (Either Error ListPackageVersionsResponse)
 -> IO (Either StoreFault ListPackageVersionsResponse))
-> (ListPackageVersions
    -> IO (Either Error ListPackageVersionsResponse))
-> ListPackageVersions
-> IO (Either StoreFault ListPackageVersionsResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error -> Error)
-> Env
-> ListPackageVersions
-> IO (Either Error (AWSResponse ListPackageVersions))
forall a e.
AWSRequest a =>
(Error -> e) -> Env -> a -> IO (Either e (AWSResponse a))
sendClassified Error -> Error
forall a. a -> a
id Env
env
        , rpDescribeRepository :: DescribeRepository
-> IO (Either StoreFault DescribeRepositoryResponse)
rpDescribeRepository = Env
-> DescribeRepository
-> IO (Either StoreFault (AWSResponse DescribeRepository))
forall a.
AWSRequest a =>
Env -> a -> IO (Either StoreFault (AWSResponse a))
sendStore Env
env
        , rpDescribeUpstream :: DescribeRepository
-> IO (Either UpstreamSafety DescribeRepositoryResponse)
rpDescribeUpstream = (Error -> UpstreamSafety)
-> Env
-> DescribeRepository
-> IO (Either UpstreamSafety (AWSResponse DescribeRepository))
forall a e.
AWSRequest a =>
(Error -> e) -> Env -> a -> IO (Either e (AWSResponse a))
sendClassified Error -> UpstreamSafety
describeUpstreamRefusal Env
env
        , rpListTags :: ListTagsForResource
-> IO (Either StoreFault ListTagsForResourceResponse)
rpListTags = Env
-> ListTagsForResource
-> IO (Either StoreFault (AWSResponse ListTagsForResource))
forall a.
AWSRequest a =>
Env -> a -> IO (Either StoreFault (AWSResponse a))
sendStore Env
env
        }

{- | Build the handle over a caller-supplied 'ControlPlane' and the manifest read the root
assembled, which together are every effect it has.
-}
maintenanceFor :: NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> ControlPlane -> StoreMaintenance
maintenanceFor :: NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ControlPlane
-> StoreMaintenance
maintenanceFor NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ControlPlane
plane =
    StoreObservation -> StoreDeletion -> StoreMaintenance
maintenanceOf
        (NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ReadPlane
-> StoreObservation
observationFor NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store (ControlPlane -> ReadPlane
cpRead ControlPlane
plane))
        StoreDeletion
            { dlDeleteVersions :: DeleteGuard
-> PackageName -> [Version] -> IO [(Version, VersionOutcome)]
dlDeleteVersions = ControlPlane
-> CodeArtifactStore
-> DeleteGuard
-> PackageName
-> [Version]
-> IO [(Version, VersionOutcome)]
deleteChunks ControlPlane
plane CodeArtifactStore
store
            , dlCursor :: Maybe StoreCursor
dlCursor = StoreCursor -> Maybe StoreCursor
forall a. a -> Maybe a
Just (NameAlphabet -> ControlPlane -> CodeArtifactStore -> StoreCursor
walkCursor NameAlphabet
alphabet ControlPlane
plane CodeArtifactStore
store)
            }

-- | The observing calls over one 'ReadPlane', which is every effect they have.
observationFor :: NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> ReadPlane -> StoreObservation
observationFor :: NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ReadPlane
-> StoreObservation
observationFor NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ReadPlane
observer =
    StoreObservation
        { obFacts :: StoreFacts
obFacts = NameAlphabet -> CodeArtifactStore -> StoreFacts
codeArtifactFacts NameAlphabet
alphabet CodeArtifactStore
store
        , obListPackagesIn :: NamePrefix -> ConduitT () [PackageName] IO (Maybe StoreFault)
obListPackagesIn = (Maybe Text -> IO (Either StoreFault (Maybe Text, [PackageName])))
-> ConduitT () [PackageName] IO (Maybe StoreFault)
forall (m :: * -> *) a i.
Monad m =>
(Maybe Text -> m (Either StoreFault (Maybe Text, [a])))
-> ConduitT i [a] m (Maybe StoreFault)
pageSource ((Maybe Text -> IO (Either StoreFault (Maybe Text, [PackageName])))
 -> ConduitT () [PackageName] IO (Maybe StoreFault))
-> (NamePrefix
    -> Maybe Text
    -> IO (Either StoreFault (Maybe Text, [PackageName])))
-> NamePrefix
-> ConduitT () [PackageName] IO (Maybe StoreFault)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadPlane
-> CodeArtifactStore
-> NamePrefix
-> Maybe Text
-> IO (Either StoreFault (Maybe Text, [PackageName]))
packagePage ReadPlane
observer CodeArtifactStore
store
        , obEnumerateVersions :: PackageName -> IO (Either StoreFault [StoredVersion])
obEnumerateVersions = (Maybe Text
 -> IO (Either StoreFault (Maybe Text, [StoredVersion])))
-> IO (Either StoreFault [StoredVersion])
forall (m :: * -> *) a.
Monad m =>
(Maybe Text -> m (Either StoreFault (Maybe Text, [a])))
-> m (Either StoreFault [a])
pageAll ((Maybe Text
  -> IO (Either StoreFault (Maybe Text, [StoredVersion])))
 -> IO (Either StoreFault [StoredVersion]))
-> (PackageName
    -> Maybe Text
    -> IO (Either StoreFault (Maybe Text, [StoredVersion])))
-> PackageName
-> IO (Either StoreFault [StoredVersion])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadPlane
-> CodeArtifactStore
-> PackageName
-> Maybe Text
-> IO (Either StoreFault (Maybe Text, [StoredVersion]))
versionPage ReadPlane
observer CodeArtifactStore
store
        , obReadManifest :: StoreManifestRead
obReadManifest = StoreManifestRead
readManifest
        , obVerifyConsent :: IO (Either StoreFault ConsentVerdict)
obVerifyConsent = ReadPlane
-> CodeArtifactStore -> IO (Either StoreFault ConsentVerdict)
readConsent ReadPlane
observer CodeArtifactStore
store
        , obClassifyStore :: IO (Either StoreFault StoreClass)
obClassifyStore = (Either StoreFault RepositoryDescription
 -> Either StoreFault StoreClass)
-> IO (Either StoreFault RepositoryDescription)
-> IO (Either StoreFault StoreClass)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RepositoryDescription -> StoreClass)
-> Either StoreFault RepositoryDescription
-> Either StoreFault StoreClass
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RepositoryDescription -> StoreClass
classifyRepository) (ReadPlane
-> CodeArtifactStore
-> IO (Either StoreFault RepositoryDescription)
describeStore ReadPlane
observer CodeArtifactStore
store)
        , obProbeUpstream :: IO UpstreamSafety
obProbeUpstream = ReadPlane -> CodeArtifactStore -> IO UpstreamSafety
probeUpstreamSafety ReadPlane
observer CodeArtifactStore
store
        }

{- | Walk the repository's upstream chain, under the bounds the walk itself holds. The reads are
the ambient role's own, so no caller's credential reaches this call.
-}
probeUpstreamSafety :: ReadPlane -> CodeArtifactStore -> IO UpstreamSafety
probeUpstreamSafety :: ReadPlane -> CodeArtifactStore -> IO UpstreamSafety
probeUpstreamSafety ReadPlane
observer CodeArtifactStore
store =
    IO UpstreamSafety -> IO UpstreamSafety
withReadableIdentity ((RepositoryName -> IO (Either UpstreamSafety RepositoryLinks))
-> RepositoryName -> IO UpstreamSafety
forall (m :: * -> *).
Monad m =>
(RepositoryName -> m (Either UpstreamSafety RepositoryLinks))
-> RepositoryName -> m UpstreamSafety
walkUpstreamChain RepositoryName -> IO (Either UpstreamSafety RepositoryLinks)
linksOf (CodeArtifactStore -> RepositoryName
repositoryOfStore CodeArtifactStore
store))
  where
    linksOf :: RepositoryName -> IO (Either UpstreamSafety RepositoryLinks)
linksOf RepositoryName
repository =
        Either UpstreamSafety DescribeRepositoryResponse
-> Either UpstreamSafety RepositoryLinks
describedLinks (Either UpstreamSafety DescribeRepositoryResponse
 -> Either UpstreamSafety RepositoryLinks)
-> IO (Either UpstreamSafety DescribeRepositoryResponse)
-> IO (Either UpstreamSafety RepositoryLinks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> DescribeRepository
-> IO (Either UpstreamSafety DescribeRepositoryResponse)
rpDescribeUpstream ReadPlane
observer (CodeArtifactStore -> RepositoryName -> DescribeRepository
describeUpstreamRequest CodeArtifactStore
store RepositoryName
repository)

-- An answer that described no repository settled nothing, so the question stays open.
describedLinks :: Either UpstreamSafety CA.DescribeRepositoryResponse -> Either UpstreamSafety RepositoryLinks
describedLinks :: Either UpstreamSafety DescribeRepositoryResponse
-> Either UpstreamSafety RepositoryLinks
describedLinks Either UpstreamSafety DescribeRepositoryResponse
response = do
    described <- Either UpstreamSafety DescribeRepositoryResponse
response
    maybe (Left (Undecidable NetworkFailure)) (Right . upstreamLinksOf) (described ^. CAL.describeRepositoryResponse_repository)

{- A service refusal comes back as a value, so a throw here is the identity itself: none was
discovered, or the one discovered could not be renewed. An identity that cannot ask fails closed. -}
withReadableIdentity :: IO UpstreamSafety -> IO UpstreamSafety
withReadableIdentity :: IO UpstreamSafety -> IO UpstreamSafety
withReadableIdentity =
    (Either SomeException UpstreamSafety -> UpstreamSafety)
-> IO (Either SomeException UpstreamSafety) -> IO UpstreamSafety
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UpstreamSafety
-> Either SomeException UpstreamSafety -> UpstreamSafety
forall b a. b -> Either a b -> b
fromRight (UnsafeReason -> UpstreamSafety
Unsafe (PermissionName -> UnsafeReason
InsufficientPermissions PermissionName
describeRepositoryGrant))) (IO (Either SomeException UpstreamSafety) -> IO UpstreamSafety)
-> (IO UpstreamSafety -> IO (Either SomeException UpstreamSafety))
-> IO UpstreamSafety
-> IO UpstreamSafety
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO UpstreamSafety -> IO (Either SomeException UpstreamSafety)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny

-- | Build observation with version pagination bounded before another page is requested.
boundedObservationFor :: Int -> NameAlphabet -> StoreManifestRead -> CodeArtifactStore -> ReadPlane -> StoreObservation
boundedObservationFor :: Int
-> NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ReadPlane
-> StoreObservation
boundedObservationFor Int
limit NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ReadPlane
observer =
    (NameAlphabet
-> StoreManifestRead
-> CodeArtifactStore
-> ReadPlane
-> StoreObservation
observationFor NameAlphabet
alphabet StoreManifestRead
readManifest CodeArtifactStore
store ReadPlane
observer)
        { obEnumerateVersions = collectPagesBounded limit . pageSource . versionPage observer store
        }

sendStore :: (AWS.AWSRequest a) => AWS.Env -> a -> IO (Either StoreFault (AWS.AWSResponse a))
sendStore :: forall a.
AWSRequest a =>
Env -> a -> IO (Either StoreFault (AWSResponse a))
sendStore = (Error -> StoreFault)
-> Env -> a -> IO (Either StoreFault (AWSResponse a))
forall a e.
AWSRequest a =>
(Error -> e) -> Env -> a -> IO (Either e (AWSResponse a))
sendClassified Error -> StoreFault
classifyStoreFault

packagePage :: ReadPlane -> CodeArtifactStore -> NamePrefix -> Maybe Text -> IO (Either StoreFault (Maybe Text, [PackageName]))
packagePage :: ReadPlane
-> CodeArtifactStore
-> NamePrefix
-> Maybe Text
-> IO (Either StoreFault (Maybe Text, [PackageName]))
packagePage ReadPlane
observer CodeArtifactStore
store NamePrefix
prefix Maybe Text
token =
    (ListPackagesResponse -> (Maybe Text, [PackageName]))
-> Either StoreFault ListPackagesResponse
-> Either StoreFault (Maybe Text, [PackageName])
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListPackagesResponse -> (Maybe Text, [PackageName])
page (Either StoreFault ListPackagesResponse
 -> Either StoreFault (Maybe Text, [PackageName]))
-> IO (Either StoreFault ListPackagesResponse)
-> IO (Either StoreFault (Maybe Text, [PackageName]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> ListPackages -> IO (Either StoreFault ListPackagesResponse)
rpListPackages ReadPlane
observer (CodeArtifactStore -> NamePrefix -> Maybe Text -> ListPackages
listPackagesRequest CodeArtifactStore
store NamePrefix
prefix Maybe Text
token)
  where
    page :: ListPackagesResponse -> (Maybe Text, [PackageName])
page ListPackagesResponse
response =
        ( ListPackagesResponse
response ListPackagesResponse
-> Getting (Maybe Text) ListPackagesResponse (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ListPackagesResponse (Maybe Text)
Lens' ListPackagesResponse (Maybe Text)
CAL.listPackagesResponse_nextToken
        , Ecosystem -> [PackageSummary] -> [PackageName]
packagesOfPage
            (CodeArtifactFormat -> Ecosystem
formatEcosystem (CodeArtifactStore -> CodeArtifactFormat
casFormat CodeArtifactStore
store))
            ([PackageSummary] -> Maybe [PackageSummary] -> [PackageSummary]
forall a. a -> Maybe a -> a
fromMaybe [] (ListPackagesResponse
response ListPackagesResponse
-> Getting
     (Maybe [PackageSummary])
     ListPackagesResponse
     (Maybe [PackageSummary])
-> Maybe [PackageSummary]
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe [PackageSummary])
  ListPackagesResponse
  (Maybe [PackageSummary])
Lens' ListPackagesResponse (Maybe [PackageSummary])
CAL.listPackagesResponse_packages))
        )

versionPage ::
    ReadPlane ->
    CodeArtifactStore ->
    PackageName ->
    Maybe Text ->
    IO (Either StoreFault (Maybe Text, [StoredVersion]))
versionPage :: ReadPlane
-> CodeArtifactStore
-> PackageName
-> Maybe Text
-> IO (Either StoreFault (Maybe Text, [StoredVersion]))
versionPage ReadPlane
observer CodeArtifactStore
store PackageName
name Maybe Text
token =
    (ListPackageVersionsResponse -> (Maybe Text, [StoredVersion]))
-> Either StoreFault ListPackageVersionsResponse
-> Either StoreFault (Maybe Text, [StoredVersion])
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListPackageVersionsResponse -> (Maybe Text, [StoredVersion])
page (Either StoreFault ListPackageVersionsResponse
 -> Either StoreFault (Maybe Text, [StoredVersion]))
-> IO (Either StoreFault ListPackageVersionsResponse)
-> IO (Either StoreFault (Maybe Text, [StoredVersion]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> ListPackageVersions
-> IO (Either StoreFault ListPackageVersionsResponse)
rpListVersions ReadPlane
observer (CodeArtifactStore
-> PackageName -> Maybe Text -> ListPackageVersions
listVersionsRequest CodeArtifactStore
store PackageName
name Maybe Text
token)
  where
    page :: ListPackageVersionsResponse -> (Maybe Text, [StoredVersion])
page ListPackageVersionsResponse
response =
        ( ListPackageVersionsResponse
response ListPackageVersionsResponse
-> Getting (Maybe Text) ListPackageVersionsResponse (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ListPackageVersionsResponse (Maybe Text)
Lens' ListPackageVersionsResponse (Maybe Text)
CAL.listPackageVersionsResponse_nextToken
        , RepositoryIdentity
-> PackageName -> [PackageVersionSummary] -> [StoredVersion]
versionsOfPage
            (CodeArtifactStore -> RepositoryIdentity
identityOfStore CodeArtifactStore
store)
            PackageName
name
            ([PackageVersionSummary]
-> Maybe [PackageVersionSummary] -> [PackageVersionSummary]
forall a. a -> Maybe a -> a
fromMaybe [] (ListPackageVersionsResponse
response ListPackageVersionsResponse
-> Getting
     (Maybe [PackageVersionSummary])
     ListPackageVersionsResponse
     (Maybe [PackageVersionSummary])
-> Maybe [PackageVersionSummary]
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe [PackageVersionSummary])
  ListPackageVersionsResponse
  (Maybe [PackageVersionSummary])
Lens' ListPackageVersionsResponse (Maybe [PackageVersionSummary])
CAL.listPackageVersionsResponse_versions))
        )

deleteChunks :: ControlPlane -> CodeArtifactStore -> DeleteGuard -> PackageName -> [Version] -> IO [(Version, VersionOutcome)]
deleteChunks :: ControlPlane
-> CodeArtifactStore
-> DeleteGuard
-> PackageName
-> [Version]
-> IO [(Version, VersionOutcome)]
deleteChunks ControlPlane
plane CodeArtifactStore
store DeleteGuard
checks PackageName
name [Version]
versions =
    DeleteGuard
-> ([Version]
    -> IO (Either StoreFault [(Version, VersionOutcome)]))
-> [[Version]]
-> IO [(Version, VersionOutcome)]
deleteAll DeleteGuard
checks [Version] -> IO (Either StoreFault [(Version, VersionOutcome)])
send (DeleteCeiling -> [Version] -> [[Version]]
forall a. DeleteCeiling -> [a] -> [[a]]
chunksOfCeiling DeleteCeiling
deleteCeiling [Version]
versions)
  where
    send :: [Version] -> IO (Either StoreFault [(Version, VersionOutcome)])
send [Version]
batch =
        (DeletePackageVersionsResponse -> [(Version, VersionOutcome)])
-> Either StoreFault DeletePackageVersionsResponse
-> Either StoreFault [(Version, VersionOutcome)]
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Version]
-> DeletePackageVersionsResponse -> [(Version, VersionOutcome)]
foldDeleteResponse [Version]
batch) (Either StoreFault DeletePackageVersionsResponse
 -> Either StoreFault [(Version, VersionOutcome)])
-> IO (Either StoreFault DeletePackageVersionsResponse)
-> IO (Either StoreFault [(Version, VersionOutcome)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPlane
-> DeletePackageVersions
-> IO (Either StoreFault DeletePackageVersionsResponse)
cpDeleteVersions ControlPlane
plane (CodeArtifactStore
-> PackageName -> [Version] -> DeletePackageVersions
deleteRequest CodeArtifactStore
store PackageName
name [Version]
batch)

-- The consent marker is a tag on the repository, so the ARN comes first.
readConsent :: ReadPlane -> CodeArtifactStore -> IO (Either StoreFault ConsentVerdict)
readConsent :: ReadPlane
-> CodeArtifactStore -> IO (Either StoreFault ConsentVerdict)
readConsent ReadPlane
observer CodeArtifactStore
store =
    ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault ConsentVerdict))
-> IO (Either StoreFault ConsentVerdict)
forall a.
ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault a))
-> IO (Either StoreFault a)
withRepositoryArn ReadPlane
observer CodeArtifactStore
store ((Text -> IO (Either StoreFault ConsentVerdict))
 -> IO (Either StoreFault ConsentVerdict))
-> (Text -> IO (Either StoreFault ConsentVerdict))
-> IO (Either StoreFault ConsentVerdict)
forall a b. (a -> b) -> a -> b
$ \Text
arn ->
        (ListTagsForResourceResponse -> ConsentVerdict)
-> Either StoreFault ListTagsForResourceResponse
-> Either StoreFault ConsentVerdict
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Tag] -> ConsentVerdict
consentOfTags ([Tag] -> ConsentVerdict)
-> (ListTagsForResourceResponse -> [Tag])
-> ListTagsForResourceResponse
-> ConsentVerdict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListTagsForResourceResponse -> [Tag]
tagsOfResponse) (Either StoreFault ListTagsForResourceResponse
 -> Either StoreFault ConsentVerdict)
-> IO (Either StoreFault ListTagsForResourceResponse)
-> IO (Either StoreFault ConsentVerdict)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> ListTagsForResource
-> IO (Either StoreFault ListTagsForResourceResponse)
rpListTags ReadPlane
observer (Text -> ListTagsForResource
listTagsRequest Text
arn)

{- The walk cursor is a second tag on the same repository, the only one this leaf writes. Its
three calls address the repository by ARN, exactly as the consent read does. -}
walkCursor :: NameAlphabet -> ControlPlane -> CodeArtifactStore -> StoreCursor
walkCursor :: NameAlphabet -> ControlPlane -> CodeArtifactStore -> StoreCursor
walkCursor NameAlphabet
alphabet ControlPlane
plane CodeArtifactStore
store =
    StoreCursor
        { readCursor :: IO (Either StoreFault (Maybe NamePrefix))
readCursor = ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault (Maybe NamePrefix)))
-> IO (Either StoreFault (Maybe NamePrefix))
forall a.
ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault a))
-> IO (Either StoreFault a)
withRepositoryArn ReadPlane
observer CodeArtifactStore
store ((Text -> IO (Either StoreFault (Maybe NamePrefix)))
 -> IO (Either StoreFault (Maybe NamePrefix)))
-> (Text -> IO (Either StoreFault (Maybe NamePrefix)))
-> IO (Either StoreFault (Maybe NamePrefix))
forall a b. (a -> b) -> a -> b
$ \Text
arn ->
            (ListTagsForResourceResponse -> Maybe NamePrefix)
-> Either StoreFault ListTagsForResourceResponse
-> Either StoreFault (Maybe NamePrefix)
forall a b. (a -> b) -> Either StoreFault a -> Either StoreFault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameAlphabet -> Ecosystem -> [Tag] -> Maybe NamePrefix
cursorOfTags NameAlphabet
alphabet Ecosystem
eco ([Tag] -> Maybe NamePrefix)
-> (ListTagsForResourceResponse -> [Tag])
-> ListTagsForResourceResponse
-> Maybe NamePrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListTagsForResourceResponse -> [Tag]
tagsOfResponse) (Either StoreFault ListTagsForResourceResponse
 -> Either StoreFault (Maybe NamePrefix))
-> IO (Either StoreFault ListTagsForResourceResponse)
-> IO (Either StoreFault (Maybe NamePrefix))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> ListTagsForResource
-> IO (Either StoreFault ListTagsForResourceResponse)
rpListTags ReadPlane
observer (Text -> ListTagsForResource
listTagsRequest Text
arn)
        , writeCursor :: NamePrefix -> IO (Either StoreFault ())
writeCursor = \NamePrefix
prefix -> ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault ()))
-> IO (Either StoreFault ())
forall a.
ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault a))
-> IO (Either StoreFault a)
withRepositoryArn ReadPlane
observer CodeArtifactStore
store ((Text -> IO (Either StoreFault ())) -> IO (Either StoreFault ()))
-> (Text -> IO (Either StoreFault ())) -> IO (Either StoreFault ())
forall a b. (a -> b) -> a -> b
$ \Text
arn ->
            Either StoreFault TagResourceResponse -> Either StoreFault ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either StoreFault TagResourceResponse -> Either StoreFault ())
-> IO (Either StoreFault TagResourceResponse)
-> IO (Either StoreFault ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPlane
-> TagResource -> IO (Either StoreFault TagResourceResponse)
cpTagResource ControlPlane
plane (Ecosystem -> Text -> NamePrefix -> TagResource
cursorTagRequest Ecosystem
eco Text
arn NamePrefix
prefix)
        , clearCursor :: IO (Either StoreFault ())
clearCursor = ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault ()))
-> IO (Either StoreFault ())
forall a.
ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault a))
-> IO (Either StoreFault a)
withRepositoryArn ReadPlane
observer CodeArtifactStore
store ((Text -> IO (Either StoreFault ())) -> IO (Either StoreFault ()))
-> (Text -> IO (Either StoreFault ())) -> IO (Either StoreFault ())
forall a b. (a -> b) -> a -> b
$ \Text
arn ->
            Either StoreFault UntagResourceResponse -> Either StoreFault ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Either StoreFault UntagResourceResponse -> Either StoreFault ())
-> IO (Either StoreFault UntagResourceResponse)
-> IO (Either StoreFault ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlPlane
-> UntagResource -> IO (Either StoreFault UntagResourceResponse)
cpUntagResource ControlPlane
plane (Ecosystem -> Text -> UntagResource
cursorUntagRequest Ecosystem
eco Text
arn)
        }
  where
    observer :: ReadPlane
observer = ControlPlane -> ReadPlane
cpRead ControlPlane
plane

    eco :: Ecosystem
    eco :: Ecosystem
eco = CodeArtifactFormat -> Ecosystem
formatEcosystem (CodeArtifactStore -> CodeArtifactFormat
casFormat CodeArtifactStore
store)

-- A tag call is addressed by ARN, which only the repository description carries.
withRepositoryArn :: ReadPlane -> CodeArtifactStore -> (Text -> IO (Either StoreFault a)) -> IO (Either StoreFault a)
withRepositoryArn :: forall a.
ReadPlane
-> CodeArtifactStore
-> (Text -> IO (Either StoreFault a))
-> IO (Either StoreFault a)
withRepositoryArn ReadPlane
observer CodeArtifactStore
store Text -> IO (Either StoreFault a)
act =
    ReadPlane
-> CodeArtifactStore
-> IO (Either StoreFault RepositoryDescription)
describeStore ReadPlane
observer CodeArtifactStore
store IO (Either StoreFault RepositoryDescription)
-> (Either StoreFault RepositoryDescription
    -> IO (Either StoreFault a))
-> IO (Either StoreFault a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left StoreFault
fault -> Either StoreFault a -> IO (Either StoreFault a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StoreFault -> Either StoreFault a
forall a b. a -> Either a b
Left StoreFault
fault)
        Right RepositoryDescription
description -> (StoreFault -> IO (Either StoreFault a))
-> (Text -> IO (Either StoreFault a))
-> Either StoreFault Text
-> IO (Either StoreFault a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreFault a -> IO (Either StoreFault a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either StoreFault a -> IO (Either StoreFault a))
-> (StoreFault -> Either StoreFault a)
-> StoreFault
-> IO (Either StoreFault a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreFault -> Either StoreFault a
forall a b. a -> Either a b
Left) Text -> IO (Either StoreFault a)
act (RepositoryDescription -> Either StoreFault Text
arnOfDescription RepositoryDescription
description)

tagsOfResponse :: CA.ListTagsForResourceResponse -> [CA.Tag]
tagsOfResponse :: ListTagsForResourceResponse -> [Tag]
tagsOfResponse ListTagsForResourceResponse
response = [Tag] -> Maybe [Tag] -> [Tag]
forall a. a -> Maybe a -> a
fromMaybe [] (ListTagsForResourceResponse
response ListTagsForResourceResponse
-> Getting (Maybe [Tag]) ListTagsForResourceResponse (Maybe [Tag])
-> Maybe [Tag]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Tag]) ListTagsForResourceResponse (Maybe [Tag])
Lens' ListTagsForResourceResponse (Maybe [Tag])
CAL.listTagsForResourceResponse_tags)

describeStore :: ReadPlane -> CodeArtifactStore -> IO (Either StoreFault CA.RepositoryDescription)
describeStore :: ReadPlane
-> CodeArtifactStore
-> IO (Either StoreFault RepositoryDescription)
describeStore ReadPlane
observer CodeArtifactStore
store =
    (Either StoreFault DescribeRepositoryResponse
-> (DescribeRepositoryResponse
    -> Either StoreFault RepositoryDescription)
-> Either StoreFault RepositoryDescription
forall a b.
Either StoreFault a
-> (a -> Either StoreFault b) -> Either StoreFault b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DescribeRepositoryResponse
-> Either StoreFault RepositoryDescription
repositoryOfResponse) (Either StoreFault DescribeRepositoryResponse
 -> Either StoreFault RepositoryDescription)
-> IO (Either StoreFault DescribeRepositoryResponse)
-> IO (Either StoreFault RepositoryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPlane
-> DescribeRepository
-> IO (Either StoreFault DescribeRepositoryResponse)
rpDescribeRepository ReadPlane
observer (CodeArtifactStore -> DescribeRepository
describeRepositoryRequest CodeArtifactStore
store)