Split Registry read and write effects

app-e2e/src/Test/E2E/Scripts.purs

@@ -149,8 +149,13 @@ spec = do
         Just _ -> Assert.fail "Expected PackageSetJob but got different job type"
         Nothing -> Assert.fail "Expected package set job to be enqueued"
 
--- | Common environment for running registry scripts in E2E tests
-type ScriptSetup =
+-- | Common environment for running read-only registry scripts in E2E tests
+type RegistryScriptSetup =
+  { resourceEnv :: Env.ResourceEnv
+  , registryEnv :: Registry.RegistryEnv
+  }
+
+type GitHubScriptSetup =
   { privateKey :: String
   , resourceEnv :: Env.ResourceEnv
   , registryEnv :: Registry.RegistryEnv
@@ -159,17 +164,12 @@ type ScriptSetup =
   , githubCacheRef :: Cache.CacheRef
   }
 
--- | Set up common environment for running registry scripts
-setupScript :: E2E ScriptSetup
-setupScript = do
-  { stateDir, privateKey } <- ask
+setupRegistryScript :: E2E RegistryScriptSetup
+setupRegistryScript = do
+  { stateDir } <- ask
   liftEffect $ Process.chdir stateDir
   resourceEnv <- liftEffect Env.lookupResourceEnv
-  token <- liftEffect $ Env.lookupRequired Env.githubToken
-  githubCacheRef <- liftAff Cache.newCacheRef
   registryCacheRef <- liftAff Cache.newCacheRef
-  let cache = Path.concat [ stateDir, "scratch", ".cache" ]
-  octokit <- liftAff $ Octokit.newOctokit token resourceEnv.githubApiUrl
   debouncer <- liftAff Registry.newDebouncer
   let
     registryEnv :: Registry.RegistryEnv
@@ -182,16 +182,26 @@ setupScript = do
       , debouncer
       , cacheRef: registryCacheRef
       }
+  pure { resourceEnv, registryEnv }
+
+setupGitHubScript :: E2E GitHubScriptSetup
+setupGitHubScript = do
+  { stateDir, privateKey } <- ask
+  { resourceEnv, registryEnv } <- setupRegistryScript
+  token <- liftEffect $ Env.lookupRequired Env.githubToken
+  githubCacheRef <- liftAff Cache.newCacheRef
+  let cache = Path.concat [ stateDir, "scratch", ".cache" ]
+  octokit <- liftAff $ Octokit.newOctokit token resourceEnv.githubApiUrl
   pure { privateKey, resourceEnv, registryEnv, octokit, cache, githubCacheRef }
 
 -- | Run the DailyImporter script in Submit mode
 runDailyImporterScript :: E2E Unit
 runDailyImporterScript = do
-  { resourceEnv, registryEnv, octokit, cache, githubCacheRef } <- setupScript
+  { resourceEnv, registryEnv, octokit, cache, githubCacheRef } <- setupGitHubScript
   result <- liftAff
     $ DailyImporter.runDailyImport DailyImporter.Submit resourceEnv.registryApiUrl
     # Except.runExcept
-    # Registry.interpret (Registry.handle registryEnv)
+    # Registry.interpretRead (Registry.handleRead registryEnv)
     # GitHub.interpret (GitHub.handle { octokit, cache, ref: githubCacheRef })
     # Log.interpret (Log.handleTerminal Quiet)
     # Env.runResourceEnv resourceEnv
@@ -203,11 +213,11 @@ runDailyImporterScript = do
 -- | Run the PackageTransferrer script in Submit mode
 runPackageTransferrerScript :: E2E Unit
 runPackageTransferrerScript = do
-  { privateKey, resourceEnv, registryEnv, octokit, cache, githubCacheRef } <- setupScript
+  { privateKey, resourceEnv, registryEnv, octokit, cache, githubCacheRef } <- setupGitHubScript
   result <- liftAff
     $ PackageTransferrer.runPackageTransferrer PackageTransferrer.Submit (Just privateKey) resourceEnv.registryApiUrl
     # Except.runExcept
-    # Registry.interpret (Registry.handle registryEnv)
+    # Registry.interpretRead (Registry.handleRead registryEnv)
     # GitHub.interpret (GitHub.handle { octokit, cache, ref: githubCacheRef })
     # Log.interpret (Log.handleTerminal Quiet)
     # Env.runResourceEnv resourceEnv
@@ -219,14 +229,12 @@ runPackageTransferrerScript = do
 -- | Run the PackageSetUpdater script in Submit mode
 runPackageSetUpdaterScript :: E2E Unit
 runPackageSetUpdaterScript = do
