Skip to content

Commit

Permalink
WebAuthn yes
Browse files Browse the repository at this point in the history
  • Loading branch information
edmundnoble committed Nov 21, 2023
1 parent 5e6eec3 commit d1fff46
Show file tree
Hide file tree
Showing 8 changed files with 138 additions and 78 deletions.
3 changes: 2 additions & 1 deletion src/Chainweb/Pact/PactService/ExecBlock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -250,13 +250,14 @@ validateChainwebTxs logger v cid cp txValidationTime bh txs doBuyGas

checkTxSigs :: ChainwebTransaction -> IO (Either InsertError ChainwebTransaction)
checkTxSigs t
| assertValidateSigs validSchemes hsh signers sigs = pure $ Right t
| assertValidateSigs validSchemes webAuthnPrefixLegal hsh signers sigs = pure $ Right t
| otherwise = return $ Left InsertErrorInvalidSigs
where
hsh = P._cmdHash t
sigs = P._cmdSigs t
signers = P._pSigners $ payloadObj $ P._cmdPayload t
validSchemes = validPPKSchemes v cid bh
webAuthnPrefixLegal = isWebAuthnPrefixLegal v cid bh

initTxList :: ValidateTxs
initTxList = V.map Right txs
Expand Down
3 changes: 2 additions & 1 deletion src/Chainweb/Pact/RestAPI/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,7 @@ import qualified Chainweb.TreeDB as TreeDB
import Chainweb.Utils
import Chainweb.Version
import Chainweb.Pact.Validations (assertCommand)
import Chainweb.Version.Guards (validPPKSchemes )
import Chainweb.Version.Guards (isWebAuthnPrefixLegal, validPPKSchemes)
import Chainweb.WebPactExecutionService

import Chainweb.Storage.Table
Expand Down Expand Up @@ -696,6 +696,7 @@ validateCommand v cid cmdText = case parsedPayload of
if assertCommand
commandParsed
(validPPKSchemes v cid maxBound)
(isWebAuthnPrefixLegal v cid maxBound)
then Right commandParsed
else Left "Command failed validation"
Left e -> Left $ "Pact parsing error: " ++ e
Expand Down
29 changes: 18 additions & 11 deletions src/Chainweb/Pact/Validations.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@ module Chainweb.Pact.Validations
, assertNetworkId
, assertSigSize
, assertTxSize
, IsWebAuthnPrefixLegal(..)
, assertValidateSigs
, assertTxTimeRelativeToParent
, assertCommand
Expand All @@ -40,6 +41,7 @@ import Data.Maybe (isJust, catMaybes, fromMaybe)
import Data.Either (isRight)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.ByteString.Short as SBS
import Data.Word (Word8)

Expand All @@ -51,15 +53,16 @@ import Chainweb.Pact.Types
import Chainweb.Pact.Utils (fromPactChainId)
import Chainweb.Pact.Service.Types
import Chainweb.Time (Seconds(..), Time(..), secondsToTimeSpan, scaleTimeSpan, second, add)
import Chainweb.Transaction (cmdTimeToLive, cmdCreationTime, PayloadWithText, payloadBytes, payloadObj)
import Chainweb.Transaction (cmdTimeToLive, cmdCreationTime, PayloadWithText, payloadBytes, payloadObj, IsWebAuthnPrefixLegal(..))
import Chainweb.Version
import Chainweb.Version.Guards (validPPKSchemes)
import Chainweb.Version.Guards (isWebAuthnPrefixLegal, validPPKSchemes)

import qualified Pact.Types.Gas as P
import qualified Pact.Types.Hash as P
import qualified Pact.Types.ChainId as P
import qualified Pact.Types.Command as P
import qualified Pact.Types.ChainMeta as P
import qualified Pact.Types.KeySet as P
import qualified Pact.Parse as P


Expand All @@ -77,6 +80,7 @@ assertLocalMetadata cmd@(P.Command pay sigs hsh) txCtx sigVerify = do

