Debug Windows failure

.github/workflows/build.yml

@@ -13,8 +13,8 @@ jobs:
     strategy:
       matrix:
         include:
-          # - os: ubuntu-latest
-          # - os: macOS-latest
+          - os: ubuntu-latest
+          - os: macOS-latest
           - os: windows-latest
     steps:
       # We set LF endings so that the Windows environment is consistent with the rest
@@ -82,8 +82,6 @@ jobs:
         run: node ./bin/bundle.js bundle -p docs-search-client-halogen
 
       - name: Run tests
-        env:
-          SPAGO_TEST_DEBUG: 1
         run: node ./bin/bundle.js test -- -e "fails if running with --offline" --no-timeout
 
       - name: Check formatting (Linux only)

core/src/Path.purs

@@ -94,8 +94,11 @@ instance IsPath LocalPath where
 
 instance IsPath GlobalPath where
   toGlobal = identity
-  relativeTo (GlobalPath path) (RootPath root) =
-    LocalPath { root: RootPath root, local: Path.relative root path }
+  relativeTo (GlobalPath path) (RootPath root)
+    | bothAbsolutePathsOnDifferentDrives path root =
+        LocalPath { root: RootPath path, local: "" }
+    | otherwise =
+        LocalPath { root: RootPath root, local: Path.relative root path }
   quote (GlobalPath path) =
     "\"" <> path <> "\""
   replaceExtension p r (GlobalPath path) =
@@ -178,3 +181,9 @@ printLocalPath p =
     l = localPart p
   in
     if l == "" then "./" else l
+
+bothAbsolutePathsOnDifferentDrives :: String -> String -> Boolean
+bothAbsolutePathsOnDifferentDrives a b =
+  Path.isAbsolute a && Path.isAbsolute b && driveLetter a /= driveLetter b
+  where
+  driveLetter s = String.toLower $ String.take 1 s

src/Spago/Command/Registry.purs

@@ -27,6 +27,7 @@ import Spago.FS as FS
 import Spago.Git as Git
 import Spago.Json as Json
 import Spago.Path as Path
+import Spago.Paths as Paths
 import Spago.Registry (RegistryEnv)
 import Spago.Registry as Registry
 
@@ -216,7 +217,7 @@ transfer { privateKeyPath } = do
       let dataToSign = { name: selected.package.name, newLocation }
       let rawPayload = Json.stringifyJson Operation.transferCodec dataToSign
 
-      key <- getPrivateKeyForSigning $ rootPath </> privateKeyPath
+      key <- getPrivateKeyForSigning privateKeyPath
       -- We have a key! We can sign the payload with it, and submit the whole package to the Registry
       let signature = SSH.sign key rawPayload
 
@@ -230,8 +231,11 @@ transfer { privateKeyPath } = do
           , payload: Operation.Transfer dataToSign
           }
 
-getPrivateKeyForSigning :: ∀ e. LocalPath -> Spago (LogEnv e) SSH.PrivateKey
-getPrivateKeyForSigning privateKeyPath = do
+getPrivateKeyForSigning :: ∀ e. AdHocFilePath -> Spago (LogEnv e) SSH.PrivateKey
+getPrivateKeyForSigning privateKeyPath' = do
+  here <- Paths.cwd
+  let privateKeyPath = here </> privateKeyPath'
+
   -- If all is well we read in the private key
   privateKey <- try (FS.readTextFile privateKeyPath) >>= case _ of
     Right key -> pure key

test/Spago/Publish.purs

@@ -5,7 +5,6 @@ import Test.Prelude
 import Data.String as String
 import Data.String.Regex as Regex
 import Data.String.Regex.Flags as RF
-import Debug (traceM)
 import Node.Platform as Platform
 import Node.Process as Process
 import Spago.Cmd as Cmd
@@ -115,8 +114,6 @@ spec = Spec.around withTempDir do
 
     Spec.it "fails if running with --offline" \{ spago, fixture, testCwd } -> do
       FS.copyFile { src: fixture "publish/transfer/aff-new-location.yaml", dst: testCwd </> "spago.yaml" }
-      traceM $ Path.quote $ fixture "publish/key"
-      traceM =<< FS.exists (fixture "publish/key")
       spago [ "auth", "-i", (Path.toRaw $ fixture "publish/key") ] >>= shouldBeSuccess
       doTheGitThing
       spago [ "registry", "transfer", "-v", "--offline", "-i", (Path.toRaw $ fixture "publish/key") ] >>= shouldBeFailureErr (fixture "publish/transfer/offline.txt")

test/Spago/Unit/Path.purs

@@ -3,6 +3,8 @@ module Test.Spago.Unit.Path where
 import Test.Prelude
 
 import Effect.Unsafe (unsafePerformEffect)
+import Node.Platform (Platform(..)) as Node
+import Node.Process (platform) as Node
 import Spago.Path as Path
 import Test.Spec (Spec)
 import Test.Spec as Spec
@@ -48,6 +50,15 @@ spec = Spec.describe "Paths" do
       (Path.global "/foo/x/y" </> "/foo/x/y/z") `shouldPointAt` "/foo/x/y/z"
       (Path.global "/foo/x/y" </> ".." </> ".." </> "bar") `shouldPointAt` "/foo/bar"
 
+  when (Node.platform == Just Node.Win32) do
+    Spec.describe "On different drives under Windows" do
+      Spec.it "LocalPath appends correctly" do
+        (root "C:\\foo" </> "bar") `shouldPointAt` "C:/foo/bar"
+        (root "C:\\foo" </> "bar" </> "baz") `shouldPointAt` "C:/foo/bar/baz"
+        (root "C:\\foo\\x\\y" </> "D:\\bar" </> "baz") `shouldPointAt` "D:/bar/baz"
+        (root "C:\\foo\\x\\y" </> "D:\\foo\\x\\y\\z") `shouldPointAt` "D:/foo/x/y/z"
+        (root "C:\\foo\\x\\y" </> ".." </> ".." </> "bar") `shouldPointAt` "C:/foo/bar"
+
   where
   root = unsafePerformEffect <<< Path.mkRoot <<< Path.global