batch signatures

pact-request-api/Pact/Core/Command/Client.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Pact.Core.Command.Client (
 
@@ -10,6 +12,7 @@ module Pact.Core.Command.Client (
   -- * Command construction with dynamic keys (Ed25519 and WebAuthn)
   mkCommandWithDynKeys,
   mkCommandWithDynKeys',
+  mkCommandsWithBatchSignatures,
   ApiKeyPair(..),
   ApiSigner(..),
   ApiPublicMeta(..),
@@ -39,9 +42,14 @@ import Control.Applicative((<|>))
 import Control.Monad.Except
 import Control.Exception.Safe
 import Control.Monad
+import qualified Crypto.Hash.Algorithms as Crypto
 import Data.Default(def)
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
 import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import Data.Foldable(traverse_, foldrM)
 import qualified Data.Aeson.Types as A
 import qualified Data.Aeson.Key as AK
@@ -50,44 +58,43 @@ import Data.List (intercalate)
 import Data.Maybe (fromMaybe, mapMaybe, listToMaybe)
 import Data.Bifunctor (first)
 import Data.Either (partitionEithers)
+import qualified Data.MerkleLog as ML
+import qualified Data.Yaml as Y
+import GHC.Generics
 import System.IO
 import System.Exit hiding (die)
 import Data.List.NonEmpty (NonEmpty(..))
 
 import Pact.Time
 import Pact.JSON.Yaml
 import System.FilePath
-import qualified Pact.JSON.Encode as J
+
 import qualified Pact.JSON.Decode as JD
-import qualified Data.Yaml as Y
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
+import qualified Pact.JSON.Encode as J
 import qualified Data.Set as S
 import qualified Data.Map.Strict as M
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Short as SBS
-import GHC.Generics
 
 import Pact.Core.ChainData
 import Pact.Core.Command.RPC
 import Pact.Core.Command.Types
 import Pact.Core.Command.Util
 import Pact.Core.Command.Crypto
+import Pact.Core.Gas
 import Pact.Core.Guards
+import Pact.Core.Hash
 import Pact.Core.PactValue
 import Pact.Core.Names
-import Pact.Core.Verifiers
-import Pact.Core.StableEncoding
-import Pact.Core.Gas
-import Pact.Core.Hash
 import Pact.Core.SPV
 import Pact.Core.Signer
+import Pact.Core.StableEncoding
+import Pact.Core.Verifiers
 import qualified Pact.Core.Hash as PactHash
 import Pact.Core.Command.SigData
 
 
-
 -- -------------------------------------------------------------------------- --
 -- ApiKeyPair
 
@@ -194,7 +201,6 @@ instance J.Encode ApiPublicMeta where
     , "gasPrice" J..?= (StableEncoding <$> _apmGasPrice o)
     , "sender" J..?= _apmSender o
     ]
-  -- Todo: revisit all inlinable pragmas
   {-# INLINABLE build #-}
 
 -- -------------------------------------------------------------------------- --
@@ -780,7 +786,7 @@ mkCommand creds vers meta nonce nid rpc = mkCommand' creds encodedPayload
 
 
 keyPairToSigner :: Ed25519KeyPair -> [UserCapability] -> Signer
-keyPairToSigner cred caps = Signer scheme pub addr caps
+keyPairToSigner cred caps = Signer scheme pub addr (SigCapability <$> caps)
       where
         scheme = Nothing
         pub = toB16Text $ exportEd25519PubKey $ fst cred
@@ -881,7 +887,84 @@ mkCommandWithDynKeys creds vers meta nonce nid rpc = mkCommandWithDynKeys' creds
             , _siCapList = caps
             }
 
-type UserCapability = SigCapability
+-- | Construct a batch of commands all signed with the WebAuthn batch signing
+-- protocol.
+--
+-- This function is used both for testing the batch signature verification scheme,
+-- and as a reference implementation of the client-side batch signing protocol,
+-- which Wallets should replicate. Because it's a reference implementation, we
+-- provide more comments in the implementation than usual.
+mkCommandsWithBatchSignatures
+  :: J.Encode c
+  => J.Encode m
+  => ((WebAuthnPublicKey, WebauthnPrivateKey), [UserCapability])
+  -> [([Verifier ParsedVerifierProof],
+       m,
+       Text,
+       Maybe NetworkId,
+       PactRPC c)]
+  -> IO [Command ByteString]
+mkCommandsWithBatchSignatures ((pubKey, privKey), caps) cmdParts = do
+
+  -- Construct Commands from the command components.
+  -- They will have a "Signer" field derived from the provided
+  -- WebAuthn keypair, but no signatures. (We will sign and attach
+  -- the signatures to the commands later.
+  let commandsAwaitingSignature = map commandAwaitingSignature cmdParts
+
+  -- Construct a merkle tree from the pact hashes of all the commands.
+  let merkleLeafs = map mkCommandMerkleNode commandsAwaitingSignature
+  let batchMerkleTree =
+        ML.merkleTree (map mkCommandMerkleNode commandsAwaitingSignature)
+
+
+  let commandProofsResult =
+        traverse
+        (\(i, node) -> ML.merkleProof node i batchMerkleTree)
+        (zip [0..] merkleLeafs)
+  commandProofs <- case commandProofsResult of
+    Nothing -> error "TODO"
+    Just proofs -> pure proofs
+
+  let batchRoot = PactHash.unsafeBsToPactHash (ML.encodeMerkleRoot (ML.merkleRoot batchMerkleTree))
+  sigResult <- runExceptT $ signWebauthn pubKey privKey "test-authdata" batchRoot
+  webAuthnSig <- case sigResult of
+    Left _e -> error "TODO"
+    Right webAuthnSig -> pure webAuthnSig
+
+  -- For every command in the batch `cmdParts`, run the `handleCommand`.
+  zipWithM (attachSignature webAuthnSig) commandsAwaitingSignature commandProofs
+
+  where
+
+    signer = Signer {
+      _siScheme = Just WebAuthn,
+      _siPubKey = webAuthnPrefix <> toB16Text (exportWebAuthnPublicKey pubKey),
+      _siAddress = Nothing,
+      _siCapList = SigCapability <$> caps
+    }
+
+    mkCommandMerkleNode :: Command ByteString -> ML.MerkleNodeType Crypto.Blake2b_256 ByteString
+    mkCommandMerkleNode (Command {_cmdHash = PactHash.Hash hashBytes}) = ML.InputNode (SBS.fromShort hashBytes)
+
+    -- Determine the PactHash of each transaction.
+    commandAwaitingSignature (verifiers, metadata, nonce, netId, rpc) =
+      let
+        payload = Payload rpc nonce metadata [signer] (nonemptyVerifiers verifiers) netId
+        encodedPayload = J.encodeStrict payload
+      in
+        Command encodedPayload [] (PactHash.hash encodedPayload)
+
+    attachSignature :: WebAuthnSignature -> Command ByteString -> ML.MerkleProof Crypto.Blake2b_256 -> IO (Command ByteString)
+    attachSignature webAuthnSig cmd (ML.MerkleProof _subj obj) = do
+
+      let userSig =
+            WebAuthnBatchToken (BatchToken {
+               _btWebAuthnSignature = webAuthnSig,
+               _btMerkleProofObject = obj
+            })
+      pure (cmd { _cmdSigs = [userSig] })
+
 
 -- | A utility function for handling the common case of commands
 -- with no verifiers. `None` is distinguished from `Just []` in

pact-request-api/Pact/Core/Command/Crypto.hs

@@ -74,6 +74,8 @@ module Pact.Core.Command.Crypto
   , exportWebAuthnPrivateKey
   , WebauthnPrivateKey(..)
   , signWebauthn
+
+  , BatchToken(..)
   ) where
 
 
@@ -87,6 +89,7 @@ import Control.Monad (unless)
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import qualified Crypto.Hash as H
+import qualified Crypto.Hash.Algorithms as Crypto
 import qualified Data.ASN1.BinaryEncoding as ASN1
 import qualified Data.ASN1.Encoding as ASN1
 import qualified Data.ASN1.Types as ASN1
@@ -95,6 +98,7 @@ import Data.ByteString.Short (fromShort)
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Base64.URL as Base64URL
+import qualified Data.MerkleLog as ML
 import Data.Proxy
 import Data.String (IsString(..))
 import qualified Data.Text as T
@@ -104,10 +108,10 @@ import qualified Data.Aeson as A
 import Control.DeepSeq (NFData)
 import Data.Hashable
 
-import qualified Pact.Core.Crypto.WebAuthn.Cose.PublicKey as WA
-import qualified Pact.Core.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as WA
-import qualified Pact.Core.Crypto.WebAuthn.Cose.SignAlg as WA
-import qualified Pact.Core.Crypto.WebAuthn.Cose.Verify as WAVerify
+import qualified Pact.Crypto.WebAuthn.Cose.PublicKey as WA
+import qualified Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as WA
+import qualified Pact.Crypto.WebAuthn.Cose.SignAlg as WA
+import qualified Pact.Crypto.WebAuthn.Cose.Verify as WAVerify
 
 import Pact.Core.Command.Util
 import qualified Pact.Core.Hash as PactHash
@@ -122,11 +126,13 @@ import qualified Crypto.PubKey.ECC.P256 as ECC hiding (scalarToInteger)
 import Crypto.Random.Types
 
 import qualified Pact.JSON.Encode as J
+import qualified Pact.JSON.Decode as JD
 
 -- | The type of parsed signatures
 data UserSig = ED25519Sig T.Text
              | WebAuthnSig WebAuthnSignature
-  deriving (Eq, Ord, Show, Generic)
+             | WebAuthnBatchToken BatchToken
+  deriving (Eq, Show, Generic)
 
 instance NFData UserSig
 
@@ -135,13 +141,18 @@ instance J.Encode UserSig where
     J.object [ "sig" J..= s ]
   build (WebAuthnSig sig) = J.object
     [ "sig" J..= T.decodeUtf8 (BSL.toStrict $ J.encode sig) ]
+  build (WebAuthnBatchToken sig) = J.object ["sig" J..= sig ]
   {-# INLINE build #-}
 
 instance A.FromJSON UserSig where
   parseJSON x =
+    parseWebAuthnBatchSig x <|>
     parseWebAuthnStringified x <|>
     parseEd25519 x
     where
+      parseWebAuthnBatchSig = A.withObject "UserSig" $ \o -> do
+        batchSig <- o A..: "sig"
+        pure (WebAuthnBatchToken batchSig)
       parseWebAuthnStringified = A.withObject "UserSig" $ \o -> do
         t <- o A..: "sig"
         case A.decode (BSL.fromStrict $ T.encodeUtf8 t) of
@@ -464,6 +475,7 @@ instance J.Encode WebAuthnSignature where
     , "signature" J..= signature
     ]
 
+
 -- | This type represents a challenge that was used during
 -- a WebAuthn "assertion" flow. For signing Pact payloads, this
 -- is the PactHash of a transaction.
@@ -479,3 +491,54 @@ instance A.FromJSON ClientDataJSON where
 instance J.Encode ClientDataJSON where
   build ClientDataJSON { challenge } =
     J.object ["challenge" J..= challenge]
+
+-- | This type specifies the format of a WebAuthn signature when the signature
+-- is shared across mulitple transactions.
+--
+-- When a client signs a batch of transactions, they must produce a Merkle Tree
+-- of those transactions, and sign the Merkle Root.
+--
+-- This packet is valid for a single transaction in the batch. The `clientDataJSON`,
+-- `authenticatorData` and `signature` fields will be identical for all transactions
+-- in the batch. The `merkleProof` will be unique for each transaction.
+--
+-- The wire format for these signature packets is given in `encodeWebAuthnBatchSignaturePacket`.
+-- It is the base64url representation of a binary encoding of each of the fields.
+--
+-- We specialize batch transaction signing to the WebAuthn case, because this is the
+-- main case in which is is difficult to produce large numbers of signatures
+-- programatically. In WebAuthn, the client does not have direct access to their
+-- private key; each use of the key to sign a payload requires a separate user
+-- interaction.
+--
+-- Examples of how to produce and serialize such a proof packet are given in the test
+-- suite TODO.
+data BatchToken = BatchToken
+  { _btWebAuthnSignature :: WebAuthnSignature
+  , _btMerkleProofObject :: ML.MerkleProofObject Crypto.Blake2b_256
+    -- ^ A Merkle Proof that the transaction is part of the signed batch.
+  } deriving (Show, Generic, Eq)
+
+instance NFData BatchToken where
+
+instance J.Encode BatchToken where
+  build p =  J.object
+        [ "webAuthnSignature" J..= _btWebAuthnSignature p
+        , "merkleProof" J..= toB64UrlUnpaddedText (ML.encodeMerkleProofObject (_btMerkleProofObject p))
+        ]
+  {-# INLINE build #-}
+
+instance JD.FromJSON BatchToken where
+  parseJSON = JD.withObject "WebAuthnBatchSignaturePacket" $ \o -> do
+    webAuthnSignature <- o JD..: "webAuthnSignature"
+    merkleProofObject <- do
+        proofBytesBase64 <- o JD..: "merkleProof"
+        proofBytes <- parseB64UrlUnpaddedText proofBytesBase64
+        case ML.decodeMerkleProofObject proofBytes of
+            Just proof -> return proof
+            Nothing -> fail "Could not decode Merkle Proof"
+    return $ BatchToken
+      { _btWebAuthnSignature = webAuthnSignature
+      , _btMerkleProofObject = merkleProofObject
+      }
+  {-# INLINE parseJSON #-}

pact-request-api/Pact/Core/Command/RPC.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
 -- Module      :  Pact.Types.RPC
@@ -42,9 +43,10 @@ import Pact.Core.SPV
 import Pact.Core.Names
 
 import Pact.JSON.Decode
+
+import Pact.Core.PactValue
 import Pact.Core.StableEncoding
 import qualified Pact.JSON.Encode as J
-import Pact.Core.PactValue
 
 
 data PactRPC c =
@@ -99,9 +101,9 @@ instance FromJSON ContMsg where
           StableEncoding defPactId <- o .: "pactId"
           step <- o .: "step"
           rollback <- o .: "rollback"
-          StableEncoding msgData <- o .: "data"
+          msgData <- o .: "data"
           maybeProof <- o .:? "proof"
-          pure $ ContMsg defPactId step rollback msgData maybeProof
+          pure $ ContMsg defPactId step rollback (_stableEncoding msgData) maybeProof
           -- ContMsg <$> o .: "pactId" <*> o .: "step" <*> o .: "rollback" <*> o .: "data"
           -- <*> o .: "proof"
   {-# INLINE parseJSON #-}