From 6ceabd30407364727b4199eeec335897ed19be4e Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Wed, 19 Jun 2019 13:47:17 +0200 Subject: [PATCH 1/5] add initial, non-complete newTransactionLayer --- .../Cardano/Wallet/Jormungandr/Transaction.hs | 68 +++++++++++++++++-- 1 file changed, 64 insertions(+), 4 deletions(-) diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs index d98f36b2d1f..06cef2a8df3 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Wallet.Jormungandr.Transaction ( newTransactionLayer @@ -7,13 +8,72 @@ module Cardano.Wallet.Jormungandr.Transaction import Prelude +import Cardano.Wallet.Jormungandr.Compatibility + ( Jormungandr ) +import Cardano.Wallet.Jormungandr.Environment + ( Network (..) ) +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (AddressK), Key, Passphrase (..), XPrv, XPub, getKey, publicKey ) +import Cardano.Wallet.Primitive.Types + ( Hash (..), Tx (..), TxId (..), TxOut (..), TxWitness (..) ) import Cardano.Wallet.Transaction - ( TransactionLayer (..) ) + ( ErrMkStdTx (..), TransactionLayer (..) ) +import Control.Monad + ( forM ) +import Data.ByteString + ( ByteString ) +import Data.Quantity + ( Quantity (..) ) +import qualified Cardano.Crypto.Wallet as CC -- | Construct a 'TransactionLayer' compatible with Shelley and 'Jörmungandr' -newTransactionLayer :: TransactionLayer t +newTransactionLayer + :: TransactionLayer (Jormungandr 'Testnet) newTransactionLayer = TransactionLayer - { mkStdTx = error "TODO: See http-bridge as starting point" - , estimateSize = error "TODO: See http-bridge as starting point" + { mkStdTx = \keyFrom inps outs -> do + let ins = (fmap fst inps) + let tx = Tx ins outs + let txSigData = txId @(Jormungandr 'Testnet) tx + txWitnesses <- forM inps $ \(_in, TxOut addr _c) -> mkWitness txSigData + <$> withEither (ErrKeyNotFoundForAddress addr) (keyFrom addr) + return (tx, txWitnesses) + + -- NOTE: at this point 'Jörmungandr' node does not support fee calculation + , estimateSize = \_ -> Quantity 0 } + where + withEither :: e -> Maybe a -> Either e a + withEither e = maybe (Left e) Right + + mkWitness + :: Hash "Tx" + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> TxWitness + mkWitness tx (xPrv, pwd) = PublicKeyWitness + (encodeXPub $ publicKey xPrv) + (sign (SignTx tx) (xPrv, pwd)) + + encodeXPub :: (Key level XPub) -> ByteString + encodeXPub = CC.xpubPublicKey . getKey + + sign + :: SignTag + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> Hash "signature" + sign _tag (_key, (Passphrase _pwd)) = undefined + +-- | To protect agains replay attacks (i.e. when an attacker intercepts a +-- signed piece of data and later sends it again), we add a tag to all data +-- that we sign. This ensures that even if some bytestring can be +-- deserialized into two different types of messages (A and B), the attacker +-- can't take message A and send it as message B. +-- +-- We also automatically add the network tag ('protocolMagic') whenever it +-- makes sense, to ensure that things intended for testnet won't work for +-- mainnet. +-- +-- The wallet only cares about the 'SignTx' tag. In 'cardano-sl' there was +-- a lot more cases. +newtype SignTag + = SignTx (Hash "Tx") From 1a0ac5e6db30aeb21cc540fd35693c3e665a0710 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Wed, 19 Jun 2019 14:41:41 +0200 Subject: [PATCH 2/5] pick up Johannes signing implementation from other PR --- .../Cardano/Wallet/Jormungandr/Transaction.hs | 53 ++++++++----------- 1 file changed, 22 insertions(+), 31 deletions(-) diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs index 06cef2a8df3..abd3d1d1a3f 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Cardano.Wallet.Jormungandr.Transaction @@ -9,11 +10,8 @@ module Cardano.Wallet.Jormungandr.Transaction import Prelude import Cardano.Wallet.Jormungandr.Compatibility - ( Jormungandr ) -import Cardano.Wallet.Jormungandr.Environment - ( Network (..) ) import Cardano.Wallet.Primitive.AddressDerivation - ( Depth (AddressK), Key, Passphrase (..), XPrv, XPub, getKey, publicKey ) + ( Depth (AddressK), Key, Passphrase (..), XPrv, getKey ) import Cardano.Wallet.Primitive.Types ( Hash (..), Tx (..), TxId (..), TxOut (..), TxWitness (..) ) import Cardano.Wallet.Transaction @@ -29,13 +27,14 @@ import qualified Cardano.Crypto.Wallet as CC -- | Construct a 'TransactionLayer' compatible with Shelley and 'Jörmungandr' newTransactionLayer - :: TransactionLayer (Jormungandr 'Testnet) -newTransactionLayer = TransactionLayer + :: forall n . Hash "Block0Hash" + -> TransactionLayer (Jormungandr n) +newTransactionLayer block0Hash = TransactionLayer { mkStdTx = \keyFrom inps outs -> do let ins = (fmap fst inps) let tx = Tx ins outs - let txSigData = txId @(Jormungandr 'Testnet) tx - txWitnesses <- forM inps $ \(_in, TxOut addr _c) -> mkWitness txSigData + let witData = witnessUtxoData block0Hash (txId @(Jormungandr n) tx) + txWitnesses <- forM inps $ \(_in, TxOut addr _c) -> mkWitness witData <$> withEither (ErrKeyNotFoundForAddress addr) (keyFrom addr) return (tx, txWitnesses) @@ -46,34 +45,26 @@ newTransactionLayer = TransactionLayer withEither :: e -> Maybe a -> Either e a withEither e = maybe (Left e) Right + witnessUtxoData :: Hash "Block0Hash" -> Hash "Tx" -> WitnessData + witnessUtxoData (Hash block0) (Hash tx) = WitnessData (block0 <> tx) + mkWitness - :: Hash "Tx" + :: WitnessData -> (Key 'AddressK XPrv, Passphrase "encryption") -> TxWitness - mkWitness tx (xPrv, pwd) = PublicKeyWitness - (encodeXPub $ publicKey xPrv) - (sign (SignTx tx) (xPrv, pwd)) - - encodeXPub :: (Key level XPub) -> ByteString - encodeXPub = CC.xpubPublicKey . getKey + mkWitness (WitnessData dat) (xPrv, pwd) = + let + -- We can't easily modify the TxWitness type. This is a temporary solution + -- before we can decide on better abstractions. We might want to have + -- different witness types for Jormungandr and http-bridge. + dummyXPub = error "The witness xPub should not be used for the new scheme." + in PublicKeyWitness dummyXPub $ sign dat (xPrv, pwd) sign - :: SignTag + :: ByteString -> (Key 'AddressK XPrv, Passphrase "encryption") -> Hash "signature" - sign _tag (_key, (Passphrase _pwd)) = undefined + sign contents (key, (Passphrase pwd)) = + Hash . CC.unXSignature $ CC.sign pwd (getKey key) contents --- | To protect agains replay attacks (i.e. when an attacker intercepts a --- signed piece of data and later sends it again), we add a tag to all data --- that we sign. This ensures that even if some bytestring can be --- deserialized into two different types of messages (A and B), the attacker --- can't take message A and send it as message B. --- --- We also automatically add the network tag ('protocolMagic') whenever it --- makes sense, to ensure that things intended for testnet won't work for --- mainnet. --- --- The wallet only cares about the 'SignTx' tag. In 'cardano-sl' there was --- a lot more cases. -newtype SignTag - = SignTx (Hash "Tx") +newtype WitnessData = WitnessData ByteString From 6803fe0888aafa87ac6867289e42146ad4382a15 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Wed, 19 Jun 2019 14:42:21 +0200 Subject: [PATCH 3/5] test estimateSize --- .../Wallet/Jormungandr/TransactionSpec.hs | 42 +++++++++++++++++++ 1 file changed, 42 insertions(+) create mode 100644 lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs new file mode 100644 index 00000000000..75316d8832c --- /dev/null +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.Jormungandr.TransactionSpec + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Jormungandr.Environment + ( KnownNetwork (..), Network (..) ) + +spec :: Spec +spec = do + describe "estimateSize" $ do + it "Estimated size is zero" + (withMaxSuccess 2500 $ property $ propSizeEstimation $ Proxy @'Mainnet) + it "Estimated size is zero" + (withMaxSuccess 2500 $ property $ propSizeEstimation $ Proxy @'Testnet) + +{------------------------------------------------------------------------------- + Size Estimation +-------------------------------------------------------------------------------} + +propSizeEstimation + :: forall n. (KnownNetwork n) + => Proxy n + -> (ShowFmt CoinSelection) + -> Property +propSizeEstimation _ (ShowFmt sel) = + let + calcSize = estimateSize (newTransactionLayer @n) sel + in calcSize `shouldBe` Quantity 0 From d2a28f15ce92daf5b8a2f9d1c110096a8faec616 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Wed, 19 Jun 2019 15:39:08 +0200 Subject: [PATCH 4/5] add estimatedSize test --- .../Cardano/Wallet/Jormungandr/Transaction.hs | 1 + .../Wallet/Jormungandr/TransactionSpec.hs | 137 +++++++++++++++++- 2 files changed, 136 insertions(+), 2 deletions(-) diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs index abd3d1d1a3f..a8430db43e7 100644 --- 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 import Prelude import Cardano.Wallet.Jormungandr.Compatibility + ( Jormungandr ) import Cardano.Wallet.Primitive.AddressDerivation ( Depth (AddressK), Key, Passphrase (..), XPrv, getKey ) import Cardano.Wallet.Primitive.Types diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs index 75316d8832c..930dd5ea240 100644 --- a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs @@ -16,8 +16,55 @@ module Cardano.Wallet.Jormungandr.TransactionSpec import Prelude +import Cardano.Wallet.Jormungandr.Compatibility + ( Jormungandr ) import Cardano.Wallet.Jormungandr.Environment ( KnownNetwork (..), Network (..) ) +import Cardano.Wallet.Jormungandr.Transaction + ( newTransactionLayer ) +import Cardano.Wallet.Primitive.CoinSelection + ( CoinSelection (..) ) +import Cardano.Wallet.Primitive.CoinSelection.LargestFirst + ( largestFirst ) +import Cardano.Wallet.Primitive.Types + ( Address (..) + , Coin (..) + , Hash (..) + , ShowFmt (..) + , TxIn (..) + , TxOut (..) + , UTxO (..) + ) +import Cardano.Wallet.Transaction + ( TransactionLayer (..) ) +import Control.Monad.Trans.Except + ( runExceptT ) +import Data.Functor.Identity + ( Identity (runIdentity) ) +import Data.List.NonEmpty + ( NonEmpty ) +import Data.Proxy + ( Proxy (..) ) +import Data.Quantity + ( Quantity (..) ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , Gen + , Property + , choose + , property + , scale + , vectorOf + , withMaxSuccess + , (===) + ) + +import qualified Cardano.Wallet.Primitive.CoinSelection as CS +import qualified Data.ByteString as BS +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as Map spec :: Spec spec = do @@ -38,5 +85,91 @@ propSizeEstimation -> Property propSizeEstimation _ (ShowFmt sel) = let - calcSize = estimateSize (newTransactionLayer @n) sel - in calcSize `shouldBe` Quantity 0 + blockHash = + Hash {getHash = "\216OY\rX\199\234\188. + [] + _ -> + let + inps' = take (max 1 (length inps `div` 2)) inps + outs' = take (max 1 (length outs `div` 2)) outs + chgs' = take (length chgs `div` 2) chgs + inps'' = if length inps > 1 then drop 1 inps else inps + outs'' = if length outs > 1 then drop 1 outs else outs + chgs'' = drop 1 chgs + in + filter (\s -> s /= sel && isValidSelection s) + [ CoinSelection inps' outs' chgs' + , CoinSelection inps' outs chgs + , CoinSelection inps outs chgs' + , CoinSelection inps outs' chgs + , CoinSelection inps'' outs'' chgs'' + , CoinSelection inps'' outs chgs + , CoinSelection inps outs'' chgs + , CoinSelection inps outs chgs'' + ] + arbitrary = do + outs <- choose (1, 10) + >>= \n -> vectorOf n arbitrary + >>= genTxOut + genSelection (NE.fromList outs) + +deriving instance Arbitrary a => Arbitrary (ShowFmt a) + +-- Check whether a selection is valid +isValidSelection :: CoinSelection -> Bool +isValidSelection (CoinSelection i o c) = + let + oAmt = sum $ map (fromIntegral . getCoin . coin) o + cAmt = sum $ map (fromIntegral . getCoin) c + iAmt = sum $ map (fromIntegral . getCoin . coin . snd) i + in + (iAmt :: Integer) >= (oAmt + cAmt) + +genTxOut :: [Coin] -> Gen [TxOut] +genTxOut coins = do + let n = length coins + outs <- vectorOf n arbitrary + return $ zipWith TxOut outs coins + +genSelection :: NonEmpty TxOut -> Gen CoinSelection +genSelection outs = do + let opts = CS.CoinSelectionOptions 100 + utxo <- vectorOf (NE.length outs * 3) arbitrary >>= genUTxO + case runIdentity $ runExceptT $ largestFirst opts outs utxo of + Left _ -> genSelection outs + Right (s,_) -> return s + +genUTxO :: [Coin] -> Gen UTxO +genUTxO coins = do + let n = length coins + inps <- vectorOf n arbitrary + outs <- genTxOut coins + return $ UTxO $ Map.fromList $ zip inps outs + +instance Arbitrary Coin where + shrink (Coin c) = Coin <$> shrink (fromIntegral c) + arbitrary = Coin <$> choose (1, 200000) + +instance Arbitrary Address where + shrink _ = [] + arbitrary = + pure $ Address "\131\&3$\195xi\193\"h\154\&5\145}\245:O\"\148\163\165/h^\ENQ\245\248\229;\135\231\234E/" + +instance Arbitrary TxIn where + shrink _ = [] + arbitrary = TxIn + <$> arbitrary + <*> scale (`mod` 3) arbitrary -- No need for a high indexes + +instance Arbitrary (Hash "Tx") where + shrink _ = [] + arbitrary = do + bytes <- BS.pack <$> vectorOf 32 arbitrary + pure $ Hash bytes From 8bed61220b0fd53253d1f3a2d1a437cd81af9a70 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Wed, 19 Jun 2019 15:39:34 +0200 Subject: [PATCH 5/5] take care of cabal and nix hlint --- lib/jormungandr/cardano-wallet-jormungandr.cabal | 3 +++ .../test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs | 2 -- nix/.stack.nix/cardano-wallet-jormungandr.nix | 2 ++ 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index c3bce9d3dd3..2e4c5581280 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -78,6 +78,7 @@ test-suite unit , cardano-wallet-core , cardano-crypto , cardano-wallet-jormungandr + , containers , generic-arbitrary , generic-lens , hspec @@ -85,6 +86,7 @@ test-suite unit , QuickCheck , text , text-class + , transformers build-tools: hspec-discover type: @@ -97,6 +99,7 @@ test-suite unit Cardano.Wallet.Jormungandr.BinarySpec Cardano.Wallet.Jormungandr.EnvironmentSpec Cardano.Wallet.Jormungandr.CompatibilitySpec + Cardano.Wallet.Jormungandr.TransactionSpec test-suite integration default-language: diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs index 930dd5ea240..21e9797ed50 100644 --- a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs @@ -3,10 +3,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} diff --git a/nix/.stack.nix/cardano-wallet-jormungandr.nix b/nix/.stack.nix/cardano-wallet-jormungandr.nix index b26dbdc23a6..8a6a7a1f54e 100644 --- a/nix/.stack.nix/cardano-wallet-jormungandr.nix +++ b/nix/.stack.nix/cardano-wallet-jormungandr.nix @@ -48,6 +48,7 @@ (hsPkgs.cardano-wallet-core) (hsPkgs.cardano-crypto) (hsPkgs.cardano-wallet-jormungandr) + (hsPkgs.containers) (hsPkgs.generic-arbitrary) (hsPkgs.generic-lens) (hsPkgs.hspec) @@ -55,6 +56,7 @@ (hsPkgs.QuickCheck) (hsPkgs.text) (hsPkgs.text-class) + (hsPkgs.transformers) ]; build-tools = [ (hsPkgs.buildPackages.hspec-discover or (pkgs.buildPackages.hspec-discover))