diff --git a/src/IC/Crypto.hs b/src/IC/Crypto.hs index 0f6a028e..bb2d011e 100644 --- a/src/IC/Crypto.hs +++ b/src/IC/Crypto.hs @@ -6,7 +6,8 @@ Everything related to signature creation and checking module IC.Crypto ( SecretKey(..) , createSecretKeyEd25519 - , createSecretKeyWebAuthn + , createSecretKeyWebAuthnECDSA + , createSecretKeyWebAuthnRSA , createSecretKeyECDSA , createSecretKeySecp256k1 , createSecretKeyBLS @@ -40,8 +41,11 @@ data SecretKey createSecretKeyEd25519 :: BS.ByteString -> SecretKey createSecretKeyEd25519 = Ed25519 . Ed25519.createKey -createSecretKeyWebAuthn :: BS.ByteString -> SecretKey -createSecretKeyWebAuthn = WebAuthn . WebAuthn.createKey +createSecretKeyWebAuthnECDSA :: BS.ByteString -> SecretKey +createSecretKeyWebAuthnECDSA = WebAuthn . WebAuthn.createECDSAKey + +createSecretKeyWebAuthnRSA :: BS.ByteString -> SecretKey +createSecretKeyWebAuthnRSA = WebAuthn . WebAuthn.createRSAKey createSecretKeyECDSA :: BS.ByteString -> SecretKey createSecretKeyECDSA = ECDSA . ECDSA.createKey diff --git a/src/IC/Crypto/WebAuthn.hs b/src/IC/Crypto/WebAuthn.hs index 57795ce0..294dce40 100644 --- a/src/IC/Crypto/WebAuthn.hs +++ b/src/IC/Crypto/WebAuthn.hs @@ -10,7 +10,8 @@ nesting of CBOR, DER and JSONā€¦ module IC.Crypto.WebAuthn ( init , SecretKey - , createKey + , createECDSAKey + , createRSAKey , toPublicKey , sign , verify @@ -36,7 +37,11 @@ import Control.Monad.Except import qualified Crypto.PubKey.ECC.ECDSA as EC import qualified Crypto.PubKey.ECC.Generate as EC import qualified Crypto.PubKey.ECC.Types as EC +import qualified Crypto.PubKey.RSA as RSA (generate) +import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Crypto.PubKey.RSA.Types as RSA import qualified Crypto.Number.Serialize as EC +import Crypto.Random (withDRG, drgNewSeed, seedFromInteger) import Crypto.Hash.Algorithms (SHA256(..)) import Data.ASN1.Types import Data.ASN1.Encoding @@ -72,41 +77,49 @@ genClientDataJson challenge = JSON.encode $ JSON.Object $ <> "type" JSON..= ("webauthn.get" :: T.Text) <> "origin" JSON..= ("ic-ref-test" :: T.Text) -parseCOSEKey :: BS.ByteString -> Either T.Text EC.PublicKey -parseCOSEKey s = do +verifyCOSESig :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Either T.Text () +verifyCOSESig s msg sig = do kv <- decodeWithoutTag s >>= parseMap "COSE key" m <- M.fromList <$> mapM keyVal kv let field n = case M.lookup n m of Just x -> return x - Nothing -> throwError $ "COSE: missing entry " <> T.pack (show n) + Nothing -> throwError $ "COSE: missing entry " <> tshow n let intField n = field n >>= \case TInt i -> pure i - _ -> throwError $ "COSE field " <> T.pack (show n) <> " not an int" - let bytesField n = field n >>= \case - TBytes b -> pure b - _ -> throwError $ "COSE field " <> T.pack (show n) <> " not bytes" + _ -> throwError $ "COSE field " <> tshow n <> " not an int" + let integerField n = field n >>= \case + TBytes b -> pure $ EC.os2ip b + _ -> throwError $ "COSE field " <> tshow n <> " not bytes" ty <- intField 1 - unless (ty == 2) $ - throwError "COSE: Only key type 2 (EC2) supported" - ty <- intField 3 - unless (ty == -7) $ - throwError "COSE: Only type -7 (ECDSA) supported" - crv <- intField (-1) - unless (crv == 1) $ - throwError $ "parsePublicKey: unknown curve: " <> T.pack (show crv) - xb <- bytesField (-2) - yb <- bytesField (-3) - let x = EC.os2ip xb - let y = EC.os2ip yb - return $ EC.PublicKey curve (EC.Point x y) + alg <- intField 3 + case (ty, alg) of + (2, -7) -> do + crv <- intField (-1) + unless (crv == 1) $ + throwError $ "parsePublicKey: unknown curve: " <> tshow crv + x <- integerField (-2) + y <- integerField (-3) + let pk = EC.PublicKey curve (EC.Point x y) + sig <- parseCOSEECDSASig sig + unless (EC.verify SHA256 pk sig (BS.toStrict msg)) $ + throwError "WebAuthn signature verification failed" + (3, -257) -> do + n <- integerField (-1) + e <- integerField (-2) + let pk = RSA.PublicKey 256 n e + unless (RSA.verify (Just SHA256) pk (BS.toStrict msg) (BS.toStrict sig)) $ + throwError "WebAuthn signature verification failed" + _ -> throwError $ "COSE: Unsupported pair of type, algorithm: " <> tshow ty <> " " <> tshow alg where keyVal (TInt k,v) = pure (fromIntegral k,v) keyVal (TInteger k,v) = pure (k,v) keyVal _ = throwError "Non-integer key in CBOR map" + tshow :: Show a => a -> T.Text + tshow v = T.pack (show v) -genCOSEKey :: EC.PublicKey -> BS.ByteString -genCOSEKey (EC.PublicKey _curve (EC.Point x y)) = +genCOSEECDSAKey :: EC.PublicKey -> BS.ByteString +genCOSEECDSAKey (EC.PublicKey _curve (EC.Point x y)) = toLazyByteString $ encodeTerm $ TMap [ (TInt 1, TInt 2) , (TInt 3, TInt (-7)) @@ -114,52 +127,72 @@ genCOSEKey (EC.PublicKey _curve (EC.Point x y)) = , (TInt (-2), TBytes (EC.i2ospOf_ 32 x)) , (TInt (-3), TBytes (EC.i2ospOf_ 32 y)) ] -genCOSEKey (EC.PublicKey _ EC.PointO) = error "genCOSEKey: Point at infinity" - +genCOSEECDSAKey (EC.PublicKey _ EC.PointO) = error "genCOSEKey: Point at infinity" +genCOSERSAKey :: RSA.PublicKey -> BS.ByteString +genCOSERSAKey (RSA.PublicKey _keyLength n e) = + toLazyByteString $ encodeTerm $ TMap + [ (TInt 1, TInt 3) + , (TInt 3, TInt (-257)) + , (TInt (-1), TBytes (EC.i2osp n)) + , (TInt (-2), TBytes (EC.i2osp e)) + ] -parseCOSESig :: BS.ByteString -> Either T.Text EC.Signature -parseCOSESig s = +parseCOSEECDSASig :: BS.ByteString -> Either T.Text EC.Signature +parseCOSEECDSASig s = first T.pack (safeDecode s) >>= \case [Start Sequence,IntVal r,IntVal s,End Sequence] -> pure $ EC.Signature r s a -> throwError $ "Unexpected DER encoding for COSE sig: " <> T.pack (show a) -genCOSESig :: EC.Signature -> BS.ByteString -genCOSESig (EC.Signature r s) = encodeASN1 DER +genCOSEECDSASig :: EC.Signature -> BS.ByteString +genCOSEECDSASig (EC.Signature r s) = encodeASN1 DER [Start Sequence,IntVal r,IntVal s,End Sequence] -data SecretKey = SecretKey EC.PrivateKey EC.PublicKey +data SecretKey = ECDSASecretKey EC.PrivateKey EC.PublicKey + | RSASecretKey RSA.PrivateKey deriving Show curve :: EC.Curve curve = EC.getCurveByName EC.SEC_p256r1 -createKey :: BS.ByteString -> SecretKey -createKey seed = - SecretKey (EC.PrivateKey curve d) (EC.PublicKey curve q) +createECDSAKey :: BS.ByteString -> SecretKey +createECDSAKey seed = + ECDSASecretKey (EC.PrivateKey curve d) (EC.PublicKey curve q) where n = EC.ecc_n $ EC.common_curve curve d = fromIntegral (hash seed) `mod` (n-2) + 1 q = EC.generateQ curve d +createRSAKey :: BS.ByteString -> SecretKey +createRSAKey seed = + RSASecretKey $ snd $ fst $ withDRG drg (RSA.generate 256 3) + where + drg = drgNewSeed $ seedFromInteger $ fromIntegral $ hash seed + toPublicKey :: SecretKey -> BS.ByteString -toPublicKey (SecretKey _ pk) = genCOSEKey pk +toPublicKey key = case key of + (ECDSASecretKey _ pk) -> genCOSEECDSAKey pk + (RSASecretKey pk) -> genCOSERSAKey (RSA.private_pub pk) sign :: SecretKey -> BS.ByteString -> IO BS.ByteString -sign (SecretKey sk _) msg = do +sign (ECDSASecretKey sk _) msg = do let cdj = genClientDataJson msg let ad = "arbitrary?" sig <- EC.sign sk SHA256 (BS.toStrict (ad <> sha256 cdj)) - return $ genSig (ad, cdj, genCOSESig sig) + return $ genSig (ad, cdj, genCOSEECDSASig sig) +sign (RSASecretKey pk) msg = do + let cdj = genClientDataJson msg + let ad = "arbitrary?" + case RSA.sign Nothing (Just SHA256) pk (BS.toStrict (ad <> sha256 cdj)) of + Left err -> error (show err) + Right sig -> + return $ genSig (ad, cdj, BS.fromStrict sig) verify :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Either T.Text () verify pk msg sig = do (ad, cdj, sig) <- parseSig sig - pk <- parseCOSEKey pk - sig <- parseCOSESig sig - unless (EC.verify SHA256 pk sig (BS.toStrict $ ad <> sha256 cdj)) $ - throwError "WebAuthn signature verification failed" + verifyCOSESig pk (ad <> sha256 cdj) sig challenge <- parseClientDataJson cdj unless (challenge == msg) $ throwError $ "Wrong challenge. Expected " <> T.pack (show msg) <> diff --git a/src/IC/Test/Agent.hs b/src/IC/Test/Agent.hs index 47d3e696..8fcc849c 100644 --- a/src/IC/Test/Agent.hs +++ b/src/IC/Test/Agent.hs @@ -154,8 +154,11 @@ defaultSK = createSecretKeyEd25519 "fixed32byteseedfortesting" otherSK :: SecretKey otherSK = createSecretKeyEd25519 "anotherfixed32byteseedfortesting" -webAuthnSK :: SecretKey -webAuthnSK = createSecretKeyWebAuthn "webauthnseed" +webAuthnECDSASK :: SecretKey +webAuthnECDSASK = createSecretKeyWebAuthnECDSA "webauthnseed" + +webAuthnRSASK :: SecretKey +webAuthnRSASK = createSecretKeyWebAuthnRSA "webauthnseed" ecdsaSK :: SecretKey ecdsaSK = createSecretKeyECDSA "ecdsaseed" @@ -167,8 +170,10 @@ defaultUser :: Blob defaultUser = mkSelfAuthenticatingId $ toPublicKey defaultSK otherUser :: Blob otherUser = mkSelfAuthenticatingId $ toPublicKey otherSK -webAuthnUser :: Blob -webAuthnUser = mkSelfAuthenticatingId $ toPublicKey webAuthnSK +webAuthnECDSAUser :: Blob +webAuthnECDSAUser = mkSelfAuthenticatingId $ toPublicKey webAuthnECDSASK +webAuthnRSAUser :: Blob +webAuthnRSAUser = mkSelfAuthenticatingId $ toPublicKey webAuthnRSASK ecdsaUser :: Blob ecdsaUser = mkSelfAuthenticatingId $ toPublicKey ecdsaSK secp256k1User :: Blob @@ -242,7 +247,8 @@ envelopeFor u content = envelope key content key :: SecretKey key | u == defaultUser = defaultSK | u == otherUser = otherSK - | u == webAuthnUser = webAuthnSK + | u == webAuthnECDSAUser = webAuthnECDSASK + | u == webAuthnRSAUser = webAuthnRSASK | u == ecdsaUser = ecdsaSK | u == secp256k1User = secp256k1SK | u == anonymousUser = error "No key for the anonymous user" diff --git a/src/IC/Test/Spec.hs b/src/IC/Test/Spec.hs index 50c819da..74fa06d4 100644 --- a/src/IC/Test/Spec.hs +++ b/src/IC/Test/Spec.hs @@ -1867,7 +1867,8 @@ icTests = withAgentConfig $ testGroup "Interface Spec acceptance tests" ] withEd25519 = zip [createSecretKeyEd25519 (BS.singleton n) | n <- [0..]] - withWebAuthn = zip [createSecretKeyWebAuthn (BS.singleton n) | n <- [0..]] + withWebAuthnECDSA = zip [createSecretKeyWebAuthnECDSA (BS.singleton n) | n <- [0..]] + withWebAuthnRSA = zip [createSecretKeyWebAuthnRSA (BS.singleton n) | n <- [0..]] in [ goodTestCase "one delegation, singleton target" callReq $ \cid -> @@ -1876,8 +1877,10 @@ icTests = withAgentConfig $ testGroup "Interface Spec acceptance tests" withEd25519 [Just [doesn'tExist]] , goodTestCase "one delegation, two targets" callReq $ \cid -> withEd25519 [Just [cid, doesn'tExist]] - , goodTestCase "two delegations, two targets, webauthn" callReq $ \cid -> - withWebAuthn [Just [cid, doesn'tExist], Just [cid, doesn'tExist]] + , goodTestCase "two delegations, two targets, webauthn ECDSA" callReq $ \cid -> + withWebAuthnECDSA [Just [cid, doesn'tExist], Just [cid, doesn'tExist]] + , goodTestCase "two delegations, two targets, webauthn RSA" callReq $ \cid -> + withWebAuthnRSA [Just [cid, doesn'tExist], Just [cid, doesn'tExist]] , goodTestCase "one delegation, redundant targets" callReq $ \cid -> withEd25519 [Just [cid, cid, doesn'tExist]] , goodTestCase "two delegations, singletons" callReq $ \cid -> @@ -1908,15 +1911,16 @@ icTests = withAgentConfig $ testGroup "Interface Spec acceptance tests" ed25519SK4 = createSecretKeyEd25519 "even more keys" delEnv sks = delegationEnv otherSK (map (, Nothing) sks) -- no targets in these tests in flip foldMap - [ ("Ed25519", otherUser, envelope otherSK) - , ("ECDSA", ecdsaUser, envelope ecdsaSK) - , ("secp256k1", secp256k1User, envelope secp256k1SK) - , ("WebAuthn", webAuthnUser, envelope webAuthnSK) - , ("empty delegations", otherUser, delEnv []) - , ("same delegations", otherUser, delEnv [otherSK]) - , ("three delegations", otherUser, delEnv [ed25519SK2, ed25519SK3]) - , ("four delegations", otherUser, delEnv [ed25519SK2, ed25519SK3, ed25519SK4]) - , ("mixed delegations", otherUser, delEnv [defaultSK, webAuthnSK, ecdsaSK, secp256k1SK]) + [ ("Ed25519", otherUser, envelope otherSK) + , ("ECDSA", ecdsaUser, envelope ecdsaSK) + , ("secp256k1", secp256k1User, envelope secp256k1SK) + , ("WebAuthn ECDSA", webAuthnECDSAUser, envelope webAuthnECDSASK) + , ("WebAuthn RSA", webAuthnRSAUser, envelope webAuthnRSASK) + , ("empty delegations", otherUser, delEnv []) + , ("same delegations", otherUser, delEnv [otherSK]) + , ("three delegations", otherUser, delEnv [ed25519SK2, ed25519SK3]) + , ("four delegations", otherUser, delEnv [ed25519SK2, ed25519SK3, ed25519SK4]) + , ("mixed delegations", otherUser, delEnv [defaultSK, webAuthnECDSASK, webAuthnRSASK, ecdsaSK, secp256k1SK]) ] $ \ (name, user, env) -> [ simpleTestCase (name ++ " in query") $ \cid -> do req <- addExpiry $ rec diff --git a/src/IC/Test/WebAuthn.hs b/src/IC/Test/WebAuthn.hs index c8d8c45b..c10666a1 100644 --- a/src/IC/Test/WebAuthn.hs +++ b/src/IC/Test/WebAuthn.hs @@ -24,19 +24,34 @@ assertLeft (Right _) = assertFailure "Unexpected success" webAuthnTests :: TestTree webAuthnTests = testGroup "WebAuthn crypto tests" - [ testProperty "create-sign-verify" $ + [ testProperty "ECDSA: create-sign-verify" $ \(BS.pack -> seed) (BS.pack -> msg) -> do - let sk = WebAuthn.createKey seed + let sk = WebAuthn.createECDSAKey seed sig <- WebAuthn.sign sk msg assertRight $ WebAuthn.verify (WebAuthn.toPublicKey sk) msg sig - , testProperty "invalid sig" $ + , testProperty "ECDSA: invalid sig" $ \(BS.pack -> seed) (BS.pack -> msg) (BS.pack -> sig) -> - let sk = WebAuthn.createKey seed in + let sk = WebAuthn.createECDSAKey seed in assertLeft $ WebAuthn.verify (WebAuthn.toPublicKey sk) msg sig - , testProperty "wrong message" $ + , testProperty "ECDSA: wrong message" $ \(BS.pack -> seed) (BS.pack -> msg1) (BS.pack -> msg2) -> msg1 /= msg2 ==> do - let sk = WebAuthn.createKey seed + let sk = WebAuthn.createECDSAKey seed + sig <- WebAuthn.sign sk msg2 + assertLeft $ WebAuthn.verify (WebAuthn.toPublicKey sk) msg1 sig + , testProperty "RSA: create-sign-verify" $ + \(BS.pack -> seed) (BS.pack -> msg) -> do + let sk = WebAuthn.createRSAKey seed + sig <- WebAuthn.sign sk msg + assertRight $ WebAuthn.verify (WebAuthn.toPublicKey sk) msg sig + , testProperty "RSA: invalid sig" $ + \(BS.pack -> seed) (BS.pack -> msg) (BS.pack -> sig) -> + let sk = WebAuthn.createRSAKey seed in + assertLeft $ WebAuthn.verify (WebAuthn.toPublicKey sk) msg sig + , testProperty "RSA: wrong message" $ + \(BS.pack -> seed) (BS.pack -> msg1) (BS.pack -> msg2) -> + msg1 /= msg2 ==> do + let sk = WebAuthn.createRSAKey seed sig <- WebAuthn.sign sk msg2 assertLeft $ WebAuthn.verify (WebAuthn.toPublicKey sk) msg1 sig ]