Use current time as published date

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
@@ -374,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
@@ -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 == LegacyPackage -> 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 == 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."

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
+                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
+                CurrentPackage ->
+                  Run.liftEffect Now.nowDateTime
 
             -- Cloning will result in the `repo` name as the directory name
             publishedTime <- Except.runExcept getRefTime >>= case _ of

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 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

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,15 @@ 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 = LegacyPackage | CurrentPackage
+
+derive instance Eq PackageSource
+
+printPackageSource :: PackageSource -> String
+printPackageSource = case _ of
+  LegacyPackage -> "legacy"
+  CurrentPackage -> "current"

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 CurrentPackage publish
 
   Unpublish, Post -> do
     auth <- HTTPurple.fromJson (jsonDecoder Operation.authenticatedCodec) body

app/test/App/API.purs

@@ -69,7 +69,7 @@ spec = do
             }
 
         -- First, we publish the package.
-        API.publish API.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 API.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

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)."

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 -> LegacyPackage
+          GenerateRegistry -> LegacyPackage
+          UpdateRegistry -> CurrentPackage
 
       void $ for notPublished \(Manifest manifest) -> do
         let formatted = formatPackageVersion manifest.name manifest.version

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 LegacyPackage
               { location: Just oldMetadata.location
               , name: name
               , ref: specificPackageMetadata.ref