Merge #878

878: Support for legacy UTxO witness in Jörmungandr r=KtorZ a=KtorZ # Issue Number  #779 # Overview  - [x] I have extended `mkStdTx` so that it would properly handle transactions coming from a `RndKey` and construct `legacy-utxo` witnesses for it. # Comments  Jörmungandr doesn't implement creating legacy utxo witnesses from jcli ... [jcli/src/jcli_app/transaction/mk_witness.rs](https://github.com/input-output-hk/jormungandr/blob/master/jcli/src/jcli_app/transaction/mk_witness.rs#L78-L82) ```rust WitnessType::OldUTxO => { // TODO unimplemented!() let _secret_key: SecretKey<Ed25519Bip32> = self.secret()?; Err(Error::MakeWitnessLegacyUtxoUnsupported)?; unimplemented!() } ``` so I had to construct them by hand according to: - The format defined in [chain-impl-mockchain#witnesses](https://github.com/input-output-hk/chain-libs/blob/incentive/chain-impl-mockchain/doc/format.md#witnesses) - The format from the source (double checking it matches the doc..) [chain-impl-mockchain/src/transaction/witness.rs](https://github.com/input-output-hk/chain-libs/blob/incentive/chain-impl-mockchain/src/transaction/witness.rs#L173-L176) It'd be nice to review our golden if / when the constructor for the witness type gets updated.  Co-authored-by: KtorZ <[email protected]>
cardano-foundation · Oct 22, 2019 · b8d621b · b8d621b
2 parents 45e7227 + 6af04d7
commit b8d621b
Show file tree

Hide file tree

Showing 6 changed files with 297 additions and 68 deletions.
diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs
@@ -62,7 +62,7 @@ import Cardano.Wallet.Jormungandr.Transaction
 import Cardano.Wallet.Network
     ( NetworkLayer (..), defaultRetryPolicy, waitForNetwork )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( KeyToAddress, PersistKey )
