From 6da962ea1e115751925568f60a229d83e2a4267b Mon Sep 17 00:00:00 2001
From: Peter Murphy <26548438+ptrfrncsmrph@users.noreply.github.com>
Date: Mon, 21 Aug 2023 21:20:45 -0400
Subject: [PATCH 1/3] Move (Package)Source data type to Prelude

---
 app/src/App/API.purs            | 25 ++++++-------------------
 app/src/App/GitHubIssue.purs    |  3 +--
 app/src/App/Prelude.purs        | 16 ++++++++++++++++
 app/src/App/Server.purs         |  3 +--
 app/test/App/API.purs           |  4 ++--
 scripts/src/LegacyImporter.purs |  7 +++----
 scripts/src/PackageDeleter.purs |  2 +-
 7 files changed, 30 insertions(+), 30 deletions(-)

diff --git a/app/src/App/API.purs b/app/src/App/API.purs
index 427a2a91..4af0896a 100644
--- a/app/src/App/API.purs
+++ b/app/src/App/API.purs
@@ -1,6 +1,5 @@
 module Registry.App.API
-  ( Source(..)
-  , PackageSetUpdateEffects
+  ( PackageSetUpdateEffects
   , packageSetUpdate
   , PublishEffects
   , publish
@@ -95,18 +94,6 @@ import Spago.Core.Config as Spago
 import Spago.Core.Prelude as Spago.Prelude
 import Spago.Log as Spago.Log
 
--- | Operations can be exercised for old, pre-registry packages, or for packages
--- | which are on the 0.15 compiler series. If a true legacy package is uploaded
--- | then we do not require compilation to succeed and we don't publish docs.
-data Source = Legacy | Current
-
-derive instance Eq Source
-
-printSource :: Source -> String
-printSource = case _ of
-  Legacy -> "legacy"
-  Current -> "current"
-
 type PackageSetUpdateEffects r = (REGISTRY + PACKAGE_SETS + GITHUB + GITHUB_EVENT_ENV + COMMENT + LOG + EXCEPT String + r)
 
 -- | Process a package set update. Package set updates are only processed via
@@ -327,11 +314,11 @@ type PublishEffects r = (RESOURCE_ENV + PURSUIT + REGISTRY + STORAGE + SOURCE +
 -- | published before then it will be registered and the given version will be
 -- | upload. If it has been published before then the existing metadata will be
 -- | updated with the new version.
-publish :: forall r. Source -> PublishData -> Run (PublishEffects + r) Unit
+publish :: forall r. PackageSource -> PublishData -> Run (PublishEffects + r) Unit
 publish source payload = do
   let printedName = PackageName.print payload.name
 
-  Log.debug $ "Publishing " <> printSource source <> " package " <> printedName <> " with payload:\n" <> stringifyJson Operation.publishCodec payload
+  Log.debug $ "Publishing " <> printPackageSource source <> " package " <> printedName <> " with payload:\n" <> stringifyJson Operation.publishCodec payload
 
   Log.debug $ "Verifying metadata..."
   Metadata existingMetadata <- Registry.readMetadata payload.name >>= case _ of
@@ -551,7 +538,7 @@ publish source payload = do
     }
 
 type PublishRegistry =
-  { source :: Source
+  { source :: PackageSource
   , manifest :: Manifest
   , metadata :: Metadata
   , payload :: PublishData
@@ -632,7 +619,7 @@ publishRegistry { source, payload, metadata: Metadata metadata, manifest: Manife
     Left error
       -- We allow legacy packages to fail compilation because we do not
       -- necessarily know what compiler to use with them.
-      | source == Legacy -> do
+      | source == PackageSource'Legacy -> do
           Log.debug error
           Log.warn "Failed to compile, but continuing because this package is a legacy package."
       | otherwise ->
@@ -655,7 +642,7 @@ publishRegistry { source, payload, metadata: Metadata metadata, manifest: Manife
   -- team should manually insert the entry.
   Registry.writeManifest (Manifest manifest)
 
-  when (source == Current) $ case compilationResult of
+  when (source == PackageSource'Current) $ case compilationResult of
     Left error -> do
       Log.error $ "Compilation failed, cannot upload to pursuit: " <> error
       Except.throw "Cannot publish to Pursuit because this package failed to compile."
diff --git a/app/src/App/GitHubIssue.purs b/app/src/App/GitHubIssue.purs
index 4e689159..4969b142 100644
--- a/app/src/App/GitHubIssue.purs
+++ b/app/src/App/GitHubIssue.purs
@@ -14,7 +14,6 @@ import Foreign.Object as Object
 import Node.FS.Aff as FS.Aff
 import Node.Path as Path
 import Node.Process as Process
-import Registry.App.API (Source(..))
 import Registry.App.API as API
 import Registry.App.Auth as Auth
 import Registry.App.CLI.Git as Git
@@ -58,7 +57,7 @@ main = launchAff_ $ do
 
         Right packageOperation -> case packageOperation of
           Publish payload ->
-            API.publish Current payload
+            API.publish PackageSource'Current payload
           Authenticated payload -> do
             -- If we receive an authenticated operation via GitHub, then we
             -- re-sign it with pacchettibotti credentials if and only if the
diff --git a/app/src/App/Prelude.purs b/app/src/App/Prelude.purs
index 8c98a2cd..ddb677df 100644
--- a/app/src/App/Prelude.purs
+++ b/app/src/App/Prelude.purs
@@ -1,5 +1,6 @@
 module Registry.App.Prelude
   ( LogVerbosity(..)
+  , PackageSource(..)
   , PursPublishMethod(..)
   , RetryRequestError(..)
   , Retry
@@ -21,6 +22,7 @@ module Registry.App.Prelude
   , parseJson
   , partitionEithers
   , printJson
+  , printPackageSource
   , pursPublishMethod
   , readJsonFile
   , scratchDir
@@ -272,3 +274,17 @@ data PursPublishMethod = LegacyPursPublish | PursPublish
 -- | The current purs publish method
 pursPublishMethod :: PursPublishMethod
 pursPublishMethod = LegacyPursPublish
+
+-- | Operations can be exercised for old, pre-registry packages, or for packages
+-- | which are on the 0.15 compiler series. If a true legacy package is uploaded
+-- | then we do not require compilation to succeed and we don't publish docs.
+data PackageSource
+  = PackageSource'Legacy
+  | PackageSource'Current
+
+derive instance Eq PackageSource
+
+printPackageSource :: PackageSource -> String
+printPackageSource = case _ of
+  PackageSource'Legacy -> "legacy"
+  PackageSource'Current -> "current"
diff --git a/app/src/App/Server.purs b/app/src/App/Server.purs
index 92ab3f55..df40148a 100644
--- a/app/src/App/Server.purs
+++ b/app/src/App/Server.purs
@@ -21,7 +21,6 @@ import Node.Process as Process
 import Record as Record
 import Registry.API.V1 (JobId(..), JobType(..), LogLevel(..), Route(..))
 import Registry.API.V1 as V1
-import Registry.App.API (Source(..))
 import Registry.App.API as API
 import Registry.App.CLI.Git as Git
 import Registry.App.Effect.Cache (CacheRef)
@@ -71,7 +70,7 @@ router env { route, method, body } = HTTPurple.usingCont case route, method of
     lift $ Log.info $ "Received Publish request: " <> printJson Operation.publishCodec publish
     forkPipelineJob publish.name publish.ref PublishJob \jobId -> do
       Log.info $ "Received Publish request, job id: " <> unwrap jobId
-      API.publish Current publish
+      API.publish PackageSource'Current publish
 
   Unpublish, Post -> do
     auth <- HTTPurple.fromJson (jsonDecoder Operation.authenticatedCodec) body
diff --git a/app/test/App/API.purs b/app/test/App/API.purs
index 82260f66..0aafb4f9 100644
--- a/app/test/App/API.purs
+++ b/app/test/App/API.purs
@@ -69,7 +69,7 @@ spec = do
             }
 
         -- First, we publish the package.
-        API.publish API.Current publishArgs
+        API.publish PackageSource'Current publishArgs
 
         -- Then, we can check that it did make it to "Pursuit" as expected
         Pursuit.getPublishedVersions name >>= case _ of
@@ -84,7 +84,7 @@ spec = do
 
         -- Finally, we can verify that publishing the package again should fail
         -- since it already exists.
-        Except.runExcept (API.publish API.Current publishArgs) >>= case _ of
+        Except.runExcept (API.publish PackageSource'Current publishArgs) >>= case _ of
           Left _ -> pure unit
           Right _ -> Except.throw $ "Expected publishing " <> formatPackageVersion name version <> " twice to fail."
   where
diff --git a/scripts/src/LegacyImporter.purs b/scripts/src/LegacyImporter.purs
index 658ebc61..a9059a29 100644
--- a/scripts/src/LegacyImporter.purs
+++ b/scripts/src/LegacyImporter.purs
@@ -40,7 +40,6 @@ import Parsing.Combinators as Parsing.Combinators
 import Parsing.Combinators.Array as Parsing.Combinators.Array
 import Parsing.String as Parsing.String
 import Parsing.String.Basic as Parsing.String.Basic
-import Registry.App.API (Source(..))
 import Registry.App.API as API
 import Registry.App.CLI.Git as Git
 import Registry.App.Effect.Cache (class FsEncodable, class MemoryEncodable, Cache, FsEncoding(..), MemoryEncoding(..))
@@ -281,9 +280,9 @@ runLegacyImport mode logs = do
 
       let
         source = case mode of
-          DryRun -> Legacy
-          GenerateRegistry -> Legacy
-          UpdateRegistry -> Current
+          DryRun -> PackageSource'Legacy
+          GenerateRegistry -> PackageSource'Legacy
+          UpdateRegistry -> PackageSource'Current
 
       void $ for notPublished \(Manifest manifest) -> do
         let formatted = formatPackageVersion manifest.name manifest.version
diff --git a/scripts/src/PackageDeleter.purs b/scripts/src/PackageDeleter.purs
index 06210ac4..17dc779b 100644
--- a/scripts/src/PackageDeleter.purs
+++ b/scripts/src/PackageDeleter.purs
@@ -237,7 +237,7 @@ deleteVersion arguments name version = do
           Just (Left _) -> Log.error "Cannot reimport a version that was specifically unpublished"
           Just (Right specificPackageMetadata) -> do
             -- Obtains `newMetadata` via cache
-            API.publish API.Legacy
+            API.publish PackageSource'Legacy
               { location: Just oldMetadata.location
               , name: name
               , ref: specificPackageMetadata.ref

From 7ec2a0c8a75d3b1b8ebfb10813d219315d516b90 Mon Sep 17 00:00:00 2001
From: Peter Murphy <26548438+ptrfrncsmrph@users.noreply.github.com>
Date: Mon, 21 Aug 2023 22:00:42 -0400
Subject: [PATCH 2/3] Update fetch to take PackageSource parameter

---
 app/src/App/API.purs           |  2 +-
 app/src/App/Effect/Source.purs | 26 +++++++++++++++-----------
 app/test/Test/Assert/Run.purs  |  2 +-
 3 files changed, 17 insertions(+), 13 deletions(-)

diff --git a/app/src/App/API.purs b/app/src/App/API.purs
index 4af0896a..36fef313 100644
--- a/app/src/App/API.purs
+++ b/app/src/App/API.purs
@@ -361,7 +361,7 @@ publish source payload = do
   -- the package directory along with its detected publish time.
   Log.debug "Metadata validated. Fetching package source code..."
   tmp <- Tmp.mkTmpDir
-  { path: packageDirectory, published: publishedTime } <- Source.fetch tmp existingMetadata.location payload.ref
+  { path: packageDirectory, published: publishedTime } <- Source.fetch source tmp existingMetadata.location payload.ref
 
   Log.debug $ "Package downloaded to " <> packageDirectory <> ", verifying it contains a src directory with valid modules..."
   Internal.Path.readPursFiles (Path.concat [ packageDirectory, "src" ]) >>= case _ of
diff --git a/app/src/App/Effect/Source.purs b/app/src/App/Effect/Source.purs
index 42a70c73..3fe32fe0 100644
--- a/app/src/App/Effect/Source.purs
+++ b/app/src/App/Effect/Source.purs
@@ -10,6 +10,7 @@ import Data.DateTime (DateTime)
 import Data.HTTP.Method (Method(..))
 import Data.JSDate as JSDate
 import Effect.Aff as Aff
+import Effect.Now as Now
 import Node.Buffer as Buffer
 import Node.FS.Aff as FS.Aff
 import Node.Path as Path
@@ -29,7 +30,7 @@ import Run.Except (EXCEPT)
 import Run.Except as Except
 
 -- | An effect for fetching package sources
-data Source a = Fetch FilePath Location String (Either String FetchedSource -> a)
+data Source a = Fetch PackageSource FilePath Location String (Either String FetchedSource -> a)
 
 derive instance Functor Source
 
@@ -41,8 +42,8 @@ _source = Proxy
 type FetchedSource = { path :: FilePath, published :: DateTime }
 
 -- | Fetch the provided location to the provided destination path.
-fetch :: forall r. FilePath -> Location -> String -> Run (SOURCE + EXCEPT String + r) FetchedSource
-fetch destination location ref = Except.rethrow =<< Run.lift _source (Fetch destination location ref identity)
+fetch :: forall r. PackageSource -> FilePath -> Location -> String -> Run (SOURCE + EXCEPT String + r) FetchedSource
+fetch source destination location ref = Except.rethrow =<< Run.lift _source (Fetch source destination location ref identity)
 
 -- | Run the SOURCE effect given a handler.
 interpret :: forall r a. (Source ~> Run r) -> Run (SOURCE + r) a -> Run r a
@@ -51,7 +52,7 @@ interpret handler = Run.interpret (Run.on _source handler Run.send)
 -- | Handle the SOURCE effect by downloading package source to the file system.
 handle :: forall r a. Source a -> Run (GITHUB + LOG + AFF + EFFECT + r) a
 handle = case _ of
-  Fetch destination location ref reply -> map (map reply) Except.runExcept do
+  Fetch source destination location ref reply -> map (map reply) Except.runExcept do
     Log.info $ "Fetching " <> printJson Location.codec location
     case location of
       Git _ -> do
@@ -92,13 +93,16 @@ handle = case _ of
             Log.debug $ "Getting published time..."
 
             let
-              getRefTime = do
-                timestamp <- Except.rethrow =<< Run.liftAff (Git.gitCLI [ "log", "-1", "--date=iso8601-strict", "--format=%cd", ref ] (Just repoDir))
-                jsDate <- Run.liftEffect $ JSDate.parse timestamp
-                dateTime <- case JSDate.toDateTime jsDate of
-                  Nothing -> Except.throw $ "Could not parse timestamp of git ref to a datetime given timestamp " <> timestamp <> " and parsed js date " <> JSDate.toUTCString jsDate
-                  Just parsed -> pure parsed
-                pure dateTime
+              getRefTime = case source of
+                PackageSource'Legacy -> do
+                  timestamp <- Except.rethrow =<< Run.liftAff (Git.gitCLI [ "log", "-1", "--date=iso8601-strict", "--format=%cd", ref ] (Just repoDir))
+                  jsDate <- Run.liftEffect $ JSDate.parse timestamp
+                  dateTime <- case JSDate.toDateTime jsDate of
+                    Nothing -> Except.throw $ "Could not parse timestamp of git ref to a datetime given timestamp " <> timestamp <> " and parsed js date " <> JSDate.toUTCString jsDate
+                    Just parsed -> pure parsed
+                  pure dateTime
+                PackageSource'Current ->
+                  Run.liftEffect Now.nowDateTime
 
             -- Cloning will result in the `repo` name as the directory name
             publishedTime <- Except.runExcept getRefTime >>= case _ of
diff --git a/app/test/Test/Assert/Run.purs b/app/test/Test/Assert/Run.purs
index dbc6a714..2be373d4 100644
--- a/app/test/Test/Assert/Run.purs
+++ b/app/test/Test/Assert/Run.purs
@@ -266,7 +266,7 @@ type SourceMockEnv = { github :: FilePath }
 
 handleSourceMock :: forall r a. SourceMockEnv -> Source a -> Run (EXCEPT String + AFF + EFFECT + r) a
 handleSourceMock env = case _ of
-  Fetch destination location ref reply -> do
+  Fetch _source destination location ref reply -> do
     now <- Run.liftEffect Now.nowDateTime
     case location of
       Git _ -> pure $ reply $ Left "Packages cannot be published from Git yet (only GitHub)."

From 706ea2380513df2454274b3ad54e716a3a816400 Mon Sep 17 00:00:00 2001
From: Peter Murphy <26548438+ptrfrncsmrph@users.noreply.github.com>
Date: Mon, 21 Aug 2023 22:26:49 -0400
Subject: [PATCH 3/3] Rename PackageSource constructors

---
 app/src/App/API.purs            | 4 ++--
 app/src/App/Effect/Source.purs  | 4 ++--
 app/src/App/GitHubIssue.purs    | 2 +-
 app/src/App/Prelude.purs        | 8 +++-----
 app/src/App/Server.purs         | 2 +-
 app/test/App/API.purs           | 4 ++--
 scripts/src/LegacyImporter.purs | 6 +++---
 scripts/src/PackageDeleter.purs | 2 +-
 8 files changed, 15 insertions(+), 17 deletions(-)

diff --git a/app/src/App/API.purs b/app/src/App/API.purs
index 36fef313..cc306709 100644
--- a/app/src/App/API.purs
+++ b/app/src/App/API.purs
@@ -619,7 +619,7 @@ publishRegistry { source, payload, metadata: Metadata metadata, manifest: Manife
     Left error
       -- We allow legacy packages to fail compilation because we do not
       -- necessarily know what compiler to use with them.
-      | source == PackageSource'Legacy -> do
+      | source == LegacyPackage -> do
           Log.debug error
           Log.warn "Failed to compile, but continuing because this package is a legacy package."
       | otherwise ->
@@ -642,7 +642,7 @@ publishRegistry { source, payload, metadata: Metadata metadata, manifest: Manife
   -- team should manually insert the entry.
   Registry.writeManifest (Manifest manifest)
 
-  when (source == PackageSource'Current) $ case compilationResult of
+  when (source == CurrentPackage) $ case compilationResult of
     Left error -> do
       Log.error $ "Compilation failed, cannot upload to pursuit: " <> error
       Except.throw "Cannot publish to Pursuit because this package failed to compile."
diff --git a/app/src/App/Effect/Source.purs b/app/src/App/Effect/Source.purs
index 3fe32fe0..96ab76cd 100644
--- a/app/src/App/Effect/Source.purs
+++ b/app/src/App/Effect/Source.purs
@@ -94,14 +94,14 @@ handle = case _ of
 
             let
               getRefTime = case source of
-                PackageSource'Legacy -> do
+                LegacyPackage -> do
                   timestamp <- Except.rethrow =<< Run.liftAff (Git.gitCLI [ "log", "-1", "--date=iso8601-strict", "--format=%cd", ref ] (Just repoDir))
                   jsDate <- Run.liftEffect $ JSDate.parse timestamp
                   dateTime <- case JSDate.toDateTime jsDate of
                     Nothing -> Except.throw $ "Could not parse timestamp of git ref to a datetime given timestamp " <> timestamp <> " and parsed js date " <> JSDate.toUTCString jsDate
                     Just parsed -> pure parsed
                   pure dateTime
-                PackageSource'Current ->
+                CurrentPackage ->
                   Run.liftEffect Now.nowDateTime
 
             -- Cloning will result in the `repo` name as the directory name
diff --git a/app/src/App/GitHubIssue.purs b/app/src/App/GitHubIssue.purs
index 4969b142..f8d7738d 100644
--- a/app/src/App/GitHubIssue.purs
+++ b/app/src/App/GitHubIssue.purs
@@ -57,7 +57,7 @@ main = launchAff_ $ do
 
         Right packageOperation -> case packageOperation of
           Publish payload ->
-            API.publish PackageSource'Current payload
+            API.publish CurrentPackage payload
           Authenticated payload -> do
             -- If we receive an authenticated operation via GitHub, then we
             -- re-sign it with pacchettibotti credentials if and only if the
diff --git a/app/src/App/Prelude.purs b/app/src/App/Prelude.purs
index ddb677df..c9237ed3 100644
--- a/app/src/App/Prelude.purs
+++ b/app/src/App/Prelude.purs
@@ -278,13 +278,11 @@ pursPublishMethod = LegacyPursPublish
 -- | Operations can be exercised for old, pre-registry packages, or for packages
 -- | which are on the 0.15 compiler series. If a true legacy package is uploaded
 -- | then we do not require compilation to succeed and we don't publish docs.
-data PackageSource
-  = PackageSource'Legacy
-  | PackageSource'Current
+data PackageSource = LegacyPackage | CurrentPackage
 
 derive instance Eq PackageSource
 
 printPackageSource :: PackageSource -> String
 printPackageSource = case _ of
-  PackageSource'Legacy -> "legacy"
-  PackageSource'Current -> "current"
+  LegacyPackage -> "legacy"
+  CurrentPackage -> "current"
diff --git a/app/src/App/Server.purs b/app/src/App/Server.purs
index df40148a..33c0b0cd 100644
--- a/app/src/App/Server.purs
+++ b/app/src/App/Server.purs
@@ -70,7 +70,7 @@ router env { route, method, body } = HTTPurple.usingCont case route, method of
     lift $ Log.info $ "Received Publish request: " <> printJson Operation.publishCodec publish
     forkPipelineJob publish.name publish.ref PublishJob \jobId -> do
       Log.info $ "Received Publish request, job id: " <> unwrap jobId
-      API.publish PackageSource'Current publish
+      API.publish CurrentPackage publish
 
   Unpublish, Post -> do
     auth <- HTTPurple.fromJson (jsonDecoder Operation.authenticatedCodec) body
diff --git a/app/test/App/API.purs b/app/test/App/API.purs
index 0aafb4f9..22d72b97 100644
--- a/app/test/App/API.purs
+++ b/app/test/App/API.purs
@@ -69,7 +69,7 @@ spec = do
             }
 
         -- First, we publish the package.
-        API.publish PackageSource'Current publishArgs
+        API.publish CurrentPackage publishArgs
 
         -- Then, we can check that it did make it to "Pursuit" as expected
         Pursuit.getPublishedVersions name >>= case _ of
@@ -84,7 +84,7 @@ spec = do
 
         -- Finally, we can verify that publishing the package again should fail
         -- since it already exists.
-        Except.runExcept (API.publish PackageSource'Current publishArgs) >>= case _ of
+        Except.runExcept (API.publish CurrentPackage publishArgs) >>= case _ of
           Left _ -> pure unit
           Right _ -> Except.throw $ "Expected publishing " <> formatPackageVersion name version <> " twice to fail."
   where
diff --git a/scripts/src/LegacyImporter.purs b/scripts/src/LegacyImporter.purs
index a9059a29..36102e92 100644
--- a/scripts/src/LegacyImporter.purs
+++ b/scripts/src/LegacyImporter.purs
@@ -280,9 +280,9 @@ runLegacyImport mode logs = do
 
       let
         source = case mode of
-          DryRun -> PackageSource'Legacy
-          GenerateRegistry -> PackageSource'Legacy
-          UpdateRegistry -> PackageSource'Current
+          DryRun -> LegacyPackage
+          GenerateRegistry -> LegacyPackage
+          UpdateRegistry -> CurrentPackage
 
       void $ for notPublished \(Manifest manifest) -> do
         let formatted = formatPackageVersion manifest.name manifest.version
diff --git a/scripts/src/PackageDeleter.purs b/scripts/src/PackageDeleter.purs
index 17dc779b..a8c8339b 100644
--- a/scripts/src/PackageDeleter.purs
+++ b/scripts/src/PackageDeleter.purs
@@ -237,7 +237,7 @@ deleteVersion arguments name version = do
           Just (Left _) -> Log.error "Cannot reimport a version that was specifically unpublished"
           Just (Right specificPackageMetadata) -> do
             -- Obtains `newMetadata` via cache
-            API.publish PackageSource'Legacy
+            API.publish LegacyPackage
               { location: Just oldMetadata.location
               , name: name
               , ref: specificPackageMetadata.ref