Add passphrase to ledger signing api (#177)

* Add passphrase to ledger signing api

This addresses #168; Instead of having the passphrase for signing
hardcoded to "Ledger.Crypto PassPhrase", allow the passphrase to be
provided. This way we aren't prevented from using private keys
created with tools like cardano-address and cardano-cli

* Add tests to verify signing and verification

* Add oracle sign off-chain and on-chain prop tests

* Bump materialized plans

* Adds forceNewEval to release.nix

Co-authored-by: John Lotoski <[email protected]>

ci.nix

@@ -7,6 +7,7 @@
 , checkMaterialization ? false
 , sourcesOverride ? { }
 , sources ? import ./nix/sources.nix { system = builtins.currentSystem; } // sourcesOverride
+, plutus-apps-commit ? { outPath = ./.; rev = "abcdef"; }
 }:
 let
   inherit (import (sources.plutus-core + "/nix/lib/ci.nix")) dimension platformFilterGeneric filterAttrsOnlyRecursive filterSystems;
@@ -72,11 +73,26 @@ let
               # When cross compiling only include haskell for now
               inherit (x) haskell;
             };
+          forceNewEval = pkgs.runCommand "forceNewEval"
+            {
+              text = plutus-apps-commit.rev;
+              meta.platforms = [ "x86_64-linux" ];
+              preferLocalBuild = true;
+              allowSubstitutes = false;
+            } ''
+            n=$out
+            mkdir -p "$(dirname "$n")"
+            echo -n "$text" > "$n"
+          '';
         in
         filterAttrsOnlyRecursive (_: drv: isBuildable drv) ({
           # The haskell.nix IFD roots for the Haskell project. We include these so they won't be GCd and will be in the
           # cache for users
           inherit (plutus-apps.haskell.project) roots;
+
+          # forceNewEval will generate at least one new job based off the commit hash.
+          # This ensures no eval failures because hydra has nothing new to build.
+          inherit forceNewEval;
         } // pkgs.lib.optionalAttrs (!rootsOnly) (filterCross {
           # build relevant top level attributes from default.nix
           inherit (packages) docs tests plutus-playground plutus-use-cases;

plutus-contract/plutus-contract.cabal

@@ -186,6 +186,7 @@ test-suite plutus-contract-test
         Spec.ThreadToken
         Spec.Secrets
         Spec.Plutus.Contract.Wallet
+        Spec.Plutus.Contract.Oracle
     build-depends:
         base >=4.9 && <5,
         bytestring -any,

plutus-contract/src/Plutus/Contract/Oracle.hs

@@ -27,6 +27,9 @@ module Plutus.Contract.Oracle(
   -- * Signing messages
   , signMessage
   , signObservation
+  -- * Signing messages with no passphrase
+  , signMessage'
+  , signObservation'
   ) where
 
 import Data.Aeson (FromJSON, ToJSON)
@@ -39,7 +42,7 @@ import PlutusTx.Prelude (Applicative (pure), Either (Left, Right), Eq ((==)), ma
 import Ledger.Address (PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey (PaymentPubKey))
 import Ledger.Constraints (TxConstraints)
 import Ledger.Constraints qualified as Constraints
-import Ledger.Crypto (PubKey (PubKey), Signature (Signature))
+import Ledger.Crypto (Passphrase, PrivateKey, PubKey (..), Signature (..))
 import Ledger.Crypto qualified as Crypto
 import Ledger.Scripts (Datum (Datum), DatumHash (DatumHash))
 import Ledger.Scripts qualified as Scripts
@@ -198,21 +201,38 @@ verifySignedMessageOffChain pk s@SignedMessage{osmSignature, osmMessageHash} =
 
 -- | Encode a message of type @a@ as a @Data@ value and sign the
 --   hash of the datum.
-signMessage :: ToData a => a -> PaymentPrivateKey -> SignedMessage a
-signMessage msg pk =
+signMessage :: ToData a => a -> PaymentPrivateKey -> Passphrase -> SignedMessage a
+signMessage msg pk pass =
   let dt = Datum (toBuiltinData msg)
       DatumHash msgHash = Scripts.datumHash dt
-      sig     = Crypto.sign msgHash (unPaymentPrivateKey pk)
+      sig     = Crypto.sign msgHash (unPaymentPrivateKey pk) pass
   in SignedMessage
         { osmSignature = sig
         , osmMessageHash = DatumHash msgHash
         , osmDatum = dt
         }
 
 -- | Encode an observation of a value of type @a@ that was made at the given time
-signObservation :: ToData a => POSIXTime -> a -> PaymentPrivateKey -> SignedMessage (Observation a)
+signObservation :: ToData a => POSIXTime -> a -> PaymentPrivateKey -> Passphrase -> SignedMessage (Observation a)
 signObservation time vl = signMessage Observation{obsValue=vl, obsTime=time}
 
+-- | Encode a message of type @a@ as a @Data@ value and sign the
+--   hash of the datum.
+signMessage' :: ToData a => a -> PrivateKey -> SignedMessage a
+signMessage' msg pk =
+  let dt = Datum (toBuiltinData msg)
+      DatumHash msgHash = Scripts.datumHash dt
+      sig     = Crypto.sign' msgHash pk
+  in SignedMessage
+        { osmSignature = sig
+        , osmMessageHash = DatumHash msgHash
+        , osmDatum = dt
+        }
+
+-- | Encode an observation of a value of type @a@ that was made at the given time
+signObservation' :: ToData a => POSIXTime -> a -> PrivateKey -> SignedMessage (Observation a)
+signObservation' time vl = signMessage' Observation{obsValue=vl, obsTime=time}
+
 makeLift ''SignedMessage
 makeIsDataIndexed ''SignedMessage [('SignedMessage,0)]
 

plutus-contract/src/Wallet/Emulator/Wallet.hs

@@ -286,7 +286,7 @@ handleAddSignature ::
     -> Eff effs Tx
 handleAddSignature tx = do
     (PaymentPrivateKey privKey) <- gets ownPaymentPrivateKey
-    pure (Ledger.addSignature privKey tx)
+    pure (Ledger.addSignature' privKey tx)
 
 ownOutputs :: forall effs.
     ( Member ChainIndexQueryEffect effs
@@ -592,14 +592,14 @@ signTxWithPrivateKey
 signTxWithPrivateKey (PaymentPrivateKey pk) tx pkh@(PaymentPubKeyHash pubK) = do
     let ownPaymentPubKey = Ledger.toPublicKey pk
     if Ledger.pubKeyHash ownPaymentPubKey == pubK
-    then pure (Ledger.addSignature pk tx)
+    then pure (Ledger.addSignature' pk tx)
     else throwError (WAPI.PaymentPrivateKeyNotFound pkh)
 
 -- | Sign the transaction with the given private keys,
 --   ignoring the list of public keys that the 'SigningProcess' is passed.
 signPrivateKeys :: [PaymentPrivateKey] -> SigningProcess
 signPrivateKeys signingKeys = SigningProcess $ \_ tx ->
-    pure (foldr (Ledger.addSignature . unPaymentPrivateKey) tx signingKeys)
+    pure (foldr (Ledger.addSignature' . unPaymentPrivateKey) tx signingKeys)
 
 data SigningProcessControlEffect r where
     SetSigningProcess :: SigningProcess -> SigningProcessControlEffect ()

plutus-contract/test/Spec.hs

@@ -4,6 +4,7 @@ module Main(main) where
 import Spec.Contract qualified
 import Spec.Emulator qualified
 import Spec.ErrorChecking qualified
+import Spec.Plutus.Contract.Oracle qualified
 import Spec.Plutus.Contract.Wallet qualified
 import Spec.Rows qualified
 import Spec.Secrets qualified
@@ -23,5 +24,6 @@ tests = testGroup "plutus-contract" [
     Spec.ThreadToken.tests,
     Spec.Secrets.tests,
     Spec.ErrorChecking.tests,
-    Spec.Plutus.Contract.Wallet.tests
+    Spec.Plutus.Contract.Wallet.tests,
+    Spec.Plutus.Contract.Oracle.tests
     ]

plutus-contract/test/Spec/Plutus/Contract/Oracle.hs

@@ -0,0 +1,43 @@
+module Spec.Plutus.Contract.Oracle where
+
+import Hedgehog (Property, forAll, property)
+import Hedgehog qualified
+import Ledger.Address (PaymentPrivateKey (PaymentPrivateKey, unPaymentPrivateKey), PaymentPubKey (PaymentPubKey))
+import Ledger.Crypto (generateFromSeed, toPublicKey)
+import Ledger.Generators qualified as Gen
+import Plutus.Contract.Oracle
+import PlutusTx.Prelude (isRight, toBuiltin)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Hedgehog (testProperty)
+
+tests :: TestTree
+tests =
+    testGroup
+        "Plutus.Contract.Oracle"
+        [ testProperty "Oracle signed payloads verify with oracle public key offchain" oracleSignOffChainProp,
+          testProperty "Oracle signed payloads verify with on-chain constraint" oracleSignContrastraintProp
+        ]
+
+oracleSignOffChainProp :: Property
+oracleSignOffChainProp = property $ do
+  seed <- forAll Gen.genSeed
+  pass <- forAll Gen.genPassphrase
+  msg <- forAll $ toBuiltin <$> Gen.genSizedByteString 128
+
+  let
+    privKey = PaymentPrivateKey $ generateFromSeed seed pass
+    pubKey = PaymentPubKey . toPublicKey . unPaymentPrivateKey $ privKey
+
+  Hedgehog.assert $ isRight $ verifySignedMessageOffChain pubKey $ signMessage msg privKey pass
+
+oracleSignContrastraintProp :: Property
+oracleSignContrastraintProp = property $ do
+  seed <- forAll Gen.genSeed
+  pass <- forAll Gen.genPassphrase
+  msg <- forAll $ toBuiltin <$> Gen.genSizedByteString 128
+
+  let
+    privKey = PaymentPrivateKey $ generateFromSeed seed pass
+    pubKey = PaymentPubKey . toPublicKey . unPaymentPrivateKey $ privKey
+
+  Hedgehog.assert $ isRight $ verifySignedMessageConstraints pubKey $ signMessage msg privKey pass

plutus-ledger/src/Ledger/CardanoWallet.hs

@@ -17,6 +17,7 @@ module Ledger.CardanoWallet(
     knownMockWallets,
     knownMockWallet,
     fromSeed,
+    fromSeed',
     -- ** Keys
     paymentPrivateKey,
     paymentPubKeyHash,
@@ -71,13 +72,19 @@ newtype WalletNumber = WalletNumber { getWallet :: Integer }
     deriving anyclass (FromJSON, ToJSON)
 
 fromWalletNumber :: WalletNumber -> MockWallet
-fromWalletNumber (WalletNumber i) = fromSeed (BSL.toStrict $ serialise i)
+fromWalletNumber (WalletNumber i) = fromSeed' (BSL.toStrict $ serialise i)
 
-fromSeed :: BS.ByteString -> MockWallet
-fromSeed bs = MockWallet{mwWalletId, mwPaymentKey, mwStakeKey} where
+fromSeed :: BS.ByteString -> Crypto.Passphrase -> MockWallet
+fromSeed bs passPhrase = fromSeedInternal (flip Crypto.generateFromSeed passPhrase) bs
+
+fromSeed' :: BS.ByteString -> MockWallet
+fromSeed' = fromSeedInternal Crypto.generateFromSeed'
+
+fromSeedInternal :: (BS.ByteString -> Crypto.XPrv) -> BS.ByteString -> MockWallet
+fromSeedInternal seedGen bs = MockWallet{mwWalletId, mwPaymentKey, mwStakeKey} where
     missing = max 0 (32 - BS.length bs)
     bs' = bs <> BS.replicate missing 0
-    k = Crypto.generateFromSeed bs'
+    k = seedGen bs'
     mwWalletId = CW.WalletId
         $ fromMaybe (error "Ledger.CardanoWallet.fromSeed: digestFromByteString")
         $ Crypto.digestFromByteString

plutus-ledger/src/Ledger/Crypto.hs

@@ -1,30 +1,44 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE TypeApplications   #-}
 
 module Ledger.Crypto
     ( module Export
     , PrivateKey
+    , Passphrase(..)
     , pubKeyHash
     , signedBy
     , sign
     , signTx
     , generateFromSeed
     , toPublicKey
     , xPubToPublicKey
-    , passPhrase
+    -- * Signing and generation with no passphrase
+    , sign'
+    , signTx'
+    , generateFromSeed'
     ) where
 
 import Cardano.Crypto.Wallet qualified as Crypto
 import Crypto.Hash qualified as Crypto
 import Data.ByteArray qualified as BA
 import Data.ByteString qualified as BS
+import Data.String
 import Plutus.V1.Ledger.Api (LedgerBytes (LedgerBytes), TxId (TxId), fromBuiltin, toBuiltin)
 import Plutus.V1.Ledger.Bytes qualified as KB
 import Plutus.V1.Ledger.Crypto as Export hiding (PrivateKey)
 import PlutusTx.Prelude qualified as P
 
 type PrivateKey = Crypto.XPrv
 
+-- | Passphrase newtype to mark intent
+newtype Passphrase =
+  Passphrase { unPassphrase :: BS.ByteString }
+  deriving newtype (IsString)
+
+instance Show Passphrase where
+  show _ = "<passphrase>"
+
 -- | Compute the hash of a public key.
 pubKeyHash :: PubKey -> PubKeyHash
 pubKeyHash (PubKey (LedgerBytes bs)) =
@@ -34,25 +48,38 @@ pubKeyHash (PubKey (LedgerBytes bs)) =
       $ Crypto.hashWith Crypto.Blake2b_224 (fromBuiltin bs)
 
 -- | Check whether the given 'Signature' was signed by the private key corresponding to the given public key.
-signedBy :: Signature -> PubKey -> TxId -> Bool
-signedBy (Signature s) (PubKey k) (TxId txId) =
+signedBy :: BA.ByteArrayAccess a => Signature -> PubKey -> a -> Bool
+signedBy (Signature s) (PubKey k) payload =
     let xpub = Crypto.XPub (KB.bytes k) (Crypto.ChainCode "" {- value is ignored -})
         xsig = either error id $ Crypto.xsignature (P.fromBuiltin s)
-    in Crypto.verify xpub txId xsig
+    in Crypto.verify xpub payload xsig
 
--- | Sign the hash of a transaction using a private key.
-signTx :: TxId -> Crypto.XPrv -> Signature
+-- | Sign the hash of a transaction using a private key and passphrase.
+signTx :: TxId -> Crypto.XPrv -> Passphrase -> Signature
 signTx (TxId txId) = sign txId
 
--- | Sign a message using a private key.
-sign :: BA.ByteArrayAccess a => a -> Crypto.XPrv -> Signature
-sign msg privKey = Signature . toBuiltin . Crypto.unXSignature $ Crypto.sign passPhrase privKey msg
+-- | Sign the hash of a transaction using a private key that has no passphrase.
+signTx' :: TxId -> Crypto.XPrv -> Signature
+signTx' txId xprv = signTx txId xprv noPassphrase
+
+-- | Sign a message using a private key and passphrase.
+sign :: BA.ByteArrayAccess a => a -> Crypto.XPrv -> Passphrase -> Signature
+sign msg privKey (Passphrase passPhrase) = Signature . toBuiltin . Crypto.unXSignature $ Crypto.sign passPhrase privKey msg
+
+-- | Sign a message using a private key with no passphrase.
+sign' :: BA.ByteArrayAccess a => a -> Crypto.XPrv -> Signature
+sign' msg privKey = sign msg privKey noPassphrase
+
+-- | Generate a private key from a seed phrase and passphrase
+generateFromSeed :: BS.ByteString -> Passphrase -> Crypto.XPrv
+generateFromSeed seed (Passphrase passPhrase) = Crypto.generate seed passPhrase
 
-passPhrase :: BS.ByteString
-passPhrase = "Ledger.Crypto PassPhrase"
+-- | Generate a private key from a seed phrase without a passphrase.
+generateFromSeed' :: BS.ByteString -> Crypto.XPrv
+generateFromSeed' seed = generateFromSeed seed noPassphrase
 
-generateFromSeed :: BS.ByteString -> Crypto.XPrv
-generateFromSeed seed = Crypto.generate seed passPhrase
+noPassphrase :: Passphrase
+noPassphrase = Passphrase ""
 
 xPubToPublicKey :: Crypto.XPub -> PubKey
 xPubToPublicKey = PubKey . KB.fromBytes . Crypto.xpubPublicKey

plutus-ledger/src/Ledger/Generators.hs

@@ -41,6 +41,8 @@ module Ledger.Generators(
     genSizedByteString,
     genSizedByteStringExact,
     genTokenName,
+    genSeed,
+    genPassphrase,
     splitVal,
     validateMockchain,
     signAll,
@@ -70,12 +72,12 @@ import Hedgehog
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 import Ledger (Ada, CurrencySymbol, Interval, MintingPolicy, OnChainTx (Valid), POSIXTime (POSIXTime, getPOSIXTime),
-               POSIXTimeRange, PaymentPrivateKey (unPaymentPrivateKey), PaymentPubKey (PaymentPubKey),
-               RedeemerPtr (RedeemerPtr), ScriptContext (ScriptContext), ScriptTag (Mint), Slot (Slot), SlotRange,
-               SomeCardanoApiTx (SomeTx), TokenName,
+               POSIXTimeRange, Passphrase (Passphrase), PaymentPrivateKey (unPaymentPrivateKey),
+               PaymentPubKey (PaymentPubKey), RedeemerPtr (RedeemerPtr), ScriptContext (ScriptContext),
+               ScriptTag (Mint), Slot (Slot), SlotRange, SomeCardanoApiTx (SomeTx), TokenName,
                Tx (txFee, txInputs, txMint, txMintScripts, txOutputs, txRedeemers, txValidRange), TxIn,
                TxInInfo (txInInfoOutRef), TxInfo (TxInfo), TxOut (txOutValue), TxOutRef (TxOutRef),
-               UtxoIndex (UtxoIndex), ValidationCtx (ValidationCtx), Value, _runValidation, addSignature,
+               UtxoIndex (UtxoIndex), ValidationCtx (ValidationCtx), Value, _runValidation, addSignature',
                mkMintingPolicyScript, pubKeyTxIn, pubKeyTxOut, scriptCurrencySymbol, toPublicKey, txId)
 import Ledger qualified
 import Ledger.CardanoWallet qualified as CW
@@ -92,7 +94,7 @@ import PlutusTx qualified
 
 -- | Attach signatures of all known private keys to a transaction.
 signAll :: Tx -> Tx
-signAll tx = foldl' (flip addSignature) tx
+signAll tx = foldl' (flip addSignature') tx
            $ fmap unPaymentPrivateKey knownPaymentPrivateKeys
 
 -- | The parameters for the generators in this module.
@@ -441,3 +443,12 @@ knownPaymentPublicKeys =
 
 knownPaymentPrivateKeys :: [PaymentPrivateKey]
 knownPaymentPrivateKeys = CW.paymentPrivateKey <$> CW.knownMockWallets
+
+-- | Seed suitable for testing a seed but not for actual wallets as ScrubbedBytes isn't used to ensure
+--  memory isn't inspectable
+genSeed :: MonadGen m => m BS.ByteString
+genSeed =  Gen.bytes $ Range.singleton 32
+
+genPassphrase :: MonadGen m => m Passphrase
+genPassphrase =
+  Passphrase <$> Gen.utf8 (Range.singleton 16) Gen.unicode