+    ( PersistKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Random
     ( RndKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Sequential
@@ -77,6 +77,8 @@ import Cardano.Wallet.Primitive.Model
     ( BlockchainParameters (..) )
 import Cardano.Wallet.Primitive.Types
     ( Block, Hash (..) )
+import Cardano.Wallet.Transaction
+    ( TransactionLayer )
 import Control.Concurrent.Async
     ( race_ )
 import Control.DeepSeq
@@ -132,8 +134,10 @@ serveWallet (cfg, tr) databaseDir hostPref listen lj beforeMainLoop = do
             waitForService "Jörmungandr" tr nPort $
                 waitForNetwork nl defaultRetryPolicy
             let (_, bp) = staticBlockchainParameters nl
-            rndApi <- apiLayer tr (toWLBlock <$> nl)
-            seqApi <- apiLayer tr (toWLBlock <$> nl)
+            let rndTl = newTransactionLayer @n (getGenesisBlockHash bp)
+            let seqTl = newTransactionLayer @n (getGenesisBlockHash bp)
+            rndApi <- apiLayer tr rndTl (toWLBlock <$> nl)
+            seqApi <- apiLayer tr seqTl (toWLBlock <$> nl)
             startServer tr nPort bp rndApi seqApi
         Left e -> handleNetworkStartupError e
   where
@@ -162,20 +166,19 @@ serveWallet (cfg, tr) databaseDir hostPref listen lj beforeMainLoop = do
     toWLBlock = J.convertBlock
 
     apiLayer
-        :: forall s k .
-            ( KeyToAddress (Jormungandr 'Testnet) k
-            , IsOurs s
+        :: forall s k.
+            ( IsOurs s
             , NFData s
             , Show s
             , PersistState s
             , PersistKey k
             )
         => Trace IO Text
+        -> TransactionLayer t k
         -> NetworkLayer IO t (Block Tx)
         -> IO (ApiLayer s t k)
-    apiLayer tracer nl = do
+    apiLayer tracer tl nl = do
         let (block0, bp) = staticBlockchainParameters nl
-        let tl = newTransactionLayer @n (getGenesisBlockHash bp)
         wallets <- maybe (pure []) (Sqlite.findDatabases @k tr) databaseDir
         Server.newApiLayer tracer (block0, bp) nl tl dbFactory wallets
 

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs
@@ -39,6 +39,15 @@ module Cardano.Wallet.Jormungandr.Binary
     , putSignedTx
     , putTx
 
+    -- * Transaction witnesses
+    , signData
+    , utxoWitness
+    , legacyUtxoWitness
+    , TxWitnessTag (..)
+    , putTxWitnessTag
+    , getTxWitnessTag
+    , txWitnessSize
+
     -- * Purification of chain block types
     , convertBlock
     , convertBlockHeader
@@ -48,7 +57,7 @@ module Cardano.Wallet.Jormungandr.Binary
     , getAddress
     , singleAddressFromKey
 
-      -- * Legacy Decoders
+      -- * Legacy
     , decodeLegacyAddress
 
       -- * Helpers
@@ -57,7 +66,6 @@ module Cardano.Wallet.Jormungandr.Binary
     , fragmentId
     , maxNumberOfInputs
     , maxNumberOfOutputs
-    , signData
     , withHeader
 
       -- * Re-export
@@ -71,7 +79,7 @@ module Cardano.Wallet.Jormungandr.Binary
 import Prelude
 
 import Cardano.Crypto.Wallet
-    ( XPub (xpubPublicKey) )
+    ( XPub (xpubPublicKey), unXPub )
 import Cardano.Wallet.Jormungandr.Environment
     ( KnownNetwork, Network (..), single )
 import Cardano.Wallet.Jormungandr.Primitive.Types
@@ -266,6 +274,21 @@ data TxWitnessTag
     | TxWitnessMultisig
     deriving (Show, Eq)
 
+putTxWitnessTag :: TxWitnessTag -> Put
+putTxWitnessTag = \case
+    TxWitnessLegacyUTxO -> putWord8 0
+    TxWitnessUTxO -> putWord8 1
+    TxWitnessAccount -> putWord8 2
+    TxWitnessMultisig -> putWord8 3
+
+getTxWitnessTag :: Get TxWitnessTag
+getTxWitnessTag = getWord8 >>= \case
+    0 -> pure TxWitnessLegacyUTxO
+    1 -> pure TxWitnessUTxO
+    2 -> pure TxWitnessAccount
+    3 -> pure TxWitnessMultisig
+    other -> fail $ "Invalid witness type: " ++ show other
+
 -- | Decode a message (header + contents).
 getMessage :: Get Message
 getMessage = label "getMessage" $ do
@@ -305,6 +328,22 @@ txWitnessSize = \case
     TxWitnessAccount -> 64
     TxWitnessMultisig -> 68
 
+txWitnessTagSize :: Int
+txWitnessTagSize = 1
+
+-- | Construct a UTxO witness from a signature
+utxoWitness :: ByteString -> TxWitness
+utxoWitness bytes = TxWitness $ BL.toStrict $ runPut $ do
+    putTxWitnessTag TxWitnessUTxO
+    putByteString bytes
+
+-- | Construct a legacy UTxO witness from a public key and a signature
+legacyUtxoWitness :: XPub -> ByteString -> TxWitness
+legacyUtxoWitness xpub bytes = TxWitness $ BL.toStrict $ runPut $ do
+    putTxWitnessTag TxWitnessLegacyUTxO
+    putByteString (unXPub xpub)
+    putByteString bytes
+
 -- | Decode the contents of a @Transaction@-message.
 getTransaction :: Int -> Get (Tx, [TxWitness])
 getTransaction n = label "getTransaction" $ do
@@ -319,20 +358,12 @@ getTransaction n = label "getTransaction" $ do
   where
     getWitness :: Get TxWitness
     getWitness = do
-        tag <- getTxWitnessTag
-        let len = txWitnessSize tag
+        tag <- lookAhead getTxWitnessTag
+        let len = txWitnessSize tag + txWitnessTagSize
         -- NOTE: Regardless of the type of witness, we decode it as a
         -- @TxWitness@.
         TxWitness <$> isolate len (getByteString len)
 
-    getTxWitnessTag :: Get TxWitnessTag
-    getTxWitnessTag = getWord8 >>= \case
-        0 -> pure TxWitnessLegacyUTxO
-        1 -> pure TxWitnessUTxO
-        2 -> pure TxWitnessAccount
-        3 -> pure TxWitnessMultisig
-        other -> fail $ "Invalid witness type: " ++ show other
-
     getTokenTransfer :: Get ([(TxIn, Coin)], [TxOut])
     getTokenTransfer = label "getTokenTransfer" $ do
         inCount <- fromIntegral <$> getWord8
@@ -362,9 +393,7 @@ putSignedTx inputs outputs witnesses = do
   where
     -- Assumes the `TxWitness` has been faithfully constructed
     putWitness :: TxWitness -> Put
-    putWitness (TxWitness bytes) = do
-        putWord8 1
-        putByteString bytes
+    putWitness (TxWitness bytes) = putByteString bytes
 
 putTx :: [(TxIn, Coin)] -> [TxOut] -> Put
 putTx inputs outputs = do
@@ -601,7 +630,7 @@ estimateMaxNumberOfInputsParams = EstimateMaxNumberOfInputsParams
     , estBlockHashSize = 32
 
     -- The length of the smallest type of witness.
-    , estTxWitnessSize = txWitnessSize TxWitnessUTxO
+    , estTxWitnessSize = txWitnessSize TxWitnessUTxO + txWitnessTagSize
     }
 
 -- | Jörmungandr distinguish 'fragment id' (what we commonly call 'txId')
@@ -652,7 +681,7 @@ convertBlockHeader h = (W.BlockHeader (slot h) (bh h) (Hash "") (Hash ""))
     bh = Quantity . fromIntegral . chainLength
 
 {-------------------------------------------------------------------------------
-                              Legacy Decoders
+                                    Legacy
 -------------------------------------------------------------------------------}
 
 -- | Attempt decoding a 'ByteString' into an 'Address'. This merely checks that

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs
@@ -10,6 +10,7 @@
 module Cardano.Wallet.Jormungandr.Transaction
     ( newTransactionLayer
     , sign
+    , mkTxWitness
     , ErrExceededInpsOrOuts (..)
     ) where
 
@@ -19,17 +20,23 @@ import Cardano.Wallet.Jormungandr.Binary
     ( Message (..)
     , fragmentId
     , getMessage
+    , legacyUtxoWitness
     , maxNumberOfInputs
     , maxNumberOfOutputs
     , runGetOrFail
     , signData
+    , utxoWitness
     )
 import Cardano.Wallet.Jormungandr.Compatibility
     ( Jormungandr )
 import Cardano.Wallet.Jormungandr.Primitive.Types
     ( Tx (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (AddressK), KeyToAddress, Passphrase (..), WalletKey (..), XPrv )
+import Cardano.Wallet.Primitive.AddressDerivation.Random
+    ( RndKey )
+import Cardano.Wallet.Primitive.AddressDerivation.Sequential
+    ( SeqKey )
 import Cardano.Wallet.Primitive.CoinSelection
     ( CoinSelection (..) )
 import Cardano.Wallet.Primitive.Types
@@ -65,20 +72,22 @@ newTransactionLayer
     :: forall n k t.
         ( t ~ Jormungandr n
         , KeyToAddress (Jormungandr n) k
+        , MkTxWitness k
         )
     => Hash "Genesis"
     -> TransactionLayer t k
-newTransactionLayer (Hash block0) = TransactionLayer
+newTransactionLayer (Hash block0H) = TransactionLayer
     { mkStdTx = \keyFrom rnps outs -> do
         -- NOTE
         -- For signing, we need to embed a hash of the transaction data
         -- without the witnesses (since we don't yet have them!). In this sense,
         -- this is a transaction id as Byron nodes or the http-bridge
         -- defines them.
         let inps = fmap (second coin) rnps
-        let bs = block0 <> getHash (signData inps outs)
-        wits <- forM rnps $ \(_, TxOut addr _) -> sign bs
-            <$> maybeToRight (ErrKeyNotFoundForAddress addr) (keyFrom addr)
+        wits <- forM rnps $ \(_, TxOut addr _) -> do
+            xprv <- maybeToRight (ErrKeyNotFoundForAddress addr) (keyFrom addr)
+            let payload = block0H <> getHash (signData inps outs)
+            pure $ mkTxWitness (fst xprv) (sign payload xprv)
         let tx = Tx
                 { txid = fragmentId inps outs wits
                 , inputs = inps
@@ -109,13 +118,40 @@ newTransactionLayer (Hash block0) = TransactionLayer
             $ Left ErrExceededInpsOrOuts
     }
 
+-- | Provide a transaction witness for a given private key. The type of witness
+-- is different between types of keys and, with backward-compatible support, we
+-- need to support many types for one backend target.
+--
+-- We have tightly coupled the type of witness to the type of key for because:
+--
+-- - RndKey can only be used with legacy / Byron wallets as they require a
+--   special address structure (to embed the derivation path).
+--
+-- - SeqKey could theorically be used with the legacy address structure (as
+-- Yoroi does) however, our implementation only associate SeqKey to new
+-- addresses.
+class MkTxWitness (k :: Depth -> * -> *) where
+    mkTxWitness
+        :: k 'AddressK XPrv
+        -> ByteString
+        -> TxWitness
+
+instance MkTxWitness SeqKey where
+    mkTxWitness _ = utxoWitness
+
+instance MkTxWitness RndKey where
+    mkTxWitness xprv = legacyUtxoWitness xpub
+      where
+        xpub = getRawKey $ publicKey xprv
+
+-- | Sign some arbitrary binary data using a private key.
 sign
     :: WalletKey k
     => ByteString
     -> (k 'AddressK XPrv, Passphrase "encryption")
-    -> TxWitness
+    -> ByteString
 sign bytes (key, (Passphrase pwd)) =
-    TxWitness . CC.unXSignature $ CC.sign pwd (getRawKey key) bytes
+    CC.unXSignature $ CC.sign pwd (getRawKey key) bytes
 
 -- | Transaction with improper number of inputs and outputs is tried
 data ErrExceededInpsOrOuts = ErrExceededInpsOrOuts

diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
@@ -17,7 +17,15 @@ import Cardano.BM.Trace
 import Cardano.Wallet.Jormungandr.Api
     ( GetTipId, api )
 import Cardano.Wallet.Jormungandr.Binary
-    ( MessageType (..), fragmentId, putSignedTx, runPut, withHeader )
+    ( MessageType (..)
+    , TxWitnessTag (..)
+    , fragmentId
+    , putSignedTx
+    , putTxWitnessTag
+    , runPut
+    , txWitnessSize
+    , withHeader
+    )
 import Cardano.Wallet.Jormungandr.Compatibility
     ( Jormungandr, Network (..) )
 import Cardano.Wallet.Jormungandr.Network
@@ -348,7 +356,7 @@ spec = do
         either throwIO (\_ -> return ()) e
 
     pkWitness :: TxWitness
-    pkWitness = TxWitness $ BS.pack $ replicate 64 3
+    pkWitness = TxWitness $ BS.pack $ [1] <> replicate 64 3
 
     proxy :: Proxy (Jormungandr 'Mainnet)
     proxy = Proxy
@@ -451,8 +459,8 @@ instance Arbitrary SignedTx where
 
 -- | Only generates single address witnesses
 instance Arbitrary TxWitness where
-    arbitrary = TxWitness <$> genFixed 64
-    shrink (TxWitness bytes) = TxWitness <$> shrinkFixedBS bytes
+    arbitrary = taggedWitness TxWitnessUTxO . TxWitness
+        <$> genFixed (txWitnessSize TxWitnessUTxO)
 
 instance Arbitrary (Hash "Tx") where
     arbitrary = Hash <$> genFixed 32
@@ -502,6 +510,11 @@ shrinkFixedBS bs = [zeros | bs /= zeros]
 prependTag :: Int -> ByteString -> ByteString
 prependTag tag bs = BS.pack [fromIntegral tag] <> bs
 
+taggedWitness :: TxWitnessTag -> TxWitness -> TxWitness
+taggedWitness tag (TxWitness bytes) = TxWitness (prefix <> bytes)
+  where
+    prefix = BL.toStrict $ runPut $ putTxWitnessTag tag
+
 getRollForward :: NextBlocksResult target block -> Maybe [block]
 getRollForward AwaitReply = Nothing
 getRollForward (RollForward _ _ bs) = Just bs

diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs
@@ -23,15 +23,18 @@ import Cardano.Wallet.Jormungandr.Binary
     , Message (..)
     , MessageType (..)
     , Milli (..)
+    , TxWitnessTag (..)
     , fragmentId
     , getAddress
     , getBlock
     , getMessage
     , putAddress
     , putSignedTx
+    , putTxWitnessTag
     , runGet
     , runPut
     , singleAddressFromKey
+    , txWitnessSize
     , withHeader
     )
 import Cardano.Wallet.Jormungandr.Compatibility
@@ -408,8 +411,13 @@ instance Arbitrary SignedTx where
 
 -- | Only generates single address witnesses
 instance Arbitrary TxWitness where
-    arbitrary = TxWitness <$> genFixed 64
-    shrink (TxWitness bytes) = TxWitness <$> shrinkFixedBS bytes
+    arbitrary = taggedWitness TxWitnessUTxO . TxWitness
+        <$> genFixed (txWitnessSize TxWitnessUTxO)
 
 prependTag :: Int -> ByteString -> ByteString
 prependTag tag bs = BS.pack [fromIntegral tag] <> bs
+
+taggedWitness :: TxWitnessTag -> TxWitness -> TxWitness
+taggedWitness tag (TxWitness bytes) = TxWitness (prefix <> bytes)
+  where
+    prefix = BL.toStrict $ runPut $ putTxWitnessTag tag