Adds verification of RSA signatures (#26)

* WIP on adding RSA support

* Progress on supporting RSA keys for WebAuthn

* fixup! Progress on supporting RSA keys for WebAuthn

* Use minimal amount of bytes when encoding RSA keys

* Removes unused definition

* Update src/IC/Crypto/WebAuthn.hs

Co-authored-by: Joachim Breitner <[email protected]>

* Export helper to create an RSA Webauthn key from a seed

* Address review feedback from Gabor

* Use RSA scheme for WebAuthn in ic-ref-test

Co-authored-by: Bas van Dijk <[email protected]>
Co-authored-by: Daniel Stefan Dietiker <[email protected]>
Co-authored-by: Joachim Breitner <[email protected]>

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

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,94 +77,122 @@ 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))
     , (TInt (-1), TInt 1)
     , (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) <>

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"

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

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
   ]