diff --git a/app/src/App/Auth.purs b/app/src/App/Auth.purs index 9c48cc03..c8647304 100644 --- a/app/src/App/Auth.purs +++ b/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 diff --git a/flake.lock b/flake.lock index 6dfd6d66..91bdc8b2 100644 --- a/flake.lock +++ b/flake.lock @@ -75,11 +75,11 @@ "slimlock": "slimlock" }, "locked": { - "lastModified": 1720786645, - "narHash": "sha256-eiuWqQ9xTA2E76XDg13TQBecnLV1g+ahdauC0FYSD7U=", + "lastModified": 1724938718, + "narHash": "sha256-lE6fUo7cgMcO20mH+9VRhDoMLlC99K5lMEVuJm+UGEI=", "owner": "thomashoneyman", "repo": "purescript-overlay", - "rev": "c46925ec09fdf54b5bb4ba38b40e19918d3be7be", + "rev": "9970a549c72aa7a787ea7cc205a0d52c3589f799", "type": "github" }, "original": { diff --git a/lib/src/Owner.purs b/lib/src/Owner.purs index e5fff9cc..f02abfed 100644 --- a/lib/src/Owner.purs +++ b/lib/src/Owner.purs @@ -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. diff --git a/lib/src/SSH.js b/lib/src/SSH.js index f59a1038..46c29301 100644 --- a/lib/src/SSH.js +++ b/lib/src/SSH.js @@ -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"), + }; +} diff --git a/lib/src/SSH.purs b/lib/src/SSH.purs index 5cec4911..9a922f4f 100644 --- a/lib/src/SSH.purs +++ b/lib/src/SSH.purs @@ -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 } diff --git a/lib/test/Registry/SSH.purs b/lib/test/Registry/SSH.purs index 92d18595..26ac3379 100644 --- a/lib/test/Registry/SSH.purs +++ b/lib/test/Registry/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." diff --git a/lib/test/Registry/Test/Utils.purs b/lib/test/Registry/Test/Utils.purs index 58d9f812..2e0869f3 100644 --- a/lib/test/Registry/Test/Utils.purs +++ b/lib/test/Registry/Test/Utils.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. diff --git a/spago.lock b/spago.lock index 75d0acb2..c13ad586 100644 --- a/spago.lock +++ b/spago.lock @@ -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 diff --git a/spago.yaml b/spago.yaml index 74b14750..20f1ce20 100644 --- a/spago.yaml +++ b/spago.yaml @@ -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: