From 9561335a69e952095070054bcaadcedf56879253 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 6 Mar 2019 13:57:34 +0100 Subject: [PATCH] Implement txId hash using CBOR encoders - Add CBOR encoders for Tx - Add missing CBOR decoders - Sketch a few golden tests using data from BinarySpec --- cardano-wallet.cabal | 3 + src/Cardano/Wallet/Binary.hs | 117 ++++++++++++++++++++-- src/Cardano/Wallet/Primitive.hs | 24 ----- test/unit/Cardano/Wallet/BinarySpec.hs | 27 ++++- test/unit/Cardano/Wallet/PrimitiveSpec.hs | 21 +--- 5 files changed, 141 insertions(+), 51 deletions(-) diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index b6744f15a2e..433a98a6360 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -36,7 +36,10 @@ library , bytestring , cborg , containers + , cryptonite , deepseq + , digest + , memory , transformers hs-source-dirs: src diff --git a/src/Cardano/Wallet/Binary.hs b/src/Cardano/Wallet/Binary.hs index b0677b23c8d..3342ae762a9 100644 --- a/src/Cardano/Wallet/Binary.hs +++ b/src/Cardano/Wallet/Binary.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} -- | -- Copyright: © 2018-2019 IOHK @@ -16,8 +17,17 @@ -- by components like the Rust . module Cardano.Wallet.Binary - ( decodeBlock + ( + -- * Decoding + decodeBlock , decodeBlockHeader + , decodeTx + + -- * Encoding + , encodeTx + + -- * Hashing + , txId -- * Helpers , inspectNextToken @@ -39,10 +49,16 @@ import Cardano.Wallet.Primitive ) import Control.Monad ( void ) -import qualified Data.ByteString.Lazy as BL +import Crypto.Hash + ( hash ) +import Crypto.Hash.Algorithms + ( Blake2b_256 ) +import Data.ByteString + ( ByteString ) +import Data.Digest.CRC32 + ( crc32 ) import Data.Set ( Set ) -import qualified Data.Set as Set import Data.Word ( Word16, Word64 ) import Debug.Trace @@ -52,8 +68,13 @@ import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Read as CBOR import qualified Codec.CBOR.Write as CBOR +import qualified Data.ByteArray as BA +import qualified Data.ByteString.Lazy as BL +import qualified Data.Set as Set +-- Decoding + decodeAddress :: CBOR.Decoder s Address decodeAddress = do _ <- CBOR.decodeListLenCanonicalOf 2 -- CRC Protection Wrapper @@ -73,6 +94,13 @@ decodeAddress = do <> CBOR.encodeBytes bytes <> CBOR.encodeWord32 crc +decodeAddressPayload :: CBOR.Decoder s ByteString +decodeAddressPayload = do + _ <- CBOR.decodeListLenCanonicalOf 2 + _ <- CBOR.decodeTag + bytes <- CBOR.decodeBytes + _ <- CBOR.decodeWord32 -- CRC + return bytes decodeAttributes :: CBOR.Decoder s ((), CBOR.Encoding) decodeAttributes = do @@ -305,6 +333,16 @@ decodeSignature = do 2 -> decodeProxySignature decodeHeavyIndex _ -> fail $ "decodeSignature: unknown signature constructor: " <> show t +decodeSignedTx :: CBOR.Decoder s Tx +decodeSignedTx = do + _ <- CBOR.decodeListLenCanonicalOf 2 + _ <- CBOR.decodeListLenCanonicalOf 3 + ins <- decodeListIndef decodeTxIn + outs <- decodeListIndef decodeTxOut + _ <- decodeAttributes + _ <- decodeList decodeTxWitness + return $ Tx ins outs + decodeSharesProof :: CBOR.Decoder s () decodeSharesProof = do _ <- CBOR.decodeBytes -- Shares Hash @@ -327,16 +365,14 @@ decodeSoftwareVersion = do decodeTx :: CBOR.Decoder s Tx decodeTx = do - _ <- CBOR.decodeListLenCanonicalOf 2 _ <- CBOR.decodeListLenCanonicalOf 3 ins <- decodeListIndef decodeTxIn outs <- decodeListIndef decodeTxOut _ <- decodeAttributes - _ <- decodeList decodeTxWitness return $ Tx ins outs decodeTxPayload :: CBOR.Decoder s (Set Tx) -decodeTxPayload = Set.fromList <$> decodeListIndef decodeTx +decodeTxPayload = Set.fromList <$> decodeListIndef decodeSignedTx {-# ANN decodeTxIn ("HLint: ignore Use <$>" :: String) #-} decodeTxIn :: CBOR.Decoder s TxIn @@ -391,6 +427,65 @@ decodeUpdateProof = do return () +-- * Encoding + +encodeAddressPayload :: ByteString -> CBOR.Encoding +encodeAddressPayload payload = mempty + <> CBOR.encodeListLen 2 + <> CBOR.encodeTag 24 -- Hard-Coded Tag value in cardano-sl + <> CBOR.encodeBytes payload + <> CBOR.encodeWord32 (crc32 payload) + +encodeTx :: Tx -> CBOR.Encoding +encodeTx tx = mempty + <> CBOR.encodeListLen 3 + <> CBOR.encodeListLenIndef + <> mconcat (encodeTxIn <$> inputs tx) + <> CBOR.encodeBreak + <> CBOR.encodeListLenIndef + <> mconcat (encodeTxOut <$> outputs tx) + <> CBOR.encodeBreak + <> encodeTxAttributes + +encodeTxAttributes :: CBOR.Encoding +encodeTxAttributes = mempty + <> CBOR.encodeMapLen 0 + +encodeTxIn :: TxIn -> CBOR.Encoding +encodeTxIn (TxIn (Hash txid) ix) = mempty + <> CBOR.encodeListLen 2 + <> CBOR.encodeWord8 0 + <> CBOR.encodeTag 24 -- Hard-coded Tag value in cardano-sl + <> CBOR.encodeBytes bytes + where + bytes = CBOR.toStrictByteString $ mempty + <> CBOR.encodeListLen 2 + <> CBOR.encodeBytes txid + <> CBOR.encodeWord32 ix + +encodeTxOut :: TxOut -> CBOR.Encoding +encodeTxOut (TxOut (Address addr) (Coin c)) = mempty + <> CBOR.encodeListLen 2 + <> encodeAddressPayload payload + <> CBOR.encodeWord64 c + where + invariant = + error $ "encodeTxOut: unable to decode address payload: " <> show addr + payload = + either (const invariant) snd $ CBOR.deserialiseFromBytes + decodeAddressPayload + (BL.fromStrict addr) + +-- * Hashing + +-- | Compute a transaction id; assumed to be effectively injective. +-- It returns an hex-encoded 64-byte hash. +-- +-- NOTE: This is a rather expensive operation +txId :: Tx -> Hash "Tx" +txId = blake2b256 . encodeTx + + -- * Helpers -- | Inspect the next token that has to be decoded and print it to the console @@ -435,3 +530,13 @@ decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a] decodeListIndef decodeOne = do _ <- CBOR.decodeListLenIndef CBOR.decodeSequenceLenIndef (flip (:)) [] reverse decodeOne + +-- | Encode a value to a corresponding Hash. +-- +-- @ +-- txId :: Tx -> Hash "Tx" +-- txId = blake2b256 . encodeTx +-- @ +blake2b256 :: forall tag. CBOR.Encoding -> Hash tag +blake2b256 = + Hash . BA.convert . hash @_ @Blake2b_256 . CBOR.toStrictByteString diff --git a/src/Cardano/Wallet/Primitive.hs b/src/Cardano/Wallet/Primitive.hs index 58630900a57..db9f08975ae 100644 --- a/src/Cardano/Wallet/Primitive.hs +++ b/src/Cardano/Wallet/Primitive.hs @@ -27,7 +27,6 @@ module Cardano.Wallet.Primitive , Tx(..) , TxIn(..) , TxOut(..) - , txId , txIns , txOutsOurs , updatePending @@ -43,8 +42,6 @@ module Cardano.Wallet.Primitive -- * UTxO , UTxO (..) , balance - , changeUTxO - , utxoFromTx , excluding , isSubsetOf , restrictedBy @@ -123,12 +120,6 @@ data Tx = Tx instance NFData Tx --- | Calculating a transaction id. Assumed to be effectively injective -txId :: Tx -> Hash "Tx" -txId = error - "txId: not yet implemented. We need the ability to encode a Tx to CBOR for:\ - \ BA.convert . hash @_ @Blake2b_256 . CBOR.toStrictByteString . encodeTx" - txIns :: Set Tx -> Set TxIn txIns = foldMap (Set.fromList . inputs) @@ -237,21 +228,6 @@ balance :: UTxO -> Integer balance = Map.foldl' (\total out -> total + fromIntegral (getCoin (coin out))) 0 . getUTxO -utxoFromTx :: Tx -> UTxO -utxoFromTx tx@(Tx _ outs) = - UTxO $ Map.fromList $ zip (TxIn (txId tx) <$> [0..]) outs - -changeUTxO - :: IsOurs s - => Set Tx - -> s - -> (UTxO, s) -changeUTxO pending = runState $ do - ours <- state $ txOutsOurs pending - let utxo = foldMap utxoFromTx pending - let ins = txIns pending - return $ (utxo `restrictedTo` ours) `restrictedBy` ins - -- ins⋪ u excluding :: UTxO -> Set TxIn -> UTxO excluding (UTxO utxo) = diff --git a/test/unit/Cardano/Wallet/BinarySpec.hs b/test/unit/Cardano/Wallet/BinarySpec.hs index 18caf858f7c..4e9b40655e5 100644 --- a/test/unit/Cardano/Wallet/BinarySpec.hs +++ b/test/unit/Cardano/Wallet/BinarySpec.hs @@ -10,7 +10,7 @@ module Cardano.Wallet.BinarySpec import Prelude import Cardano.Wallet.Binary - ( decodeBlock, decodeBlockHeader ) + ( decodeBlock, decodeBlockHeader, decodeTx, encodeTx, txId ) import Cardano.Wallet.Primitive ( Address (..) , Block (..) @@ -32,11 +32,13 @@ import Test.Hspec import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Read as CBOR +import qualified Codec.CBOR.Write as CBOR import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as L8 import qualified Data.Set as Set +{-# ANN spec ("HLint: ignore Use head" :: String) #-} spec :: Spec spec = do describe "Decoding blocks" $ do @@ -60,6 +62,29 @@ spec = do let decoded = unsafeDeserialiseFromBytes decodeBlock bs decoded `shouldBe` block3 + describe "Encoding Tx" $ do + let txs = Set.toList (transactions block2 <> transactions block3) + let roundTripTx tx = do + let bytes = CBOR.toLazyByteString (encodeTx tx) + let tx' = unsafeDeserialiseFromBytes decodeTx bytes + tx `shouldBe` tx' + + it "encode . decode = pure (1)" $ do + roundTripTx (txs !! 0) + + it "encode . decode = pure (2)" $ do + roundTripTx (txs !! 1) + + it "should compute correct txId (1)" $ do + let hash = txId (txs !! 0) + let hash' = hash16 "c470563001e448e61ff1268c2a6eb458ace1d04011a02cb262b6d709d66c23d0" + hash `shouldBe` hash' + + it "should compute correct txId (2)" $ do + let hash = txId (txs !! 1) + let hash' = hash16 "d30d37f1f8674c6c33052826fdc5bc198e3e95c150364fd775d4bc663ae6a9e6" + hash `shouldBe` hash' + -- A mainnet block header blockHeader1 :: BlockHeader diff --git a/test/unit/Cardano/Wallet/PrimitiveSpec.hs b/test/unit/Cardano/Wallet/PrimitiveSpec.hs index 60aa1b45aae..b49d9376f46 100644 --- a/test/unit/Cardano/Wallet/PrimitiveSpec.hs +++ b/test/unit/Cardano/Wallet/PrimitiveSpec.hs @@ -26,12 +26,11 @@ import Cardano.Wallet.Primitive , restrictedBy , restrictedTo , updatePending - , utxoFromTx ) import Data.Set ( Set, (\\) ) import Test.Hspec - ( Spec, describe, it, pendingWith ) + ( Spec, describe, it ) import Test.QuickCheck ( Arbitrary (..) , Property @@ -40,7 +39,6 @@ import Test.QuickCheck , cover , oneof , property - , quickCheck , scale , vectorOf , (===) @@ -85,11 +83,6 @@ spec = do it "3.3) updatePending b pending ⊆ pending" (checkCoverage prop_3_2) - describe "Miscellaneous properties" $ do - it "utxoFromTx preserve number of outputs" $ do - pendingWith "Need txId to be implemented first" - quickCheck $ checkCoverage prop_utxoFromTx - {------------------------------------------------------------------------------- Wallet Specification - Lemma 2.1 - Properties of UTxO operations @@ -217,18 +210,6 @@ prop_3_2 (b, pending) = prop = updatePending b pending `Set.isSubsetOf` pending -{------------------------------------------------------------------------------- - Miscellaneous Properties --------------------------------------------------------------------------------} - -prop_utxoFromTx :: Tx -> Property -prop_utxoFromTx tx = - cover 50 cond "outputs tx ≠ ∅ " (property prop) - where - cond = not $ null $ outputs tx - prop = Map.size (getUTxO $ utxoFromTx tx) === length (outputs tx) - - {------------------------------------------------------------------------------- Arbitrary Instances