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/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs index d98f36b2d1f..a8430db43e7 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Wallet.Jormungandr.Transaction ( newTransactionLayer @@ -7,13 +9,63 @@ 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 + ( 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 - { mkStdTx = error "TODO: See http-bridge as starting point" - , estimateSize = error "TODO: See http-bridge as starting point" +newTransactionLayer + :: 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 witData = witnessUtxoData block0Hash (txId @(Jormungandr n) tx) + txWitnesses <- forM inps $ \(_in, TxOut addr _c) -> mkWitness witData + <$> 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 + + witnessUtxoData :: Hash "Block0Hash" -> Hash "Tx" -> WitnessData + witnessUtxoData (Hash block0) (Hash tx) = WitnessData (block0 <> tx) + + mkWitness + :: WitnessData + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> TxWitness + 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 + :: ByteString + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> Hash "signature" + sign contents (key, (Passphrase pwd)) = + Hash . CC.unXSignature $ CC.sign pwd (getKey key) contents + +newtype WitnessData = WitnessData ByteString 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..21e9797ed50 --- /dev/null +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.Jormungandr.TransactionSpec + ( spec + ) where + +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 + 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 + 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 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))