From b31abd3fd211ec047983ffbbb67ae5a4c5d06c5c Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 6 Mar 2019 14:33:56 +0100 Subject: [PATCH] implement txId using CBOR encoders --- cardano-wallet.cabal | 2 ++ src/Cardano/Wallet/Binary.hs | 28 ++++++++++++++++-- src/Cardano/Wallet/Primitive.hs | 4 +-- test/unit/Cardano/Wallet/BinarySpec.hs | 39 +++++++++++++++++++++----- 4 files changed, 61 insertions(+), 12 deletions(-) diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 4d6bc380754..c4aa3e9799f 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -35,8 +35,10 @@ library , bytestring , cborg , containers + , cryptonite , deepseq , digest + , memory hs-source-dirs: src exposed-modules: diff --git a/src/Cardano/Wallet/Binary.hs b/src/Cardano/Wallet/Binary.hs index 6a1e1f2797f..1857c4af9e3 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,9 +17,11 @@ module Cardano.Wallet.Binary -- * Decoding decodeBlock , decodeBlockHeader + , decodeTx -- * Encoding , encodeTx + , txId -- * Helpers , inspectNextToken @@ -40,6 +43,10 @@ import Cardano.Wallet.Primitive ) import Control.Monad ( void ) +import Crypto.Hash + ( hash ) +import Crypto.Hash.Algorithms + ( Blake2b_256 ) import Data.ByteString ( ByteString ) import Data.Digest.CRC32 @@ -55,6 +62,7 @@ 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 @@ -319,6 +327,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 @@ -341,16 +359,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 @@ -407,6 +423,12 @@ decodeUpdateProof = do -- * Encoding +-- | Compute a transaction id; assumed to be effectively injective. +-- It returns an hex-encoded 64-byte hash. +txId :: Tx -> Hash "Tx" +txId = + Hash . BA.convert . hash @_ @Blake2b_256 . CBOR.toStrictByteString . encodeTx + encodeAddressPayload :: ByteString -> CBOR.Encoding encodeAddressPayload payload = mempty <> CBOR.encodeListLen 2 diff --git a/src/Cardano/Wallet/Primitive.hs b/src/Cardano/Wallet/Primitive.hs index b6b85813b5c..017792ea8ac 100644 --- a/src/Cardano/Wallet/Primitive.hs +++ b/src/Cardano/Wallet/Primitive.hs @@ -107,9 +107,9 @@ instance NFData Tx data TxIn = TxIn - { txId + { inputId :: !(Hash "Tx") - , txIx + , inputIx :: !Word32 } deriving (Show, Generic, Eq, Ord) diff --git a/test/unit/Cardano/Wallet/BinarySpec.hs b/test/unit/Cardano/Wallet/BinarySpec.hs index e1bc4b3d357..171ecb9c77d 100644 --- a/test/unit/Cardano/Wallet/BinarySpec.hs +++ b/test/unit/Cardano/Wallet/BinarySpec.hs @@ -5,7 +5,7 @@ module Cardano.Wallet.BinarySpec (spec) where import Prelude import Cardano.Wallet.Binary - ( decodeBlock, decodeBlockHeader ) + ( decodeBlock, decodeBlockHeader, decodeTx, encodeTx, txId ) import Cardano.Wallet.Primitive ( Address (..) , Block (..) @@ -27,11 +27,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 @@ -55,6 +57,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 @@ -87,8 +112,8 @@ block2 = Block [ Tx { inputs = [ TxIn - { txId = hash16 "60dbb2679ee920540c18195a3d92ee9be50aee6ed5f891d92d51db8a76b02cd2" - , txIx = 3 + { inputId = hash16 "60dbb2679ee920540c18195a3d92ee9be50aee6ed5f891d92d51db8a76b02cd2" + , inputIx = 3 } ] , outputs = @@ -117,11 +142,11 @@ block3 = Block [ Tx { inputs = [ TxIn - { txId = hash16 "6967e2b5c3ad5ae07a9bd8d888f1836195a04f7a1cb4b6d083261870068fab1b" - , txIx = 1} + { inputId = hash16 "6967e2b5c3ad5ae07a9bd8d888f1836195a04f7a1cb4b6d083261870068fab1b" + , inputIx = 1} , TxIn - { txId = hash16 "7064addc0968bccd7d57d2e7aa1e9c2f666d8387042483fc1e87200cfb96c8f1" - , txIx = 0} ] + { inputId = hash16 "7064addc0968bccd7d57d2e7aa1e9c2f666d8387042483fc1e87200cfb96c8f1" + , inputIx = 0} ] , outputs = [ TxOut { address = addr58 "37btjrVyb4KBsw2f3V76ntfwqDPgyf3QmmdsrTSmCnuTGYtS9JgVXzxeQEsKjgWurKoyw9BDNEtLxWtU9znK49SC8bLTirk6YqcAESFxXJkSyXhQKL"