let bh = ctxCurrentBlockHeight txCtx
let validSchemes = validPPKSchemes v cid bh
let webAuthnPrefixLegal = isWebAuthnPrefixLegal v cid bh

let P.PublicMeta pcid _ gl gp _ _ = P._pMeta pay
nid = P._pNetworkId pay
Expand All @@ -89,17 +93,17 @@ assertLocalMetadata cmd@(P.Command pay sigs hsh) txCtx sigVerify = do
, eUnless "Gas price decimal precision too high" $ assertGasPrice gp
, eUnless "Network id mismatch" $ assertNetworkId v nid
, eUnless "Signature list size too big" $ assertSigSize sigs
, eUnless "Invalid transaction signatures" $ sigValidate validSchemes signers
, eUnless "Invalid transaction signatures" $ sigValidate validSchemes webAuthnPrefixLegal signers
, eUnless "Tx time outside of valid range" $ assertTxTimeRelativeToParent pct cmd
]

pure $ case nonEmpty errs of
Nothing -> Right ()
Just vs -> Left vs
where
sigValidate validSchemes signers
sigValidate validSchemes webAuthnPrefixLegal signers
| Just NoVerify <- sigVerify = True
| otherwise = assertValidateSigs validSchemes hsh signers sigs
| otherwise = assertValidateSigs validSchemes webAuthnPrefixLegal hsh signers sigs

pct = ParentCreationTime
. _blockCreationTime
Expand Down Expand Up @@ -158,16 +162,19 @@ assertTxSize initialGas gasLimit = initialGas < fromIntegral gasLimit
-- | Check and assert that signers and user signatures are valid for a given
-- transaction hash.
--
assertValidateSigs :: [P.PPKScheme] -> P.PactHash -> [P.Signer] -> [P.UserSig] -> Bool
assertValidateSigs validSchemes hsh signers sigs
assertValidateSigs :: [P.PPKScheme] -> IsWebAuthnPrefixLegal -> P.PactHash -> [P.Signer] -> [P.UserSig] -> Bool
assertValidateSigs validSchemes webAuthnPrefixLegal hsh signers sigs
| length signers /= length sigs = False
| otherwise = and $ zipWith verifyUserSig sigs signers
where verifyUserSig sig signer =
let
sigScheme = fromMaybe P.ED25519 (P._siScheme signer)
okScheme = sigScheme `elem` validSchemes
okPrefix =
webAuthnPrefixLegal == WebAuthnPrefixLegal ||
not (P.webAuthnPrefix `T.isPrefixOf` P._siPubKey signer)
okSignature = isRight $ P.verifyUserSig hsh sig signer
in okScheme && okSignature
in okScheme && okPrefix && okSignature