-  { resourceEnv, registryEnv, octokit, cache, githubCacheRef } <- setupScript
+  { resourceEnv, registryEnv } <- setupRegistryScript
   result <- liftAff
     $ PackageSetUpdater.runPackageSetUpdater PackageSetUpdater.Submit resourceEnv.registryApiUrl
     # Except.runExcept
-    # Registry.interpret (Registry.handle registryEnv)
-    # GitHub.interpret (GitHub.handle { octokit, cache, ref: githubCacheRef })
+    # Registry.interpretRead (Registry.handleRead registryEnv)
     # Log.interpret (Log.handleTerminal Quiet)
-    # Env.runResourceEnv resourceEnv
     # Run.runBaseAff'
   case result of
     Left err -> liftAff $ Aff.throwError $ Aff.error $ "PackageSetUpdater failed: " <> err

app/src/App/API.purs

@@ -76,7 +76,7 @@ import Registry.App.Effect.PackageSets (Change(..), PACKAGE_SETS)
 import Registry.App.Effect.PackageSets as PackageSets
 import Registry.App.Effect.Pursuit (PURSUIT)
 import Registry.App.Effect.Pursuit as Pursuit
-import Registry.App.Effect.Registry (REGISTRY)
+import Registry.App.Effect.Registry (REGISTRY, REGISTRY_READ)
 import Registry.App.Effect.Registry as ManifestIndex
 import Registry.App.Effect.Registry as Registry
 import Registry.App.Effect.Source (SOURCE)
@@ -349,7 +349,7 @@ resolveCompilerAndDeps
   -> Manifest
   -> Maybe Version -- payload.compiler
   -> Maybe (Map PackageName Version) -- payload.resolutions
-  -> Run (REGISTRY + LOG + AFF + EXCEPT String + r) { compiler :: Version, resolutions :: Map PackageName Version }
+  -> Run (LOG + AFF + EXCEPT String + r) { compiler :: Version, resolutions :: Map PackageName Version }
 resolveCompilerAndDeps compilerIndex manifest@(Manifest { dependencies }) maybeCompiler maybeResolutions = do
   Log.debug "Resolving compiler and dependencies..."
   case maybeCompiler of
@@ -1067,7 +1067,7 @@ type FindAllCompilersResult =
 findAllCompilers
   :: forall r
    . { source :: FilePath, manifest :: Manifest, compilers :: NonEmptyArray Version }
-  -> Run (REGISTRY + STORAGE + COMPILER_CACHE + LOG + AFF + EFFECT + EXCEPT String + r) FindAllCompilersResult
+  -> Run (REGISTRY_READ + STORAGE + COMPILER_CACHE + LOG + AFF + EFFECT + EXCEPT String + r) FindAllCompilersResult
 findAllCompilers { source, manifest, compilers } = do
   compilerIndex <- MatrixBuilder.readCompilerIndex
   checkedCompilers <- for compilers \target -> do

app/src/App/Effect/PackageSets.purs

@@ -24,7 +24,7 @@ import Registry.App.CLI.Purs as Purs
 import Registry.App.CLI.Tar as Tar
 import Registry.App.Effect.Log (LOG)
 import Registry.App.Effect.Log as Log
-import Registry.App.Effect.Registry (REGISTRY)
+import Registry.App.Effect.Registry (REGISTRY_READ)
 import Registry.App.Effect.Registry as Registry
 import Registry.App.Effect.Storage (STORAGE)
 import Registry.App.Effect.Storage as Storage
@@ -86,7 +86,7 @@ type PackageSetsEnv =
 
 -- | A handler for the PACKAGE_SETS effect which compiles the package sets and
 -- | returns the results.
-handle :: forall r a. PackageSetsEnv -> PackageSets a -> Run (REGISTRY + STORAGE + LOG + AFF + EFFECT + r) a
+handle :: forall r a. PackageSetsEnv -> PackageSets a -> Run (REGISTRY_READ + STORAGE + LOG + AFF + EFFECT + r) a
 handle env = case _ of
   UpgradeAtomic oldSet@(PackageSet { packages }) compiler changes reply -> reply <$> Except.runExcept do
     Log.info $ "Performing atomic upgrade of package set " <> Version.print (un PackageSet oldSet).version
@@ -423,7 +423,7 @@ type ValidatedCandidates =
   }
 
 -- | Validate a package set is self-contained, ignoring version bounds.
-validatePackageSet :: forall r. PackageSet -> Run (REGISTRY + LOG + EXCEPT String + r) Unit
+validatePackageSet :: forall r. PackageSet -> Run (REGISTRY_READ + LOG + EXCEPT String + r) Unit
 validatePackageSet (PackageSet set) = do
   Log.debug $ "Validating package set version " <> Version.print set.version
   index <- Registry.readAllManifests