From f5a88f65600768df5cd5542224df093282c0f2d9 Mon Sep 17 00:00:00 2001 From: Greg Hale Date: Thu, 12 Sep 2024 11:17:21 -0700 Subject: [PATCH] batch signatures --- pact-request-api/Pact/Core/Command/Client.hs | 109 ++++++- pact-request-api/Pact/Core/Command/Crypto.hs | 73 ++++- pact-request-api/Pact/Core/Command/RPC.hs | 8 +- pact-request-api/Pact/Core/Command/Server.hs | 143 +++++++++ pact-request-api/Pact/Core/Command/Types.hs | 46 ++- .../Core/Crypto/WebAuthn/Cose/PublicKey.hs | 197 ------------ .../WebAuthn/Cose/PublicKeyWithSignAlg.hs | 266 ---------------- .../Core/Crypto/WebAuthn/Cose/Registry.hs | 300 ------------------ .../Pact/Core/Crypto/WebAuthn/Cose/SignAlg.hs | 243 -------------- pact-tests/Pact/Core/Test/CommandTests.hs | 23 +- .../Pact/Core/Test/SignatureSchemeTests.hs | 6 +- pact-tng.cabal | 15 +- pact/Pact/Core/Evaluate.hs | 2 + pact/Pact/Core/Guards.hs | 3 +- pact/Pact/Core/Hash.hs | 1 + pact/Pact/Core/Scheme.hs | 3 +- .../Pact}/Crypto/WebAuthn/Cose/Verify.hs | 9 +- 17 files changed, 396 insertions(+), 1051 deletions(-) create mode 100644 pact-request-api/Pact/Core/Command/Server.hs delete mode 100644 pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKey.hs delete mode 100644 pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs delete mode 100644 pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Registry.hs delete mode 100644 pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/SignAlg.hs rename {pact-request-api/Pact/Core => pact/Pact}/Crypto/WebAuthn/Cose/Verify.hs (96%) diff --git a/pact-request-api/Pact/Core/Command/Client.hs b/pact-request-api/Pact/Core/Command/Client.hs index ac12d00a0..1c0bfb576 100644 --- a/pact-request-api/Pact/Core/Command/Client.hs +++ b/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,6 +58,9 @@ 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(..)) @@ -57,37 +68,33 @@ 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 diff --git a/pact-request-api/Pact/Core/Command/Crypto.hs b/pact-request-api/Pact/Core/Command/Crypto.hs index b76a43601..c242faebe 100644 --- a/pact-request-api/Pact/Core/Command/Crypto.hs +++ b/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 #-} diff --git a/pact-request-api/Pact/Core/Command/RPC.hs b/pact-request-api/Pact/Core/Command/RPC.hs index ee31c0012..90e168295 100644 --- a/pact-request-api/Pact/Core/Command/RPC.hs +++ b/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 #-} diff --git a/pact-request-api/Pact/Core/Command/Server.hs b/pact-request-api/Pact/Core/Command/Server.hs new file mode 100644 index 000000000..3ca558ec7 --- /dev/null +++ b/pact-request-api/Pact/Core/Command/Server.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +import Control.Monad.IO.Class +import Control.Monad.Except +import Control.Concurrent.MVar +-- import Data.ByteString +import qualified Data.LruCache as LRU +import Data.IORef +import Data.LruCache.IO as LRU +import Data.Text +import qualified Data.Text.Encoding as E +import Data.Traversable +import Data.Word +import GHC.Generics +import Servant.API +import Servant.Server +-- import System.FilePath + +import Pact.Core.Builtin +import Pact.Core.Compile +import Pact.Core.Command.RPC +import Pact.Core.Command.Types +import Pact.Core.ChainData +import Pact.Core.Errors +import Pact.Core.Environment.Types +import Pact.Core.Evaluate +-- import Pact.Core.Gas.Types +-- import Pact.Core.Info +import Pact.Core.Persistence.Types +import Pact.Core.StableEncoding +import Pact.Core.Syntax.ParseTree +import Pact.Core.Command.Client + +main :: IO () +main = undefined (server undefined) + +-- | Commandline configuration for running a Pact server. +data Config = Config { + _port :: Word16, + _persistDir :: Maybe FilePath, + _logDir :: FilePath, + _pragmas :: [Pragma], + _verbose :: Bool, + -- _entity :: Maybe EntityName, + _gasLimit :: Maybe Int, + _gasRate :: Maybe Int + -- _execConfig :: Maybe ExecutionConfig + } deriving (Eq,Show,Generic) + +-- | Pragma for configuring a SQLite database. +newtype Pragma = Pragma Text + deriving (Eq, Show, Generic) + +-- | Temporarily pretend our Log type in CommandResult is unit. +type Log = () + +-- | Runtime environment for a Pact server. +data CommandEnv = CommandEnv { + -- _ceEntity :: Maybe EntityName + _ceMode :: ExecutionMode + , _ceDbEnv :: PactDb CoreBuiltin () + -- , _ceLogger :: Logger + -- , _ceGasEnv :: GasEnv + , _cePublicData :: PublicData + -- , _ceSPVSupport :: SPVSupport + , _ceNetworkId :: Maybe NetworkId + -- , _ceExecutionConfig :: ExecutionConfig + , _ceEvalEnv :: EvalEnv CoreBuiltin () + , _ceEvalState :: MVar (EvalState CoreBuiltin ()) + , _ceRequestCache :: LruHandle RequestKey (CommandResult Log PactErrorI) + } + +type API = + "v1" :> "send" :> ReqBody '[JSON] SubmitBatch :> Post '[JSON] RequestKeys + :<|> "v1" :> "listen" :> Capture "requestKey" RequestKey :> Get '[JSON] (CommandResult Log PactErrorI) + +server :: CommandEnv -> Server API +server env = + sendHandler env + :<|> listenHandler env + +sendHandler :: CommandEnv -> SubmitBatch -> Handler RequestKeys +sendHandler env submitBatch = do + requestKeys <- forM (_sbCmds submitBatch) (\cmd -> liftIO $ do + -- let evalEnv = _ceEvalEnv env + let requestKey = cmdToRequestKey cmd + _ <- cached (_ceRequestCache env) requestKey (computeResultAndUpdateState requestKey cmd) + pure requestKey) + -- TODO, stick result into the cache. + -- TODO, stick result into the cache. + pure $ RequestKeys requestKeys + + where + computeResultAndUpdateState :: RequestKey -> Command Text -> IO (CommandResult Log PactErrorI) + computeResultAndUpdateState requestKey cmd = do + modifyMVar (_ceEvalState env) $ \evalState -> do + case verifyCommand @(StableEncoding PublicMeta) (fmap E.encodeUtf8 cmd) of + ProcFail _ -> error "TODO" + ProcSucc Command{ _cmdPayload = Payload { _pPayload = Exec execMsg }} -> do + let parsedCode = Right $ _pcExps (_pmCode execMsg) + (evalState', result) <- interpretReturningState (_ceEvalEnv env) evalState parsedCode + case result of + Right goodRes -> pure (evalState', evalResultToCommandResult requestKey goodRes) + Left _ -> error "TODO" + ProcSucc Command { _cmdPayload = Payload { _pPayload = Continuation contMsg }} -> do + let evalInput = contMsgToEvalInput contMsg + (evalState', result) <- interpretReturningState (_ceEvalEnv env) evalState evalInput + case result of + Right goodRes -> pure (evalState', evalResultToCommandResult requestKey goodRes) + Left _ -> error "TODO" + + evalResultToCommandResult :: RequestKey -> EvalResult [TopLevel ()] -> CommandResult Log PactErrorI + evalResultToCommandResult requestKey EvalResult {_erOutput, _erLogs, _erExec, _erGas, _erTxId, _erEvents} = + CommandResult { + _crReqKey = requestKey, + _crTxId = _erTxId, + _crResult = evalOutputToCommandResult _erOutput, + _crGas = _erGas, + _crLogs = Nothing, -- TODO + _crEvents = _erEvents, + _crContinuation = Nothing, + _crMetaData = Nothing -- TODO + } + + evalOutputToCommandResult :: [CompileValue ()] -> PactResult PactErrorI + evalOutputToCommandResult = \case + [InterpretValue v _info] -> PactResultOk v + other -> error ("Wanted single InterpretValue. Got\n" ++ show other) + + contMsgToEvalInput :: ContMsg -> EvalInput + contMsgToEvalInput = undefined + +listenHandler :: CommandEnv -> RequestKey -> Handler (CommandResult Log PactErrorI) +listenHandler env key = do + let (LRU.LruHandle cacheRef) = _ceRequestCache env + cache <- liftIO $ readIORef cacheRef + case LRU.lookup key cache of + Just (result, _) -> pure result + Nothing -> throwError err404 \ No newline at end of file diff --git a/pact-request-api/Pact/Core/Command/Types.hs b/pact-request-api/Pact/Core/Command/Types.hs index f7c640d8f..09e37c25e 100644 --- a/pact-request-api/Pact/Core/Command/Types.hs +++ b/pact-request-api/Pact/Core/Command/Types.hs @@ -41,12 +41,14 @@ module Pact.Core.Command.Types , ParsedCode(..),pcCode,pcExps , Signer(..),siScheme, siPubKey, siAddress, siCapList , UserSig(..) + , UserCapability , PactResult(..) , _PactResultOk , _PactResultErr , CommandResult(..),crReqKey,crTxId,crResult,crGas,crLogs,crEvents , crContinuation,crMetaData , RequestKey(..) + , RequestKeys(..) , cmdToRequestKey , requestKeyToB16Text , parsePact @@ -67,6 +69,8 @@ import qualified Data.ByteString.Short as ShortByteString import qualified Data.ByteString.Base16 as B16 import Data.Foldable import Data.Hashable (Hashable) +import Data.List.NonEmpty (NonEmpty((:|))) +import qualified Data.MerkleLog as ML import Data.Serialize as SZ import Data.Text (Text) import qualified Data.Text.Encoding as T @@ -82,6 +86,7 @@ import Pact.Core.Compile import Pact.Core.DefPacts.Types import Pact.Core.Guards import Pact.Core.Gas.Types +import Pact.Core.Names import qualified Pact.Core.Hash as PactHash import Pact.Core.Persistence.Types import Pact.Core.PactValue (PactValue(..)) @@ -95,7 +100,7 @@ import qualified Pact.JSON.Decode as JD import qualified Pact.JSON.Encode as J -import Pact.Core.Command.Crypto as Base +import Pact.Core.Command.Crypto import Pact.Core.Evaluate (Info) -- | Command is the signed, hashed envelope of a Pact execution instruction or command. @@ -108,7 +113,7 @@ data Command a = Command { _cmdPayload :: !a , _cmdSigs :: ![UserSig] , _cmdHash :: !PactHash.Hash - } deriving (Eq,Show,Ord,Generic,Functor,Foldable,Traversable) + } deriving (Eq,Show,Generic,Functor,Foldable,Traversable) instance (FromJSON a) => FromJSON (Command a) where parseJSON = withObject "Command" $ \o -> @@ -135,7 +140,9 @@ data ProcessedCommand m a = instance (NFData a,NFData m) => NFData (ProcessedCommand m a) -type Ed25519KeyPairCaps = (Ed25519KeyPair ,[SigCapability]) +type Ed25519KeyPairCaps = (Ed25519KeyPair ,[UserCapability]) + +type UserCapability = CapToken QualifiedName PactValue -- | Pair parsed Pact expressions with the original text. @@ -188,7 +195,7 @@ verifyUserSigs hsh sigsAndSigners formatIssues = Just $ "Invalid sig(s) found: " ++ show (J.encode . J.Object $ failedSigs) verifyUserSig :: PactHash.Hash -> UserSig -> Signer -> Either String () -verifyUserSig msg sig Signer{..} = do +verifyUserSig msg@(PactHash.Hash msgBytes) sig Signer{..} = do case (sig, scheme) of (ED25519Sig edSig, ED25519) -> do for_ _siAddress $ \addr -> do @@ -208,6 +215,21 @@ verifyUserSig msg sig Signer{..} = do pk <- over _Left ("failed to parse webauthn pubkey: " <>) $ parseWebAuthnPublicKey =<< B16.decode (Text.encodeUtf8 strippedPrefix) verifyWebAuthnSig msg pk waSig + + (WebAuthnBatchToken batchSig, WebAuthn) -> do + pk <- maybe (Left "Could not parse public key") Right (parseWebAuthnPublicKeyText (PublicKeyText _siPubKey)) + let BatchToken { + _btWebAuthnSignature, + _btMerkleProofObject + } = batchSig + + let + proofObject = _btMerkleProofObject + proofSubject = ML.MerkleProofSubject (ML.InputNode (ShortByteString.fromShort msgBytes)) + merkleProof = ML.MerkleProof proofSubject proofObject + inferredMerkleRoot = ML.runMerkleProof merkleProof + inferredRootHash = PactHash.unsafeBsToPactHash (ML.encodeMerkleRoot inferredMerkleRoot) + verifyWebAuthnSig inferredRootHash pk _btWebAuthnSignature _ -> Left $ unwords @@ -217,6 +239,7 @@ verifyUserSig msg sig Signer{..} = do , case sig of ED25519Sig _ -> "ED25519" WebAuthnSig _ -> "WebAuthn" + WebAuthnBatchToken _ -> "WebAuthnBatch" ] where scheme = fromMaybe defPPKScheme _siScheme @@ -353,6 +376,21 @@ newtype RequestKey = RequestKey { unRequestKey :: PactHash.Hash} instance Show RequestKey where show (RequestKey rk) = show rk +newtype RequestKeys = RequestKeys { _rkRequestKeys :: NonEmpty RequestKey } + deriving (Show, Eq, Ord, Generic, NFData) + +instance J.Encode RequestKeys where + build (RequestKeys rks) = J.object [ + "requestKeys" J..= J.Array rks + ] + +instance JD.FromJSON RequestKeys where + parseJSON = JD.withObject "RequestKeys" $ \o -> do + rks <- o JD..: "requestKeys" + case rks of + [] -> fail "Empty requestKeys" + (rk:rks') -> pure $ RequestKeys (rk :| rks') + makeLenses ''UserSig makeLenses ''Signer makeLenses ''ExecutionMode diff --git a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKey.hs b/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKey.hs deleted file mode 100644 index ae1b34ec4..000000000 --- a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKey.hs +++ /dev/null @@ -1,197 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Stability: experimental --- This module contains a partial implementation of the --- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format, --- limited to what is needed for Webauthn, and in a structured way. -module Pact.Core.Crypto.WebAuthn.Cose.PublicKey - ( -- * Public key - UncheckedPublicKey (..), - checkPublicKey, - PublicKey (PublicKey), - - -- * COSE Elliptic Curves - CoseCurveEdDSA (..), - coordinateSizeEdDSA, - CoseCurveECDSA (..), - toCryptCurveECDSA, - coordinateSizeECDSA, - ) -where - -import qualified Crypto.PubKey.ECC.Prim as ECC -import qualified Crypto.PubKey.ECC.Types as ECC -import qualified Crypto.PubKey.Ed25519 as Ed25519 -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as Base16 -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import GHC.Generics (Generic) - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey) --- A structured representation of a [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) --- limited to what is know to be necessary for Webauthn public keys for the --- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey) field, --- and without any signing algorithm parameters like hashes. Due to the raw --- nature of parameters, this type is labeled as unchecked. Parameters are --- checked by using the 'checkPublicKey' function, returning a t'PublicKey' --- type. -data UncheckedPublicKey - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) - -- EdDSA Signature Algorithm - -- - -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the - -- elliptic curve signature scheme Edwards-curve - -- Digital Signature Algorithm (EdDSA). In that document, the signature - -- algorithm is instantiated using parameters for edwards25519 and - -- edwards448 curves. The document additionally describes two variants - -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied - -- to the content before signing, and HashEdDSA, where a hash function - -- is applied to the content before signing and the result of that hash - -- function is signed. For EdDSA, the content to be signed (either the - -- message or the pre-hash value) is processed twice inside of the - -- signature algorithm. For use with COSE, only the pure EdDSA version - -- is used. - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1) - PublicKeyEdDSA - { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- The elliptic curve to use - eddsaCurve :: CoseCurveEdDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- This contains the public key bytes. - eddsaX :: BS.ByteString - } - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) - -- ECDSA Signature Algorithm - -- - -- This document defines ECDSA to work only with the curves P-256, - -- P-384, and P-521. Future documents may define it to work with other - -- curves and points in the future. - -- - -- In order to promote interoperability, it is suggested that SHA-256 be - -- used only with curve P-256, SHA-384 be used only with curve P-384, - -- and SHA-512 be used with curve P-521. This is aligned with the recommendation in - -- [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4). - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1) - PublicKeyECDSA - { -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- The elliptic curve to use - ecdsaCurve :: CoseCurveECDSA, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- This contains the x-coordinate for the EC point. The integer is - -- converted to a byte string as defined in [SEC1]. Leading zero - -- octets MUST be preserved. - ecdsaX :: Integer, - -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- This contains the value of the - -- y-coordinate for the EC point. When encoding the value y, the - -- integer is converted to an byte string (as defined in - -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1)) - -- and encoded as a CBOR bstr. Leading zero octets MUST be - -- preserved. - ecdsaY :: Integer - } - | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) - -- [RSASSA-PKCS1-v1_5](https://www.rfc-editor.org/rfc/rfc8017#section-8.2) Signature Algorithm - -- - -- A key of size 2048 bits or larger MUST be used with these algorithms. - -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5) - PublicKeyRSA - { -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- The RSA modulus n is a product of u distinct odd primes - -- r_i, i = 1, 2, ..., u, where u >= 2 - rsaN :: Integer, - -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- The RSA public exponent e is an integer between 3 and n - 1 satisfying - -- GCD(e,\\lambda(n)) = 1, where \\lambda(n) = LCM(r_1 - 1, ..., r_u - 1) - rsaE :: Integer - } - deriving (Eq, Show, Generic) - --- | Same as 'UncheckedPublicKey', but checked to be valid using --- 'checkPublicKey'. -newtype PublicKey = CheckedPublicKey UncheckedPublicKey - deriving newtype (Eq, Show) - --- | Returns the 'UncheckedPublicKey' for a t'PublicKey' -pattern PublicKey :: UncheckedPublicKey -> PublicKey -pattern PublicKey k <- CheckedPublicKey k - -{-# COMPLETE PublicKey #-} - --- | Checks whether an 'UncheckedPublicKey' is valid. This is the only way to construct a t'PublicKey' -checkPublicKey :: UncheckedPublicKey -> Either Text PublicKey -checkPublicKey key@PublicKeyEdDSA {..} - | actualSize == expectedSize = Right $ CheckedPublicKey key - | otherwise = - Left $ - "EdDSA public key for curve " - <> Text.pack (show eddsaCurve) - <> " didn't have the expected size of " - <> Text.pack (show expectedSize) - <> " bytes, it has " - <> Text.pack (show actualSize) - <> " bytes instead: " - <> Text.decodeUtf8 (Base16.encode eddsaX) - where - actualSize = BS.length eddsaX - expectedSize = coordinateSizeEdDSA eddsaCurve -checkPublicKey key@PublicKeyECDSA {..} - | ECC.isPointValid curve point = Right $ CheckedPublicKey key - | otherwise = - Left $ - "ECDSA public key point is not valid for curve " - <> Text.pack (show ecdsaCurve) - <> ": " - <> Text.pack (show point) - where - curve = ECC.getCurveByName (toCryptCurveECDSA ecdsaCurve) - point = ECC.Point ecdsaX ecdsaY -checkPublicKey key = Right $ CheckedPublicKey key - --- | COSE elliptic curves that can be used with EdDSA -data CoseCurveEdDSA - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- Ed25519 for use w/ EdDSA only - CoseCurveEd25519 - deriving (Eq, Show, Enum, Bounded, Generic) - --- | Returns the size of a coordinate point for a specific EdDSA curve in bytes. -coordinateSizeEdDSA :: CoseCurveEdDSA -> Int -coordinateSizeEdDSA CoseCurveEd25519 = Ed25519.publicKeySize - --- | COSE elliptic curves that can be used with ECDSA -data CoseCurveECDSA - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-256 also known as secp256r1 - CoseCurveP256 - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-384 also known as secp384r1 - CoseCurveP384 - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-521 also known as secp521r1 - CoseCurveP521 - deriving (Eq, Show, Enum, Bounded, Generic) - --- | Converts a 'Cose.CoseCurveECDSA' to an 'ECC.CurveName'. The inverse --- function is 'fromCryptCurveECDSA' -toCryptCurveECDSA :: CoseCurveECDSA -> ECC.CurveName -toCryptCurveECDSA CoseCurveP256 = ECC.SEC_p256r1 -toCryptCurveECDSA CoseCurveP384 = ECC.SEC_p384r1 -toCryptCurveECDSA CoseCurveP521 = ECC.SEC_p521r1 - --- | Returns the size of a coordinate point for a specific ECDSA curve in bytes. -coordinateSizeECDSA :: CoseCurveECDSA -> Int -coordinateSizeECDSA curve = byteSize - where - bitSize = ECC.curveSizeBits (ECC.getCurveByName (toCryptCurveECDSA curve)) - byteSize = (bitSize + 7) `div` 8 diff --git a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs b/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs deleted file mode 100644 index 07426624f..000000000 --- a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/PublicKeyWithSignAlg.hs +++ /dev/null @@ -1,266 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Stability: experimental --- This module contains a partial implementation of the --- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format, --- limited to what is needed for Webauthn, and in a structured way. -module Pact.Core.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg - ( -- * COSE public Key - PublicKeyWithSignAlg (PublicKeyWithSignAlgInternal, PublicKeyWithSignAlg, publicKey, signAlg), - CosePublicKey - ) -where - -import Codec.CBOR.Decoding (Decoder, TokenType (TypeBool, TypeBytes), decodeBytesCanonical, decodeMapLenCanonical, peekTokenType) -import Codec.CBOR.Encoding (Encoding, encodeBytes, encodeMapLen) -import Codec.Serialise (Serialise (decode, encode)) -import Control.Monad (unless) -import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip) -import qualified Data.ByteString as BS -import qualified Data.Text as Text -import GHC.Generics (Generic) - -import qualified Pact.Core.Crypto.WebAuthn.Cose.Registry as R -import qualified Pact.Core.Crypto.WebAuthn.Cose.PublicKey as P -import qualified Pact.Core.Crypto.WebAuthn.Cose.SignAlg as A - --- | A combination of a t'P.PublicKey' holding the public key data and a --- 'A.CoseSignAlg' holding the exact signature algorithm that should be used. --- This type can only be constructed with 'makePublicKeyWithSignAlg', which --- ensures that the signature scheme matches between 'P.PublicKey' and --- 'A.CoseSignAlg'. This type is equivalent to a COSE public key, which holds --- the same information, see 'CosePublicKey' -data PublicKeyWithSignAlg = PublicKeyWithSignAlgInternal - { publicKeyInternal :: P.PublicKey, - signAlgInternal :: A.CoseSignAlg - -- TODO: Consider adding a RawField here to replace - -- acdCredentialPublicKeyBytes. This would then require parametrizing - -- 'PublicKeyWithSignAlg' with 'raw :: Bool' - } - deriving (Eq, Show, Generic) - --- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey) --- A structured and checked representation of a --- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7), limited --- to what is know to be necessary for Webauthn public keys for the --- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey) --- field. -type CosePublicKey = PublicKeyWithSignAlg - --- | Deconstructs a 'makePublicKeyWithSignAlg' into its t'P.PublicKey' and --- 'A.CoseSignAlg'. Since 'makePublicKeyWithSignAlg' can only be constructed --- using 'makePublicKeyWithSignAlg', we can be sure that the signature scheme --- of t'P.PublicKey' and 'A.CoseSignAlg' matches. -pattern PublicKeyWithSignAlg :: P.PublicKey -> A.CoseSignAlg -> PublicKeyWithSignAlg -pattern PublicKeyWithSignAlg {publicKey, signAlg} <- PublicKeyWithSignAlgInternal {publicKeyInternal = publicKey, signAlgInternal = signAlg} - -{-# COMPLETE PublicKeyWithSignAlg #-} - --- | CBOR encoding as a [COSE_Key](https://tools.ietf.org/html/rfc8152#section-7) --- using the [CTAP2 canonical CBOR encoding form](https://fidoalliance.org/specs/fido-v2.0-ps-20190130/fido-client-to-authenticator-protocol-v2.0-ps-20190130.html#ctap2-canonical-cbor-encoding-form) -instance Serialise CosePublicKey where - encode PublicKeyWithSignAlg {..} = case publicKey of - P.PublicKey P.PublicKeyEdDSA {..} -> - common R.CoseKeyTypeOKP - <> encode R.CoseKeyTypeParameterOKPCrv - <> encode (fromCurveEdDSA eddsaCurve) - <> encode R.CoseKeyTypeParameterOKPX - <> encodeBytes eddsaX - P.PublicKey P.PublicKeyECDSA {..} -> - common R.CoseKeyTypeEC2 - <> encode R.CoseKeyTypeParameterEC2Crv - <> encode (fromCurveECDSA ecdsaCurve) - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1 - -- > Leading zero octets MUST be preserved. - <> encode R.CoseKeyTypeParameterEC2X - -- This version of i2ospOf_ throws if the bytestring is larger than - -- size, but this can't happen due to the PublicKey invariants - <> encodeBytes (i2ospOf_ size ecdsaX) - <> encode R.CoseKeyTypeParameterEC2Y - <> encodeBytes (i2ospOf_ size ecdsaY) - where - size = P.coordinateSizeECDSA ecdsaCurve - P.PublicKey P.PublicKeyRSA {..} -> - common R.CoseKeyTypeRSA - -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4 - -- > The octet sequence MUST utilize the minimum - -- number of octets needed to represent the value. - <> encode R.CoseKeyTypeParameterRSAN - <> encodeBytes (i2osp rsaN) - <> encode R.CoseKeyTypeParameterRSAE - <> encodeBytes (i2osp rsaE) - where - common :: R.CoseKeyType -> Encoding - common kty = - encodeMapLen (R.parameterCount kty) - <> encode R.CoseKeyCommonParameterKty - <> encode kty - <> encode R.CoseKeyCommonParameterAlg - <> encode signAlg - - -- NOTE: CBOR itself doesn't give an ordering of map keys, but the CTAP2 canonical CBOR encoding form does: - -- > The keys in every map must be sorted lowest value to highest. The sorting rules are: - -- > - -- > * If the major types are different, the one with the lower value in numerical order sorts earlier. - -- > * If two keys have different lengths, the shorter one sorts earlier; - -- > * If two keys have the same length, the one with the lower value in (byte-wise) lexical order sorts earlier. - -- - -- This has the effect that numeric keys are sorted like 1, 2, 3, ..., -1, -2, -3, ... - -- Which aligns very nicely with the fact that common parameters use positive - -- values and can therefore be decoded first, while key type specific - -- parameters use negative values - decode = do - n <- fromIntegral <$> decodeMapLenCanonical - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1 - -- This parameter MUST be present in a key object. - decodeExpected R.CoseKeyCommonParameterKty - kty <- decode - -- https://www.w3.org/TR/webauthn-2/#credentialpublickey - -- The COSE_Key-encoded credential public key MUST contain the "alg" - -- parameter and MUST NOT contain any other OPTIONAL parameters. - decodeExpected R.CoseKeyCommonParameterAlg - alg <- decode - - uncheckedKey <- decodeKey n kty alg - case P.checkPublicKey uncheckedKey of - Left err -> fail $ "Key check failed: " <> Text.unpack err - Right result -> - pure $ - PublicKeyWithSignAlgInternal - { publicKeyInternal = result, - signAlgInternal = alg - } - where - decodeKey :: Word -> R.CoseKeyType -> A.CoseSignAlg -> Decoder s P.UncheckedPublicKey - decodeKey n kty alg = case alg of - A.CoseSignAlgEdDSA -> decodeEdDSAKey - A.CoseSignAlgECDSA _ -> decodeECDSAKey - A.CoseSignAlgRSA _ -> decodeRSAKey - where - -- [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) - -- Implementations MUST verify that the key type is appropriate for - -- the algorithm being processed. - checkKty :: R.CoseKeyType -> Decoder s () - checkKty expectedKty = do - unless (expectedKty == kty) $ - fail $ - "Expected COSE key type " - <> show expectedKty - <> " for COSE algorithm " - <> show alg - <> " but got COSE key type " - <> show kty - <> " instead" - unless (R.parameterCount kty == n) $ - fail $ - "Expected CBOR map to contain " - <> show (R.parameterCount kty) - <> " parameters for COSE key type " - <> show kty - <> " but got " - <> show n - <> " parameters instead" - - decodeEdDSAKey :: Decoder s P.UncheckedPublicKey - decodeEdDSAKey = do - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2 - -- > The 'kty' field MUST be present, and it MUST be 'OKP' (Octet Key Pair). - checkKty R.CoseKeyTypeOKP - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2 - decodeExpected R.CoseKeyTypeParameterOKPCrv - eddsaCurve <- toCurveEdDSA <$> decode - decodeExpected R.CoseKeyTypeParameterOKPX - eddsaX <- decodeBytesCanonical - pure P.PublicKeyEdDSA {..} - - decodeECDSAKey :: Decoder s P.UncheckedPublicKey - decodeECDSAKey = do - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1 - -- > The 'kty' field MUST be present, and it MUST be 'EC2'. - checkKty R.CoseKeyTypeEC2 - -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1 - decodeExpected R.CoseKeyTypeParameterEC2Crv - ecdsaCurve <- toCurveECDSA <$> decode - let size = P.coordinateSizeECDSA ecdsaCurve - decodeExpected R.CoseKeyTypeParameterEC2X - ecdsaX <- os2ipWithSize size =<< decodeBytesCanonical - - decodeExpected R.CoseKeyTypeParameterEC2Y - ecdsaY <- - peekTokenType >>= \case - TypeBytes -> os2ipWithSize size =<< decodeBytesCanonical - TypeBool -> fail "Compressed EC2 y coordinate not yet supported" - typ -> fail $ "Unexpected type in EC2 y parameter: " <> show typ - - pure P.PublicKeyECDSA {..} - - decodeRSAKey :: Decoder s P.UncheckedPublicKey - decodeRSAKey = do - -- https://www.rfc-editor.org/rfc/rfc8812.html#section-2 - -- > Implementations need to check that the key type is 'RSA' when creating or verifying a signature. - checkKty R.CoseKeyTypeRSA - -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4 - decodeExpected R.CoseKeyTypeParameterRSAN - -- > The octet sequence MUST utilize the minimum number of octets needed to represent the value. - rsaN <- os2ipNoLeading =<< decodeBytesCanonical - decodeExpected R.CoseKeyTypeParameterRSAE - rsaE <- os2ipNoLeading =<< decodeBytesCanonical - pure P.PublicKeyRSA {..} - --- | Same as 'os2ip', but throws an error if there are not exactly as many bytes as expected. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with @'i2ospOf_' size@. -os2ipWithSize :: MonadFail m => Int -> BS.ByteString -> m Integer -os2ipWithSize size bytes - | BS.length bytes == size = pure $ os2ip bytes - | otherwise = - fail $ - "bytes have length " - <> show (BS.length bytes) - <> " when length " - <> show size - <> " was expected" - --- | Same as 'os2ip', but throws an error if there are leading zero bytes. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with 'i2osp'. -os2ipNoLeading :: MonadFail m => BS.ByteString -> m Integer -os2ipNoLeading bytes - | leadingZeroCount == 0 = pure $ os2ip bytes - | otherwise = - fail $ - "bytes of length " - <> show (BS.length bytes) - <> " has " - <> show leadingZeroCount - <> " leading zero bytes when none were expected" - where - leadingZeroCount = BS.length (BS.takeWhile (== 0) bytes) - --- | Decode a value and ensure it's the same as the value that was given -decodeExpected :: (Show a, Eq a, Serialise a) => a -> Decoder s () -decodeExpected expected = do - actual <- decode - unless (expected == actual) $ - fail $ - "Expected " <> show expected <> " but got " <> show actual - -fromCurveEdDSA :: P.CoseCurveEdDSA -> R.CoseEllipticCurveOKP -fromCurveEdDSA P.CoseCurveEd25519 = R.CoseEllipticCurveEd25519 - -toCurveEdDSA :: R.CoseEllipticCurveOKP -> P.CoseCurveEdDSA -toCurveEdDSA R.CoseEllipticCurveEd25519 = P.CoseCurveEd25519 - -fromCurveECDSA :: P.CoseCurveECDSA -> R.CoseEllipticCurveEC2 -fromCurveECDSA P.CoseCurveP256 = R.CoseEllipticCurveEC2P256 -fromCurveECDSA P.CoseCurveP384 = R.CoseEllipticCurveEC2P384 -fromCurveECDSA P.CoseCurveP521 = R.CoseEllipticCurveEC2P521 - -toCurveECDSA :: R.CoseEllipticCurveEC2 -> P.CoseCurveECDSA -toCurveECDSA R.CoseEllipticCurveEC2P256 = P.CoseCurveP256 -toCurveECDSA R.CoseEllipticCurveEC2P384 = P.CoseCurveP384 -toCurveECDSA R.CoseEllipticCurveEC2P521 = P.CoseCurveP521 diff --git a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Registry.hs b/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Registry.hs deleted file mode 100644 index e920e2ebd..000000000 --- a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Registry.hs +++ /dev/null @@ -1,300 +0,0 @@ -{-# language LambdaCase #-} -{-# language RecordWildCards #-} -{-# language DeriveAnyClass #-} -{-# language DeriveGeneric #-} -{-# language TypeApplications #-} -{-# language ScopedTypeVariables #-} -{-# language AllowAmbiguousTypes #-} - --- | Stability: internal --- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml) --- entries that are relevant for Webauthn COSE public keys. All the types in --- this module implement the 'Serialise' class, mapping them to the respective --- CBOR values/labels. --- --- This modules sometimes uses this --- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4) --- to describe CBOR value types corresponding to CBOR parameters -module Pact.Core.Crypto.WebAuthn.Cose.Registry - ( -- * COSE Key Types - CoseKeyType (..), - - -- * COSE Parameters - CoseKeyCommonParameter (..), - CoseKeyTypeParameterOKP (..), - CoseKeyTypeParameterEC2 (..), - CoseKeyTypeParameterRSA (..), - parameterCount, - - -- * COSE Elliptic Curves - CoseEllipticCurveOKP (..), - CoseEllipticCurveEC2 (..), - ) -where - -import Codec.CBOR.Decoding (decodeIntCanonical) -import Codec.CBOR.Encoding (encodeInt) -import Codec.Serialise (Serialise) -import Codec.Serialise.Class (decode, encode) - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters) --- All the entries from the [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters) --- that are needed for Webauthn public keys -data CoseKeyCommonParameter - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) - -- - -- * COSE value type: tstr / int - -- * Value registry: 'CoseKeyType' - -- * Description: Identification of the key type - -- - -- This parameter is used to identify the family of keys for this - -- structure and, thus, the set of key-type-specific parameters to be - -- found. The key type MUST be included as part of the trust decision - -- process. - CoseKeyCommonParameterKty - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1) - -- - -- * COSE value type: tstr / int - -- * Value registry: 'Crypto.WebAuthn.Cose.Algorithm.CoseSignAlg' - -- * Description: Key usage restriction to this algorithm - -- - -- This parameter is used to restrict the algorithm that is used - -- with the key. - CoseKeyCommonParameterAlg - deriving (Eq, Show, Bounded, Enum) - --- | Serialises the parameters using the @Label@ column from the --- [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters) -instance Serialise CoseKeyCommonParameter where - encode CoseKeyCommonParameterKty = encodeInt 1 - encode CoseKeyCommonParameterAlg = encodeInt 3 - decode = - decodeIntCanonical >>= \case - 1 -> pure CoseKeyCommonParameterKty - 3 -> pure CoseKeyCommonParameterAlg - value -> fail $ "Unknown COSE key common parameter " <> show value - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type) --- All the entries from the [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type) --- that are known to be needed for Webauthn public keys -data CoseKeyType - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- Octet Key Pair. - -- See 'CoseKeyTypeParameterOKP' for the parameters specific to this key type. - CoseKeyTypeOKP - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- Elliptic Curve Keys w/ x- and y-coordinate pair. - -- See 'CoseKeyTypeParameterEC2' for the parameters specific to this key type. - CoseKeyTypeEC2 - | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- RSA Key. - -- See 'CoseKeyTypeParameterRSA' for the parameters specific to this key type. - CoseKeyTypeRSA - deriving (Eq, Show) - --- | Serialises the key type using the @Value@ column from the --- [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type) -instance Serialise CoseKeyType where - encode CoseKeyTypeOKP = encodeInt 1 - encode CoseKeyTypeEC2 = encodeInt 2 - encode CoseKeyTypeRSA = encodeInt 3 - decode = - decodeIntCanonical >>= \case - 1 -> pure CoseKeyTypeOKP - 2 -> pure CoseKeyTypeEC2 - 3 -> pure CoseKeyTypeRSA - value -> fail $ "Unknown COSE key type " <> show value - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) --- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) --- for key type 'CoseKeyTypeOKP' (aka @Key Type@ is @1@) that are required for --- public keys -data CoseKeyTypeParameterOKP - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- - -- * COSE value type: int / tstr - -- * Value registry: 'CoseEllipticCurveOKP' - -- * Description: EC identifier - -- - -- This contains an identifier of the curve to be used with the key. - CoseKeyTypeParameterOKPCrv - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2) - -- - -- * COSE value type: bstr - -- * Description: Public Key - -- - -- This contains the public key. The byte string contains the public key as defined by the algorithm. - CoseKeyTypeParameterOKPX - deriving (Eq, Show, Bounded, Enum) - --- | Serialises the parameters using the @Label@ column from the --- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) -instance Serialise CoseKeyTypeParameterOKP where - encode CoseKeyTypeParameterOKPCrv = encodeInt (-1) - encode CoseKeyTypeParameterOKPX = encodeInt (-2) - decode = - decodeIntCanonical >>= \case - -1 -> pure CoseKeyTypeParameterOKPCrv - -2 -> pure CoseKeyTypeParameterOKPX - value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type OKP" - --- | Elliptic curves for key type 'CoseKeyTypeOKP' from the --- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves), --- limited to the ones that are currently needed for Webauthn -data CoseEllipticCurveOKP - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- Ed25519 for use w/ EdDSA only - CoseEllipticCurveEd25519 - deriving (Eq, Show) - --- | Serialises COSE Elliptic Curves using the @Value@ column from the --- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves). -instance Serialise CoseEllipticCurveOKP where - encode CoseEllipticCurveEd25519 = encodeInt 6 - decode = - decodeIntCanonical >>= \case - 6 -> pure CoseEllipticCurveEd25519 - value -> fail $ "Unknown COSE elliptic curve " <> show value <> " for key type OKP" - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) --- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) --- for key type 'CoseKeyTypeEC2' (aka @Key Type@ is @2@) that are required for --- public keys -data CoseKeyTypeParameterEC2 - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- - -- * COSE value type: int / tstr - -- * Value registry: 'CoseEllipticCurveEC2' - -- * Description: EC identifier - -- - -- This contains an identifier of the curve to be used with the key. - CoseKeyTypeParameterEC2Crv - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- - -- * COSE value type: bstr - -- * Description: x-coordinate - -- - -- This contains the x-coordinate for the EC point. The integer is - -- converted to a byte string as defined in [SEC1]. Leading zero - -- octets MUST be preserved. - CoseKeyTypeParameterEC2X - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1) - -- - -- * COSE value type: bstr / bool - -- * Description: y-coordinate - -- - -- This contains either the sign bit or the value of the - -- y-coordinate for the EC point. When encoding the value y, the - -- integer is converted to an byte string (as defined in - -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1)) - -- and encoded as a CBOR bstr. Leading zero octets MUST be - -- preserved. The compressed point encoding is also supported. - -- Compute the sign bit as laid out in the Elliptic-Curve-Point-to- - -- Octet-String Conversion function of - -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1). - -- If the sign bit is zero, then encode y as a CBOR false value; - -- otherwise, encode y as a CBOR true value. - -- The encoding of the infinity point is not supported. - CoseKeyTypeParameterEC2Y - deriving (Eq, Show, Bounded, Enum) - --- | Serialises the parameters using the @Label@ column from the --- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) -instance Serialise CoseKeyTypeParameterEC2 where - encode CoseKeyTypeParameterEC2Crv = encodeInt (-1) - encode CoseKeyTypeParameterEC2X = encodeInt (-2) - encode CoseKeyTypeParameterEC2Y = encodeInt (-3) - decode = - decodeIntCanonical >>= \case - -1 -> pure CoseKeyTypeParameterEC2Crv - -2 -> pure CoseKeyTypeParameterEC2X - -3 -> pure CoseKeyTypeParameterEC2Y - value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type EC2" - --- | Elliptic curves for key type 'CoseKeyTypeEC2' from the --- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves), --- limited to the ones that are currently needed for Webauthn -data CoseEllipticCurveEC2 - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-256 also known as secp256r1 - CoseEllipticCurveEC2P256 - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-384 also known as secp384r1 - CoseEllipticCurveEC2P384 - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1) - -- NIST P-521 also known as secp521r1 - CoseEllipticCurveEC2P521 - deriving (Eq, Show) - --- | Serialises COSE Elliptic Curves using the @Value@ column from the --- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves). -instance Serialise CoseEllipticCurveEC2 where - encode CoseEllipticCurveEC2P256 = encodeInt 1 - encode CoseEllipticCurveEC2P384 = encodeInt 2 - encode CoseEllipticCurveEC2P521 = encodeInt 3 - decode = - decodeIntCanonical >>= \case - 1 -> pure CoseEllipticCurveEC2P256 - 2 -> pure CoseEllipticCurveEC2P384 - 3 -> pure CoseEllipticCurveEC2P521 - value -> fail $ "Unknown COSE elliptic curve " <> show value <> " for key type EC2" - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) --- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) --- for key type 'CoseKeyTypeRSA' (aka @Key Type@ is @3@) that are required for --- public keys -data CoseKeyTypeParameterRSA - = -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- - -- * COSE value type: bstr - -- * Description: the RSA modulus n - -- - -- The RSA modulus n is a product of u distinct odd primes - -- r_i, i = 1, 2, ..., u, where u >= 2 - -- - -- All numeric key parameters are encoded in an unsigned big-endian - -- representation as an octet sequence using the CBOR byte string - -- type (major type 2). The octet sequence MUST utilize the minimum - -- number of octets needed to represent the value. For instance, the - -- value 32,768 is represented as the CBOR byte sequence 0b010_00010, - -- 0x80 0x00 (major type 2, additional information 2 for the length). - CoseKeyTypeParameterRSAN - | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4) - -- - -- * COSE value type: bstr - -- * Description: the RSA public exponent e - -- - -- The RSA public exponent e is an integer between 3 and n - 1 satisfying - -- GCD(e,\lambda(n)) = 1, where \lambda(n) = LCM(r_1 - 1, ..., r_u - 1) - -- - -- All numeric key parameters are encoded in an unsigned big-endian - -- representation as an octet sequence using the CBOR byte string - -- type (major type 2). The octet sequence MUST utilize the minimum - -- number of octets needed to represent the value. For instance, the - -- value 32,768 is represented as the CBOR byte sequence 0b010_00010, - -- 0x80 0x00 (major type 2, additional information 2 for the length). - CoseKeyTypeParameterRSAE - deriving (Eq, Show, Bounded, Enum) - --- | Serialises the parameters using the @Label@ column from the --- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters) -instance Serialise CoseKeyTypeParameterRSA where - encode CoseKeyTypeParameterRSAN = encodeInt (-1) - encode CoseKeyTypeParameterRSAE = encodeInt (-2) - decode = - decodeIntCanonical >>= \case - -1 -> pure CoseKeyTypeParameterRSAN - -2 -> pure CoseKeyTypeParameterRSAE - value -> fail $ "Unknown COSE key type parameter " <> show value <> " for key type RSA" - --- | The number of parameters for a 'CoseKeyType' relevant for Webauthn public --- keys -parameterCount :: CoseKeyType -> Word -parameterCount CoseKeyTypeOKP = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterOKP -parameterCount CoseKeyTypeEC2 = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterEC2 -parameterCount CoseKeyTypeRSA = cardinality @CoseKeyCommonParameter + cardinality @CoseKeyTypeParameterRSA - --- | A utility function for getting the number of constructors for a type --- that implements both 'Bounded' and 'Enum' -cardinality :: forall a b. (Bounded a, Enum a, Num b) => b -cardinality = fromIntegral $ 1 + fromEnum @a maxBound - fromEnum @a minBound diff --git a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/SignAlg.hs b/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/SignAlg.hs deleted file mode 100644 index f6fe8e4db..000000000 --- a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/SignAlg.hs +++ /dev/null @@ -1,243 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Stability: experimental --- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml) --- entries that are relevant for Webauthn COSE public keys. All the types in --- this module implement the 'Serialise' class, mapping them to the respective --- CBOR values/labels. --- --- This modules sometimes uses this --- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4) --- to describe CBOR value types corresponding to CBOR parameters -module Pact.Core.Crypto.WebAuthn.Cose.SignAlg - ( -- * COSE Algorithms - CoseSignAlg - ( .., - CoseAlgorithmEdDSA, - CoseAlgorithmES256, - CoseAlgorithmES384, - CoseAlgorithmES512, - CoseAlgorithmRS256, - CoseAlgorithmRS384, - CoseAlgorithmRS512, - CoseAlgorithmRS1 - ), - fromCoseSignAlg, - toCoseSignAlg, - - -- * Hash Algorithms - CoseHashAlgECDSA (..), - CoseHashAlgRSA (..), - ) -where - -import Codec.CBOR.Decoding (decodeIntCanonical) -import Codec.CBOR.Encoding (encodeInt) -import Codec.Serialise (Serialise) -import Codec.Serialise.Class (decode, encode) -import Data.Text (Text) -import qualified Data.Text as Text -import GHC.Generics (Generic) - --- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- All the entries from the [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- limited to the ones that are currently needed for Webauthn. Notably we only --- care about asymmetric signature algorithms -data CoseSignAlg - = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) - -- EdDSA - -- - -- [RFC8032](https://datatracker.ietf.org/doc/html/rfc8032) describes the elliptic curve signature scheme Edwards-curve - -- Digital Signature Algorithm (EdDSA). In that document, the signature - -- algorithm is instantiated using parameters for edwards25519 and - -- edwards448 curves. The document additionally describes two variants - -- of the EdDSA algorithm: Pure EdDSA, where no hash function is applied - -- to the content before signing, and HashEdDSA, where a hash function - -- is applied to the content before signing and the result of that hash - -- function is signed. For EdDSA, the content to be signed (either the - -- message or the pre-hash value) is processed twice inside of the - -- signature algorithm. For use with COSE, only the pure EdDSA version - -- is used. - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2.1) - CoseSignAlgEdDSA - | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) - -- ECDSA - -- - -- ECDSA [DSS] defines a signature algorithm using ECC. Implementations - -- SHOULD use a deterministic version of ECDSA such as the one defined - -- in [RFC6979]. - -- - -- The ECDSA signature algorithm is parameterized with a hash function - -- (h). In the event that the length of the hash function output is - -- greater than the group of the key, the leftmost bytes of the hash - -- output are used. - -- ECDSA w/ SHA-256 - -- - -- This document defines ECDSA to work only with the curves P-256, - -- P-384, and P-521. Future documents may define it to work with other - -- curves and points in the future. - -- - -- In order to promote interoperability, it is suggested that SHA-256 be - -- used only with curve P-256, SHA-384 be used only with curve P-384, - -- and SHA-512 be used with curve P-521. This is aligned with the - -- recommendation in [Section 4 of RFC5480](https://datatracker.ietf.org/doc/html/rfc5480#section-4) - -- - -- Security considerations are [here](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1.1) - CoseSignAlgECDSA CoseHashAlgECDSA - | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) - -- The RSASSA-PKCS1-v1_5 signature algorithm is defined in - -- [RFC8017](https://www.rfc-editor.org/rfc/rfc8812.html#RFC8017). - -- The RSASSA-PKCS1-v1_5 signature algorithm is parameterized with a hash function (h). - -- - -- A key of size 2048 bits or larger MUST be used with these algorithms. - -- - -- Security considerations are [here](https://www.rfc-editor.org/rfc/rfc8812.html#section-5) - CoseSignAlgRSA CoseHashAlgRSA - deriving (Eq, Show, Ord, Generic) - --- | Hash algorithms that can be used with the ECDSA signature algorithm -data CoseHashAlgECDSA - = -- | SHA-256 - CoseHashAlgECDSASHA256 - | -- | SHA-384 - CoseHashAlgECDSASHA384 - | -- | SHA-512 - CoseHashAlgECDSASHA512 - deriving (Eq, Show, Ord, Enum, Bounded, Generic) - --- | Hash algorithms that can be used with the RSA signature algorithm -data CoseHashAlgRSA - = -- | SHA-1 (deprecated) - CoseHashAlgRSASHA1 - | -- | SHA-256 - CoseHashAlgRSASHA256 - | -- | SHA-384 - CoseHashAlgRSASHA384 - | -- | SHA-512 - CoseHashAlgRSASHA512 - deriving (Eq, Show, Ord, Enum, Bounded, Generic) - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @EdDSA@. Alias for 'CoseSignAlgEdDSA' --- --- * Name: EdDSA --- * Description: EdDSA --- * Recommended: Yes -pattern CoseAlgorithmEdDSA :: CoseSignAlg -pattern CoseAlgorithmEdDSA = CoseSignAlgEdDSA - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @ES256@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA256'@ --- --- * Name: ES256 --- * Description: ECDSA w/ SHA-256 --- * Recommended: Yes -pattern CoseAlgorithmES256 :: CoseSignAlg -pattern CoseAlgorithmES256 = CoseSignAlgECDSA CoseHashAlgECDSASHA256 - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @ES384@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA384'@ --- --- * Name: ES384 --- * Description: ECDSA w/ SHA-384 --- * Recommended: Yes -pattern CoseAlgorithmES384 :: CoseSignAlg -pattern CoseAlgorithmES384 = CoseSignAlgECDSA CoseHashAlgECDSASHA384 - --- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @ES512@. Alias for @'CoseSignAlgECDSA' 'CoseHashAlgECDSASHA512'@ --- --- * Name: ES512 --- * Description: ECDSA w/ SHA-512 --- * Recommended: Yes -pattern CoseAlgorithmES512 :: CoseSignAlg -pattern CoseAlgorithmES512 = CoseSignAlgECDSA CoseHashAlgECDSASHA512 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS256@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA256'@ --- --- * Name: RS256 --- * Description: RSASSA-PKCS1-v1_5 using SHA-256 --- * Recommended: No -pattern CoseAlgorithmRS256 :: CoseSignAlg -pattern CoseAlgorithmRS256 = CoseSignAlgRSA CoseHashAlgRSASHA256 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS384@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA384'@ --- --- * Name: RS384 --- * Description: RSASSA-PKCS1-v1_5 using SHA-384 --- * Recommended: No -pattern CoseAlgorithmRS384 :: CoseSignAlg -pattern CoseAlgorithmRS384 = CoseSignAlgRSA CoseHashAlgRSASHA384 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS512@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA512'@ --- --- * Name: RS512 --- * Description: RSASSA-PKCS1-v1_5 using SHA-512 --- * Recommended: No -pattern CoseAlgorithmRS512 :: CoseSignAlg -pattern CoseAlgorithmRS512 = CoseSignAlgRSA CoseHashAlgRSASHA512 - --- | [(spec)](https://www.rfc-editor.org/rfc/rfc8812.html#section-2) --- [Cose Algorithm registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms) --- entry @RS1@. Alias for @'CoseSignAlgRSA' 'CoseHashAlgRSASHA1'@ --- --- * Name: RS1 --- * Description: RSASSA-PKCS1-v1_5 using SHA-1 --- * Recommended: Deprecated -pattern CoseAlgorithmRS1 :: CoseSignAlg -pattern CoseAlgorithmRS1 = CoseSignAlgRSA CoseHashAlgRSASHA1 - --- | Serialises COSE Algorithms using the @Value@ column from the --- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). --- This uses the 'fromCoseSignAlg' and 'toCoseSignAlg' functions to do the --- encoding and decoding respectively. -instance Serialise CoseSignAlg where - encode = encodeInt . fromCoseSignAlg - decode = do - int <- decodeIntCanonical - case toCoseSignAlg int of - Right res -> pure res - Left err -> fail $ Text.unpack err - --- | Converts a 'CoseSignAlg' to the corresponding integer value from the --- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). --- The inverse operation is 'toCoseSignAlg' -fromCoseSignAlg :: Num p => CoseSignAlg -> p -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA1) = -65535 -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA512) = -259 -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA384) = -258 -fromCoseSignAlg (CoseSignAlgRSA CoseHashAlgRSASHA256) = -257 -fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA512) = -36 -fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA384) = -35 -fromCoseSignAlg CoseSignAlgEdDSA = -8 -fromCoseSignAlg (CoseSignAlgECDSA CoseHashAlgECDSASHA256) = -7 - --- | Converts an integer value to the corresponding 'CoseSignAlg' from the --- [COSE Algorithms registry](https://www.iana.org/assignments/cose/cose.xhtml#algorithms). --- Returns an error if the integer doesn't represent a known algorithm. --- The inverse operation is 'fromCoseSignAlg' -toCoseSignAlg :: (Eq a, Num a, Show a) => a -> Either Text CoseSignAlg -toCoseSignAlg (-65535) = pure (CoseSignAlgRSA CoseHashAlgRSASHA1) -toCoseSignAlg (-259) = pure (CoseSignAlgRSA CoseHashAlgRSASHA512) -toCoseSignAlg (-258) = pure (CoseSignAlgRSA CoseHashAlgRSASHA384) -toCoseSignAlg (-257) = pure (CoseSignAlgRSA CoseHashAlgRSASHA256) -toCoseSignAlg (-36) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA512) -toCoseSignAlg (-35) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA384) -toCoseSignAlg (-8) = pure CoseSignAlgEdDSA -toCoseSignAlg (-7) = pure (CoseSignAlgECDSA CoseHashAlgECDSASHA256) -toCoseSignAlg value = Left $ "Unknown COSE algorithm value " <> Text.pack (show value) diff --git a/pact-tests/Pact/Core/Test/CommandTests.hs b/pact-tests/Pact/Core/Test/CommandTests.hs index 76db45d6e..5576b713b 100644 --- a/pact-tests/Pact/Core/Test/CommandTests.hs +++ b/pact-tests/Pact/Core/Test/CommandTests.hs @@ -8,6 +8,7 @@ module Pact.Core.Test.CommandTests ) where import qualified Data.Aeson as A +import Data.Foldable (forM_) import Data.ByteString import Data.Text import Test.Tasty @@ -16,9 +17,10 @@ import Test.Tasty.HUnit import Pact.Core.PactValue import Pact.Core.Command.Client -import Pact.Core.Command.Crypto (generateEd25519KeyPair) +import Pact.Core.Command.Crypto (generateEd25519KeyPair, generateWebAuthnEd25519KeyPair) import Pact.Core.Command.RPC import Pact.Core.Command.Types +import Pact.Core.StableEncoding exampleCommand :: IO (Command ByteString) exampleCommand = do @@ -32,11 +34,28 @@ tests = do pure $ testGroup "CommandTests" [ testCase "verifyCommand" $ do cmd <- exampleCommand - let cmdResult = verifyCommand @Int cmd + let cmdResult = verifyCommand @(StableEncoding PactValue) cmd case cmdResult of ProcFail f -> do print f assertFailure "Command should be valid" ProcSucc _ -> assertBool "Command should be valid" True + + , testCase "verifyBatch" $ do + webAuthnKeys <- generateWebAuthnEd25519KeyPair + let + metaData = StableEncoding (PUnit) + mkRpc :: Text -> PactRPC Text + mkRpc pactCode = Exec $ ExecMsg { _pmCode = pactCode, _pmData = PUnit } + cmds <- mkCommandsWithBatchSignatures (webAuthnKeys, []) + [([], metaData, "nonce-1", Nothing, mkRpc "(+ 1 1)") + ,([], metaData, "nonce-2", Nothing, mkRpc "(+ 1 2)") + ,([], metaData, "nonce-3", Nothing, mkRpc "(+ 1 3)") + ,([], metaData, "nonce-4", Nothing, mkRpc "(+ 1 4)") + ] + forM_ cmds $ \cmd -> case verifyCommand @(StableEncoding PactValue) cmd of + ProcFail f -> assertFailure $ "Command should be valid: " <> show f + ProcSucc _ -> pure () + ] diff --git a/pact-tests/Pact/Core/Test/SignatureSchemeTests.hs b/pact-tests/Pact/Core/Test/SignatureSchemeTests.hs index 82806bc79..a2141f138 100644 --- a/pact-tests/Pact/Core/Test/SignatureSchemeTests.hs +++ b/pact-tests/Pact/Core/Test/SignatureSchemeTests.hs @@ -112,7 +112,7 @@ testKeyPairImport :: TestTree testKeyPairImport = do testCase "imports ED25519 Key Pair" $ do [(DynEd25519KeyPair kp, caps)] <- mkKeyPairs (toApiKeyPairs [someED25519Pair]) - (map getKeyPairComponents [(kp, caps)]) @=? [someED25519Pair] + (map getKeyPairComponents [(kp, _sigCapability <$> caps)]) @=? [someED25519Pair] testDefSchemeApiKeyPair :: TestTree @@ -121,7 +121,7 @@ testDefSchemeApiKeyPair = let (pub, priv, addr, _) = someED25519Pair apiKP = ApiKeyPair priv (Just pub) addr Nothing Nothing [(DynEd25519KeyPair kp, caps)] <- mkKeyPairs [apiKP] - (map getKeyPairComponents [(kp, caps)]) @?= [someED25519Pair] + (map getKeyPairComponents [(kp, _sigCapability <$> caps)]) @?= [someED25519Pair] shouldThrow :: (HasCallStack, Exception e) => IO a -> (e -> Bool) -> Assertion shouldThrow act f = do @@ -145,7 +145,7 @@ testPublicKeyImport = let (_, priv, addr, scheme) = someED25519Pair apiKP = ApiKeyPair priv Nothing addr (Just scheme) Nothing [(DynEd25519KeyPair kp, caps)] <- mkKeyPairs [apiKP] - (map getKeyPairComponents [(kp,caps)]) @?= [someED25519Pair] + (map getKeyPairComponents [(kp, _sigCapability <$> caps)]) @?= [someED25519Pair] doesNotMatchDerivedPk = testCase "throws error when PublicKey provided does not match derived PublicKey" $ do diff --git a/pact-tng.cabal b/pact-tng.cabal index cbb42980f..5876b3330 100644 --- a/pact-tng.cabal +++ b/pact-tng.cabal @@ -54,6 +54,8 @@ library unsafe common pact-common build-depends: , Decimal + , asn1-encoding + , asn1-types , attoparsec , base , base16-bytestring @@ -79,7 +81,7 @@ common pact-common , vector , vector-algorithms , megaparsec - , cryptonite + , crypton , memory , safe-exceptions , ralist >= 0.4.0.0 @@ -151,9 +153,10 @@ library pact-request-api visibility: public hs-source-dirs: pact-request-api build-depends: - asn1-encoding - , asn1-types , cereal + , crypton + , lrucaching + , merkle-log , pact-tng , pact-tng:pact-crypto , yaml @@ -164,11 +167,6 @@ library pact-request-api Pact.Core.Command.RPC Pact.Core.Command.Util Pact.Core.Command.SigData - Pact.Core.Crypto.WebAuthn.Cose.PublicKey - Pact.Core.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg - Pact.Core.Crypto.WebAuthn.Cose.Registry - Pact.Core.Crypto.WebAuthn.Cose.SignAlg - Pact.Core.Crypto.WebAuthn.Cose.Verify library import: pact-common @@ -306,6 +304,7 @@ library Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg Pact.Crypto.WebAuthn.Cose.Registry Pact.Crypto.WebAuthn.Cose.SignAlg + Pact.Crypto.WebAuthn.Cose.Verify -- Hyperlane Pact.Crypto.Hyperlane diff --git a/pact/Pact/Core/Evaluate.hs b/pact/Pact/Core/Evaluate.hs index f91913c2f..fa462c094 100644 --- a/pact/Pact/Core/Evaluate.hs +++ b/pact/Pact/Core/Evaluate.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DataKinds #-} @@ -7,6 +8,7 @@ module Pact.Core.Evaluate ( MsgData(..) , RawCode(..) + , EvalInput , EvalResult(..) , Cont(..) , Info diff --git a/pact/Pact/Core/Guards.hs b/pact/Pact/Core/Guards.hs index c5f5c98db..2ff7734ff 100644 --- a/pact/Pact/Core/Guards.hs +++ b/pact/Pact/Core/Guards.hs @@ -13,6 +13,7 @@ module Pact.Core.Guards , renderKeySetName , keysetNameParser , parseAnyKeysetName +, parseWebAuthnPublicKeyText , Governance(..) , KeySet(..) , Guard(..) @@ -163,7 +164,7 @@ parseWebAuthnPublicKeyText (PublicKeyText k) where parseWebAuthnPublicKey :: ByteString -> Either String WA.CosePublicKey parseWebAuthnPublicKey rawPk = do - pk <- over _Left (\e -> "WebAuthn public key parsing error: " <> show e) $ + pk <- over _Left (\_ -> "WebAuthn public key parsing error") $ Serialise.deserialiseOrFail @WA.CosePublicKey (BSL.fromStrict rawPk) webAuthnPubKeyHasValidAlg pk return pk diff --git a/pact/Pact/Core/Hash.hs b/pact/Pact/Core/Hash.hs index e4e0a6c8d..a7832d18a 100644 --- a/pact/Pact/Core/Hash.hs +++ b/pact/Pact/Core/Hash.hs @@ -33,6 +33,7 @@ module Pact.Core.Hash , parseModuleHash -- unsafe creating of a 'ModuleHash', only used in the -- legacy translation process. +, unsafeBsToPactHash , unsafeBsToModuleHash ) where diff --git a/pact/Pact/Core/Scheme.hs b/pact/Pact/Core/Scheme.hs index b399aacb5..a5eafbaf8 100644 --- a/pact/Pact/Core/Scheme.hs +++ b/pact/Pact/Core/Scheme.hs @@ -21,6 +21,7 @@ import qualified Pact.JSON.Encode as J --------- PPKSCHEME DATA TYPE --------- +-- | data PPKScheme = ED25519 | WebAuthn deriving (Show, Eq, Ord, Generic, Bounded, Enum) @@ -38,4 +39,4 @@ instance JD.FromJSON PPKScheme where _ -> fail "Invalid PPKScheme" defPPKScheme :: PPKScheme -defPPKScheme = ED25519 \ No newline at end of file +defPPKScheme = ED25519 diff --git a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Verify.hs b/pact/Pact/Crypto/WebAuthn/Cose/Verify.hs similarity index 96% rename from pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Verify.hs rename to pact/Pact/Crypto/WebAuthn/Cose/Verify.hs index 198ccf15d..37e624c61 100644 --- a/pact-request-api/Pact/Core/Crypto/WebAuthn/Cose/Verify.hs +++ b/pact/Pact/Crypto/WebAuthn/Cose/Verify.hs @@ -21,7 +21,7 @@ -- * A 'Cose.PublicKey' can be created from an X.509 public key with 'fromX509' -- * A 'Cose.CoseSignAlg' and a 'Cose.PublicKey' can be used to verify a signature -- with 'verify' -module Pact.Core.Crypto.WebAuthn.Cose.Verify +module Pact.Crypto.WebAuthn.Cose.Verify ( -- * Signature verification verify @@ -36,6 +36,9 @@ import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import qualified Pact.Crypto.WebAuthn.Cose.PublicKey as Cose +import qualified Pact.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose +import qualified Pact.Crypto.WebAuthn.Cose.SignAlg as Cose import qualified Data.ASN1.BinaryEncoding as ASN1 import qualified Data.ASN1.Encoding as ASN1 import qualified Data.ASN1.Types as ASN1 @@ -43,10 +46,6 @@ import qualified Data.ByteString as BS import Data.Text (Text) import qualified Data.Text as Text -import qualified Pact.Core.Crypto.WebAuthn.Cose.PublicKey as Cose -import qualified Pact.Core.Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose -import qualified Pact.Core.Crypto.WebAuthn.Cose.SignAlg as Cose - -- | Verifies an asymmetric signature for a message using a -- 'Cose.PublicKeyWithSignAlg' Returns an error if the signature algorithm -- doesn't match. Also returns an error if the signature wasn't valid or for