-- prop_tx_ttl_newBlock/validateBlock
--
Expand Down Expand Up @@ -195,10 +202,10 @@ assertTxTimeRelativeToParent (ParentCreationTime (BlockCreationTime txValidation

-- | Assert that the command hash matches its payload and
-- its signatures are valid, without parsing the payload.
assertCommand :: P.Command PayloadWithText -> [P.PPKScheme] -> Bool
assertCommand (P.Command pwt sigs hsh) ppkSchemePassList =
assertCommand :: P.Command PayloadWithText -> [P.PPKScheme] -> IsWebAuthnPrefixLegal -> Bool
assertCommand (P.Command pwt sigs hsh) ppkSchemePassList webAuthnPrefixLegal =
isRight assertHash &&
assertValidateSigs ppkSchemePassList hsh signers sigs
assertValidateSigs ppkSchemePassList webAuthnPrefixLegal hsh signers sigs
where
cmdBS = SBS.fromShort $ payloadBytes pwt
signers = P._pSigners (payloadObj pwt)
Expand Down
6 changes: 6 additions & 0 deletions src/Chainweb/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ module Chainweb.Transaction
, HashableTrans(..)
, PayloadWithText
, PactParserVersion(..)
, IsWebAuthnPrefixLegal(..)
, chainwebPayloadCodec
, encodePayload
, decodePayload
Expand Down Expand Up @@ -85,6 +86,11 @@ data PactParserVersion
| PactParserChainweb213
deriving (Eq, Ord, Bounded, Show, Enum)

data IsWebAuthnPrefixLegal
= WebAuthnPrefixIllegal
| WebAuthnPrefixLegal
deriving (Eq, Ord, Bounded, Show, Enum)

-- | Hashable newtype of ChainwebTransaction
newtype HashableTrans a = HashableTrans { unHashable :: Command a }
deriving (Eq, Functor, Ord)
Expand Down
7 changes: 7 additions & 0 deletions src/Chainweb/Version/Guards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ module Chainweb.Version.Guards
, pactParserVersion
, maxBlockGasLimit
, validPPKSchemes
, isWebAuthnPrefixLegal
, validKeyFormats

-- ** BlockHeader Validation Guards
Expand Down Expand Up @@ -264,6 +265,12 @@ validPPKSchemes v cid bh =
then [ED25519, WebAuthn]
else [ED25519]

isWebAuthnPrefixLegal :: ChainwebVersion -> ChainId -> BlockHeight -> IsWebAuthnPrefixLegal
isWebAuthnPrefixLegal v cid bh =
if chainweb222Pact v cid bh
then WebAuthnPrefixLegal
else WebAuthnPrefixIllegal

validKeyFormats :: ChainwebVersion -> ChainId -> BlockHeight -> [PublicKeyText -> Bool]
validKeyFormats v cid bh =
if chainweb222Pact v cid bh
Expand Down
2 changes: 1 addition & 1 deletion test/Chainweb/Test/Cut/TestBlockDb.hs
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ addTestBlockDb (TestBlockDb wdb pdb cmv) n gbt cid outs = do
return False

-- something went wrong
Left e -> throwM $ userError (show e)
Left e -> throwM $ userError ("addTestBlockDb: " <> show e)

-- | Get header for chain on current cut.
getParentTestBlockDb :: TestBlockDb -> ChainId -> IO BlockHeader
Expand Down
130 changes: 74 additions & 56 deletions test/Chainweb/Test/Pact/PactMultiChainTest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1077,10 +1077,8 @@ pact49UpgradeTest = do
-- WebAuthn is not yet a valid PPK scheme, so this transaction
-- is not valid for insertion into the mempool.
expectInvalid
[ PactTxTest webAuthnSignedTransaction $
assertTxSuccess
"WebAuthn not valid scheme at this block height"
(pDecimal 3)
"WebAuthn should not yet be supported"
[ webAuthnSignedTransaction
]

-- run block 99 (before the pact-4.9 fork)
Expand Down Expand Up @@ -1115,69 +1113,89 @@ pact410UpgradeTest = do
runToHeight 110

expectInvalid
[ PactTxTest readValidWebAuthnPrefixedSignerPrefixedKey $
assertTxFailure
"Key prefixing is not yet supported."
"Invalid keyset"
"WebAuthn prefixed keys should not yet be supported in signatures"
[ prefixedSigned
]

runToHeight 120
runBlockTest
[ -- PactTxTest addTenTwenty $
-- assertTxSuccess
-- "WebAuthn not valid scheme at this block height"
-- (pDecimal 30)

-- , PactTxTest readValidWebAuthnPrefixedSignerPrefixedKey $
-- assertTxSuccess
-- "Key prefixing is supported."
-- (pBool True)

-- -- , PactTxTest readValidPrefixedWebAuthnKeyNoPrefix $
-- -- assertTxSuccess
-- -- "Key prefixing is supported."
-- -- (pBool True)

-- , PactTxTest readInvalidPrefixedWebAuthnKey $
-- assertTxFailure
-- "Key prefixing is supported."
-- "Invalid keyset"
[ PactTxTest prefixedSigned $
assertTxSuccess
"Prefixed WebAuthn signers should be legal"
(pDecimal 1)

, PactTxTest prefixedSignerPrefixedKey $
assertTxSuccess
"WebAuthn prefixed keys should be enforceable with prefixed signers"
(pBool True)

, PactTxTest bareSignerPrefixedKey $
assertTxFailure
"WebAuthn prefixed keys should not be enforceable with bare signers"
"Keyset failure (keys-all): [WEBAUTHN...]"

, PactTxTest definePrefixedKeySet $
assertTxSuccess
"WebAuthn prefixed keys should be enforceable after defining them"
(pBool True)

, PactTxTest prefixedSignerPrefixedKeyCreatePrincipal $
assertTxSuccess
"WebAuthn prefixed keys in a keyset should be possible to make into w: principals"
(pString "w:XrscJ2X8aFxFF7oilzFyjQuA1mUN8jgwdxbAd8rt21M:keys-all")

, PactTxTest prefixedSignerPrefixedKeyValidatePrincipal $
assertTxSuccess
"WebAuthn prefixed keys in a keyset should be possible to make into *valid* w: principals"
(pBool True)

, PactTxTest prefixedSignerBareKey $
assertTxFailure
"WebAuthn bare keys should throw an error when read"
"Invalid keyset"

, PactTxTest invalidPrefixedKey $
assertTxFailure
"Invalid WebAuthn prefixed keys should throw an error when read"
"Invalid keyset"

]

where
addTenTwenty = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec'
"(let ((x:integer 10) (y:integer 20)) (+ x y))"

-- readValidPrefixedEd25519Key = buildBasicGas 1000 $ mkExec
-- "(read-keyset 'k)"
-- (mkKeyEnvData "ED25519-368820f80c324bbc7c2b0610688a7da43e39f91d118732671cd9c7500ff43cca")
prefixedSigned = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec' "1"

-- readInvalidPrefixedEd25519Key = buildBasicGas 1000 $ mkExec
-- "(read-keyset 'k)"
-- (mkKeyEnvData "ED2551-Z")
prefixedSignerBareKey = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
"(enforce-keyset (read-keyset 'k))"
(mkKeyEnvData "a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")

readValidWebAuthnPrefixedSignerBareKey = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
bareSignerPrefixedKey = buildBasicGasWebAuthnBareSigner 1000 $ mkExec
"(enforce-keyset (read-keyset 'k))"
(mkKeyEnvData "a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")
(mkKeyEnvData "WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")

readValidWebAuthnPrefixedSignerPrefixedKey = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
prefixedSignerPrefixedKey = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
"(enforce-keyset (read-keyset 'k))"
(mkKeyEnvData "WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")
(mkKeyEnvData "WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")

-- readValidPrefixedWebAuthnKeyNoPrefix = buildBasicGas 1000 $ mkExec
-- "(enforce-keyset (read-keyset 'k))"
-- (mkKeyEnvData "a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")
definePrefixedKeySet = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
"(namespace 'free) (define-keyset \"free.edmund\" (read-keyset 'k)) (enforce-keyset \"free.edmund\")"
(mkKeyEnvData "WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")

prefixedSignerPrefixedKeyCreatePrincipal = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
"(create-principal (read-keyset 'k))"
(mkKeyEnvData "WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")

prefixedSignerPrefixedKeyValidatePrincipal = buildBasicGasWebAuthnPrefixedSigner 1000 $ mkExec
"(let ((ks (read-keyset 'k))) (validate-principal ks (create-principal ks)))"
(mkKeyEnvData "WEBAUTHN-a4010103272006215820c18831c6f15306d6271e154842906b68f26c1af79b132dde6f6add79710303bf")

-- This hardcoded public key is the same as the valid one above, except that the first
-- character is changed. CBOR parsing will fail.
readInvalidPrefixedWebAuthnKey = buildBasicGas 1000 $ mkExec
"(read-keyset 'k)"
(mkKeyEnvData "WEBAUTHN-a401010327200add79710303bf")
invalidPrefixedKey = buildBasicGas 1000 $ mkExec
"(read-keyset 'k)"
(mkKeyEnvData "WEBAUTHN-a401010327200add79710303bf")

mkKeyEnvData :: String -> Value
mkKeyEnvData key = object [ "k" .= [key] ]
-- addOneTwo = buildBasicGas 1000 $ mkExec' "(+ 1 2)"


pact4coin3UpgradeTest :: PactTestM ()
Expand Down Expand Up @@ -1427,13 +1445,13 @@ testsToBlock chid pts = blockForChain chid $ MempoolBlock $ \_ ->

-- | No tests in this list should even be submitted to the mempool,
-- they should be rejected early.
expectInvalid :: [PactTxTest] -> PactTestM ()
expectInvalid pts = do
expectInvalid :: String -> [MempoolCmdBuilder] -> PactTestM ()
expectInvalid msg pts = do
chid <- view menvChainId
setPactMempool $ PactMempool [testsToBlock chid pts]
cutResult <- try runCut'
setPactMempool $ PactMempool [blockForChain chid $ MempoolBlock $ \_ -> pure pts]
_ <- runCut'
rs <- txResults
liftIO $ assertEqual "None of these transactions should succeed" rs mempty
liftIO $ assertEqual msg mempty rs

-- | Run tests on current cut and chain.
runBlockTests :: HasCallStack => [PactTxTest] -> PactTestM ()
Expand Down Expand Up @@ -1515,8 +1533,7 @@ setFromHeader bh =
buildBasic
:: PactRPC T.Text
-> MempoolCmdBuilder
-- buildBasic = buildBasic' (\cmd -> cmd { _cbNetworkId = Just testVersion })
buildBasic = buildBasic' id
buildBasic = buildBasic' (\cmd -> cmd { _cbNetworkId = Just testVersion })

buildBasicGas :: GasLimit -> PactRPC T.Text -> MempoolCmdBuilder
buildBasicGas g = buildBasic' (set cbGasLimit g)
Expand All @@ -1529,6 +1546,7 @@ buildBasic'
buildBasic' f r = MempoolCmdBuilder $ \(MempoolInput _ bh) ->
f $ signSender00
$ setFromHeader bh
$ (\cmd -> cmd { _cbNetworkId = Just testVersion })
$ mkCmd (sshow bh) r

buildBasicWebAuthnBareSigner'
Expand All @@ -1538,7 +1556,7 @@ buildBasicWebAuthnBareSigner'
buildBasicWebAuthnBareSigner' f r = MempoolCmdBuilder $ \(MempoolInput _ bh) ->
f $ signWebAuthn00
$ setFromHeader bh
-- $ (\cmd -> cmd { _cbNetworkId = Just testVersion })
$ (\cmd -> cmd { _cbNetworkId = Just testVersion })
$ mkCmd (sshow bh) r

buildBasicWebAuthnPrefixedSigner'
Expand All @@ -1548,7 +1566,7 @@ buildBasicWebAuthnPrefixedSigner'
buildBasicWebAuthnPrefixedSigner' f r = MempoolCmdBuilder $ \(MempoolInput _ bh) ->
f $ signWebAuthn00Prefixed
$ setFromHeader bh
-- $ (\cmd -> cmd { _cbNetworkId = Just testVersion })
$ (\cmd -> cmd { _cbNetworkId = Just testVersion })
$ mkCmd (sshow bh) r

buildBasicGasWebAuthnPrefixedSigner :: GasLimit -> PactRPC T.Text -> MempoolCmdBuilder
Expand Down
Loading

0 comments on commit d1fff46

Please sign in to comment.