webauthn signatures (#1193)

* Implement webauthn signature checking
* Bump base64-bytestring

Co-authored-by: John Wiegley <[email protected]>
Co-authored-by: Edmund Noble <[email protected]>
Co-authored-by: Lars Kuhtz <[email protected]>

cabal.project

@@ -3,13 +3,6 @@ packages: .
 -- temporary upper bounds
 constraints: sbv <10
 
--- these upper bounds are required in order to not break payload validation in chainweb
-constraints: base16-bytestring <1
-constraints: base64-bytestring <1.1
-
-allow-newer: base64-bytestring:*
-allow-newer: base16-bytestring:*
-
 -- test upper bounds
 constraints: hspec-golden <0.2,
 

docs/en/pact-functions.md

@@ -461,7 +461,7 @@ Return ID if called during current pact execution, failing if not.
 Obtain current pact build version.
 ```lisp
 pact> (pact-version)
-"4.8"
+"4.9"
 ```
 
 Top level only: this function will fail if used in module code.
@@ -1928,7 +1928,7 @@ Retreive any accumulated events and optionally clear event state. Object returne
  *→* `[string]`
 
 
-Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
+Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact420","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePact49","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
 ```lisp
 pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config)
 ["DisableHistoryInTransactionalMode"]
@@ -2104,14 +2104,6 @@ pact> (expect-that "addition" (> 2) (+ 1 2))
 ```
 
 
-### format-address {#format-address}
-
-*scheme* `string` *public-key* `string` *→* `string`
-
-
-Transform PUBLIC-KEY into an address (i.e. a Pact Runtime Public Key) depending on its SCHEME.
-
-
 ### load {#load}
 
 *file* `string` *→* `string`

pact.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.2
 name:                pact
-version:             4.8
+version:             4.9
 -- ^ 4 digit is prerelease, 3- or 2-digit for prod release
 synopsis:            Smart contract language library and REPL
 description:
@@ -145,7 +145,6 @@ library
     Pact.Types.Command
     Pact.Types.Continuation
     Pact.Types.Crypto
-    Pact.Types.ECDSA
     Pact.Types.Exp
     Pact.Types.ExpParser
     Pact.Types.Gas
@@ -229,6 +228,7 @@ library
     , scientific >= 0.3
     , semigroupoids >=5.0
     , semirings
+    , serialise >= 0.2.6
     , servant
     , servant-client >=0.16
     , servant-client-core >=0.16
@@ -242,6 +242,7 @@ library
     , vector-algorithms >=0.7
     , vector-space >=0.10.4
     , yaml
+    , webauthn >= 0.7
 
   if flag(build-tool)
     cpp-options: -DBUILD_TOOL

src/Pact/ApiReq.hs

@@ -296,7 +296,7 @@ loadSigData fp = do
     Left e -> Left $ "Error loading SigData file " <> fp <> ": " <> show e
     Right sd -> Right sd
 
-addSigToSigData :: SomeKeyPair -> SigData a -> IO (SigData a)
+addSigToSigData :: Ed25519KeyPair -> SigData a -> IO (SigData a)
 addSigToSigData kp sd = do
   sig <- signHash (_sigDataHash sd) kp
   let k = PublicKeyHex $ toB16Text $ getPublic kp
@@ -384,7 +384,7 @@ addSigReq sd keyFile = do
   kp <- importKeyFile keyFile
   addSigToSigData kp sd
 
-importKeyFile :: FilePath -> IO SomeKeyPair
+importKeyFile :: FilePath -> IO Ed25519KeyPair
 importKeyFile keyFile = do
   v :: Value <- decodeYaml keyFile
   let ekp = do
@@ -393,7 +393,7 @@ importKeyFile keyFile = do
         pub <- getKey "public" v
         sec <- getKey "secret" v
 
-        importKeyPair defaultScheme (Just $ PubBS pub) (PrivBS sec)
+        importKeyPair (Just $ PubBS pub) (PrivBS sec)
   case ekp of
     Left e -> dieAR $ "Could not parse key file " <> keyFile <> ": " <> e
     Right kp -> return kp
@@ -480,7 +480,7 @@ signCmd keyFiles bs = do
 withKeypairsOrSigner
   :: Bool
   -> ApiReq
-  -> ([SomeKeyPairCaps] -> IO a)
+  -> ([Ed25519KeyPairCaps] -> IO a)
   -> ([Signer] -> IO a)
   -> IO a
 withKeypairsOrSigner unsignedReq ApiReq{..} keypairAction signerAction =
@@ -548,7 +548,7 @@ mkExec
     -- ^ optional environment data
   -> PublicMeta
     -- ^ public metadata
-  -> [SomeKeyPairCaps]
+  -> [Ed25519KeyPairCaps]
     -- ^ signing keypairs + caplists
   -> Maybe NetworkId
     -- ^ optional 'NetworkId'
@@ -635,7 +635,7 @@ mkCont
     -- ^ environment data
   -> PublicMeta
     -- ^ command public metadata
-  -> [SomeKeyPairCaps]
+  -> [Ed25519KeyPairCaps]
     -- ^ signing keypairs
   -> Maybe Text
     -- ^ optional nonce
@@ -687,12 +687,11 @@ mkUnsignedCont txid step rollback mdata pubMeta kps ridm proof nid = do
          (Continuation (ContMsg txid step rollback (toLegacyJson mdata) proof) :: (PactRPC ContMsg))
   return $ decodeUtf8 <$> cmd
 
-mkKeyPairs :: [ApiKeyPair] -> IO [SomeKeyPairCaps]
+-- Parse `APIKeyPair`s into Ed25519 keypairs.
+mkKeyPairs :: [ApiKeyPair] -> IO [Ed25519KeyPairCaps]
 mkKeyPairs keyPairs = traverse mkPair keyPairs
   where importValidKeyPair ApiKeyPair{..} = fmap (,maybe [] id _akpCaps) $
-          case _akpScheme of
-            Nothing -> importKeyPair defaultScheme _akpPublic _akpSecret
-            Just ppk -> importKeyPair (toScheme ppk) _akpPublic _akpSecret
+          importKeyPair _akpPublic _akpSecret
 
         mkPair akp = case _akpAddress akp of
           Nothing -> either dieAR return (importValidKeyPair akp)
@@ -703,14 +702,12 @@ mkKeyPairs keyPairs = traverse mkPair keyPairs
             -- Enforces that user provided address matches the address derived from the Public Key
             -- for transparency and a better user experience. User provided address not used except
             -- for this purpose.
-
-            case (addrBS, formatPublicKey (fst kp)) of
-              (expectAddr, actualAddr)
-                | expectAddr == actualAddr  -> return kp
-                | otherwise                 -> dieAR $ "Address provided "
-                                               ++ show (toB16Text expectAddr)
-                                               ++ " does not match actual Address "
-                                               ++ show (toB16Text actualAddr)
+            if addrBS == getPublic (fst kp)
+              then return kp
+              else dieAR $ "Address provided "
+                          ++ show (toB16Text addrBS)
+                          ++ " does not match actual Address "
+                          ++ show (toB16Text $ getPublic $ fst kp)
 
 dieAR :: String -> IO a
 dieAR errMsg = throwM . userError $ intercalate "\n" $

src/Pact/Bench.hs

@@ -234,7 +234,7 @@ benchReadValue benchMod (DataTable t) _k
 benchReadValue _ (TxTable _t) _k = rcp Nothing
 
 
-mkBenchCmd :: [SomeKeyPairCaps] -> (String, Text) -> IO (String, Command ByteString)
+mkBenchCmd :: [Ed25519KeyPairCaps] -> (String, Text) -> IO (String, Command ByteString)
 mkBenchCmd kps (str, t) = do
   cmd <- mkCommand' kps
     $ J.encodeStrict
@@ -291,7 +291,7 @@ main = do
   !priv <- eitherDie "priv" $
     parseB16TextOnly "6c938ed95a8abf99f34a1b5edd376f790a2ea8952413526af91b4c3eb0331b3c"
   !keyPair <- eitherDie "keyPair" $
-    importKeyPair defaultScheme (Just $ PubBS pub) (PrivBS priv)
+    importKeyPair (Just $ PubBS pub) (PrivBS priv)
   !parsedExps <- force <$> mapM (mapM (eitherDie "parseExps" . parseExprs)) exps
   !pureDb <- perfEnv dbPerf <$> mkPureEnv neverLog
   initSchema pureDb

src/Pact/Main.hs

@@ -245,6 +245,6 @@ echoBuiltins = do
 
 genKeys :: IO ()
 genKeys = do
-  kp <- genKeyPair defaultScheme
+  kp <- genKeyPair
   putStrLn $ "public: " ++ unpack (toB16Text $ getPublic kp)
   putStrLn $ "secret: " ++ unpack (toB16Text $ getPrivate kp)