Few fixes to SSH and Owner to implement auth and transfer commands in Spago (#695)

Author: f-f

app/src/App/Auth.purs

@@ -33,5 +33,5 @@ type SignAuthenticated =
 
 signPayload :: SignAuthenticated -> Either String SSH.Signature
 signPayload { privateKey, rawPayload } = do
-  private <- SSH.parsePrivateKey privateKey
+  private <- lmap SSH.printPrivateKeyParseError $ SSH.parsePrivateKey { key: privateKey, passphrase: Nothing }
   pure $ SSH.sign private rawPayload

flake.lock

@@ -25,7 +25,11 @@ newtype Owner = Owner
   }
 
 derive instance Newtype Owner _
-derive newtype instance Eq Owner
+
+-- | Owners are equal if their keytype and public key are equal, regardless of
+-- | the id field, which is just an arbitrary string.
+instance Eq Owner where
+  eq (Owner o1) (Owner o2) = o1.keytype == o2.keytype && o1.public == o2.public
 
 -- | A codec for encoding and decoding an `Owner` as JSON. Represented as a JSON
 -- | object.

lib/src/Owner.purs

@@ -28,3 +28,11 @@ export function isPrivateKeyImpl(parsedKey) {
 export function equalsImpl(a, b) {
   return a.equals(b);
 }
+
+export function publicToOwnerImpl(parsedKey) {
+  return {
+    id: parsedKey.comment,
+    keytype: parsedKey.type,
+    public: parsedKey.getPublicSSH().toString("base64"),
+  };
+}

lib/src/SSH.js

@@ -1,21 +1,27 @@
 module Registry.SSH
   ( PublicKey
   , PrivateKey
+  , PrivateKeyParseError(..)
+  , printPrivateKeyParseError
   , Signature(..)
   , parsePublicKey
   , parsePrivateKey
-  , parsePrivateKeyWithPassword
+  , publicKeyToOwner
   , sign
   , verify
   ) where
 
 import Prelude
 
+import Data.Bifunctor (bimap)
 import Data.Either (Either(..))
 import Data.Function.Uncurried (Fn1, Fn2, Fn3, Fn4, runFn1, runFn2, runFn3, runFn4)
+import Data.Maybe (Maybe)
 import Data.Newtype (class Newtype)
-import Data.Nullable (Nullable, notNull, null)
+import Data.Nullable (Nullable, null)
+import Data.Nullable as Nullable
 import Effect.Exception as Exception
+import Registry.Owner (Owner(..))
 
 -- | A parsed SSH public key which can be used to verify payloads.
 newtype PublicKey = PublicKey ParsedKey
@@ -37,18 +43,23 @@ foreign import parseKeyImpl :: forall r. Fn4 (Exception.Error -> r) (ParsedKey -
 parse :: String -> Either String ParsedKey
 parse buf = runFn4 parseKeyImpl (Left <<< Exception.message) Right buf null
 
--- | Parse a non-password-protected private SSH key
-parsePrivateKey :: String -> Either String PrivateKey
-parsePrivateKey key = case parse key of
-  Right parsed | not (isPrivateKey parsed) -> Left $ "Expected private key, but this is a public key of type " <> keyType parsed
-  result -> map PrivateKey result
+data PrivateKeyParseError
+  = GotPublicKeyInstead String
+  | RequiresPassphrase
+  | OtherParseError String
 
--- | Parse a password-protected private SSH key
-parsePrivateKeyWithPassword :: { key :: String, passphrase :: String } -> Either String PrivateKey
-parsePrivateKeyWithPassword { key, passphrase } =
-  case runFn4 parseKeyImpl (Left <<< Exception.message) Right key (notNull passphrase) of
-    Right parsed | not (isPrivateKey parsed) -> Left $ "Expected private key, but this is a public key of type " <> keyType parsed
-    result -> map PrivateKey result
+printPrivateKeyParseError :: PrivateKeyParseError -> String
+printPrivateKeyParseError = case _ of
+  GotPublicKeyInstead keyType' -> "Expected private key, but got public key of type " <> keyType'
+  RequiresPassphrase -> "Encrypted private key requires a passphrase"
+  OtherParseError message -> message
+
+parsePrivateKey :: { key :: String, passphrase :: Maybe String } -> Either PrivateKeyParseError PrivateKey
+parsePrivateKey { key, passphrase } =
+  case runFn4 parseKeyImpl (Left <<< Exception.message) Right key (Nullable.toNullable passphrase) of
+    Right parsed | not (isPrivateKey parsed) -> Left $ GotPublicKeyInstead $ keyType parsed
+    Left "Encrypted private OpenSSH key detected, but no passphrase given" -> Left RequiresPassphrase
+    result -> bimap OtherParseError PrivateKey result
 
 -- | Parse a public SSH key
 parsePublicKey :: String -> Either String PublicKey
@@ -88,3 +99,10 @@ isPrivateKey :: ParsedKey -> Boolean
 isPrivateKey = runFn1 isPrivateKeyImpl
 
 foreign import equalsImpl :: Fn2 ParsedKey ParsedKey Boolean
+
+foreign import publicToOwnerImpl :: Fn1 PublicKey { keytype :: String, public :: String, id :: Nullable String }
+
+publicKeyToOwner :: PublicKey -> Owner
+publicKeyToOwner key = do
+  let { id: nullableId, keytype, public } = runFn1 publicToOwnerImpl key
+  Owner { keytype, public, id: Nullable.toMaybe nullableId }

lib/src/SSH.purs

@@ -3,6 +3,7 @@ module Test.Registry.SSH (spec) where
 import Prelude
 
 import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
 import Data.String as String
 import Registry.SSH (Signature(..))
 import Registry.SSH as SSH
@@ -13,8 +14,8 @@ import Test.Spec as Spec
 spec :: Spec.Spec Unit
 spec = do
   Spec.it "Parses an ED25519 private key" do
-    case SSH.parsePrivateKey id_ed25519 of
-      Left err -> Assert.fail $ "Failed to parse ed_25519 private key: " <> err
+    case SSH.parsePrivateKey { key: id_ed25519, passphrase: Nothing } of
+      Left err -> Assert.fail $ "Failed to parse ed_25519 private key: " <> SSH.printPrivateKeyParseError err
       Right _ -> pure unit
 
   Spec.it "Parses an ED25519 public key" do
@@ -23,12 +24,13 @@ spec = do
       Right _ -> pure unit
 
   Spec.it "Parses a password-protected RSA private key" do
-    case SSH.parsePrivateKey id_rsa of
-      Left err1 -> do
-        err1 `Assert.shouldEqual` "Encrypted private OpenSSH key detected, but no passphrase given"
-        case SSH.parsePrivateKeyWithPassword { key: id_rsa, passphrase: id_rsa_password } of
-          Left err2 -> Assert.fail $ "Failed to parse id_rsa private key with password: " <> err2
+    case SSH.parsePrivateKey { key: id_rsa, passphrase: Nothing } of
+      Left err1@SSH.RequiresPassphrase -> do
+        SSH.printPrivateKeyParseError err1 `Assert.shouldEqual` "Encrypted private key requires a passphrase"
+        case SSH.parsePrivateKey { key: id_rsa, passphrase: Just id_rsa_password } of
+          Left err2 -> Assert.fail $ "Failed to parse id_rsa private key with password: " <> SSH.printPrivateKeyParseError err2
           Right _ -> pure unit
+      Left otherError -> Assert.fail $ "Should have required a passphrase, but got: " <> SSH.printPrivateKeyParseError otherError
       Right _ -> Assert.fail $ "Expected parse failure, but got key."
 
   Spec.it "Parses an RSA public key" do
@@ -41,7 +43,7 @@ spec = do
       Left _ -> pure unit
       Right _ -> Assert.fail "Parsed private key as a public key."
 
-    case SSH.parsePrivateKey id_ed25519_pub of
+    case SSH.parsePrivateKey { key: id_ed25519_pub, passphrase: Nothing } of
       Left _ -> pure unit
       Right _ -> Assert.fail "Parsed public key as a private key."
 

lib/test/Registry/SSH.purs

@@ -91,7 +91,7 @@ unsafeSSHPublicKey str = fromRight ("Failed to parse SSH key: " <> str) (SSH.par
 
 -- | Unsafely parse a private SSH key from a string
 unsafeSSHPrivateKey :: String -> SSH.PrivateKey
-unsafeSSHPrivateKey str = fromRight ("Failed to parse SSH key: " <> str) (SSH.parsePrivateKey str)
+unsafeSSHPrivateKey str = fromRight ("Failed to parse SSH key: " <> str) (SSH.parsePrivateKey { key: str, passphrase: Nothing })
 
 -- | Unsafely create a manifest from a name, version, and array of dependencies
 -- | where keys are package names and values are ranges.

lib/test/Registry/Test/Utils.purs

@@ -201,7 +201,7 @@ workspace:
         - variant
       test_dependencies: []
   package_set:
-    registry: 46.0.0
+    registry: 50.10.0
   extra_packages:
     codec-json: 1.2.0
     dodo-printer:
@@ -568,10 +568,11 @@ packages:
       - prelude
   encoding:
     type: registry
-    version: 0.0.8
-    integrity: sha256-n0HhENAax0yr7JFwZXcisx0jJvVf1dFwqd+Q5i2Pr88=
+    version: 0.0.9
+    integrity: sha256-vtyUO06Jww8pFl4wRekPd1YpJl2XuQXcaNXQgHtG8Tk=
     dependencies:
       - arraybuffer-types
+      - effect
       - either
       - exceptions
       - functions
@@ -608,16 +609,18 @@ packages:
       - unsafe-coerce
   fetch:
     type: registry
-    version: 4.0.0
-    integrity: sha256-Ita74WPIvzCsSIkUQQbBDKgIrsnuBWIRzEJ8Q5P7iQU=
+    version: 4.1.0
+    integrity: sha256-zCwBUkRL9n6nUhK1+7UqqsuxswPFATsZfGSBOA3NYYY=
     dependencies:
       - aff
       - arraybuffer-types
       - bifunctors
       - effect
+      - either
       - foreign
       - http-methods
       - js-fetch
+      - js-promise
       - js-promise-aff
       - maybe
       - newtype
@@ -1354,8 +1357,8 @@ packages:
       - tuples
   ordered-collections:
     type: registry
-    version: 3.1.1
-    integrity: sha256-boSYHmlz4aSbwsNN4VxiwCStc0t+y1F7BXmBS+1JNtI=
+    version: 3.2.0
+    integrity: sha256-o9jqsj5rpJmMdoe/zyufWHFjYYFTTsJpgcuCnqCO6PM=
     dependencies:
       - arrays
       - foldable-traversable
@@ -1452,8 +1455,8 @@ packages:
     dependencies: []
   profunctor:
     type: registry
-    version: 6.0.0
-    integrity: sha256-99NzxFgTr4CGlCSRYG1kShL+JhYbihhHtbOk1/0R5zI=
+    version: 6.0.1
+    integrity: sha256-E58hSYdJvF2Qjf9dnWLPlJKh2Z2fLfFLkQoYi16vsFk=
     dependencies:
       - control
       - distributive
@@ -1616,8 +1619,8 @@ packages:
       - unsafe-coerce
   spec:
     type: registry
-    version: 7.5.5
-    integrity: sha256-HdyBH7Ys1/m2SdTq3u2u9LdQ4cGeaohWeEMYay2mHdU=
+    version: 7.6.0
+    integrity: sha256-+merGdQbL9zWONbnt8S8J9afGJ59MQqGtS0qSd3yu4I=
     dependencies:
       - aff
       - ansi
@@ -1626,7 +1629,6 @@ packages:
       - bifunctors
       - control
       - datetime
-      - debug
       - effect
       - either
       - exceptions

spago.lock

@@ -1,7 +1,7 @@
 workspace:
   lock: true
   package_set:
-    registry: 46.0.0
+    registry: 50.10.0
   extra_packages:
     codec-json: 1.2.0
     dodo-printer: