diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 936f0657cb9..b6744f15a2e 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -32,22 +32,18 @@ library ghc-options: -Werror build-depends: base - - -- Hackage Dependencies , binary , bytestring , cborg , containers , deepseq - , text , transformers hs-source-dirs: src exposed-modules: Cardano.Wallet.Binary - , Cardano.Wallet.Binary.Helpers - , Cardano.Wallet.Binary.Packfile - , Cardano.Wallet.Primitive + Cardano.Wallet.Binary.Packfile + Cardano.Wallet.Primitive other-modules: Paths_cardano_wallet @@ -100,7 +96,6 @@ test-suite unit main-is: Main.hs other-modules: - Cardano.Wallet.BinaryHelpers - , Cardano.Wallet.BinarySpec - , Cardano.Wallet.Binary.PackfileSpec - , Cardano.Wallet.PrimitiveSpec + Cardano.Wallet.BinarySpec + Cardano.Wallet.Binary.PackfileSpec + Cardano.Wallet.PrimitiveSpec diff --git a/src/Cardano/Wallet/Binary.hs b/src/Cardano/Wallet/Binary.hs index 3aca9e133ed..b0677b23c8d 100644 --- a/src/Cardano/Wallet/Binary.hs +++ b/src/Cardano/Wallet/Binary.hs @@ -1,36 +1,32 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} --- | These are (partial) CBOR decoders for blocks and block headers. --- Note that we ignore most of the block's and header's content and only --- retrieve the pieces of information relevant to us, wallet (we do assume a --- trusted node and therefore, we needn't to care about verifying signatures and --- blocks themselves). +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- These are (partial) CBOR decoders for blocks and block headers. Note that we +-- ignore most of the block's and header's content and only retrieve the pieces +-- of information relevant to us, wallet (we do assume a trusted node and +-- therefore, we needn't to care about verifying signatures and blocks +-- themselves). +-- +-- The format described in the decoders below are the one used in the Byron era +-- of Cardano and will endure in the first stages of Shelley. They are also used +-- by components like the Rust . module Cardano.Wallet.Binary ( decodeBlock , decodeBlockHeader + + -- * Helpers + , inspectNextToken + , decodeList + , decodeListIndef ) where -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 Control.Monad - ( void ) -import qualified Data.ByteString.Lazy as BL -import Data.Set - ( Set ) -import qualified Data.Set as Set -import Data.Text - ( Text ) -import Data.Word - ( Word16, Word64 ) import Prelude -import Cardano.Wallet.Binary.Helpers - ( decodeList, decodeListIndef ) import Cardano.Wallet.Primitive ( Address (..) , Block (..) @@ -41,8 +37,22 @@ import Cardano.Wallet.Primitive , TxIn (..) , TxOut (..) ) +import Control.Monad + ( void ) +import qualified Data.ByteString.Lazy as BL +import Data.Set + ( Set ) +import qualified Data.Set as Set +import Data.Word + ( Word16, Word64 ) +import Debug.Trace + ( traceShow ) + +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 -{-# ANN module ("HLint: ignore Use <$>" :: Text) #-} decodeAddress :: CBOR.Decoder s Address decodeAddress = do @@ -69,6 +79,7 @@ decodeAttributes = do _ <- CBOR.decodeMapLenCanonical -- Empty map of attributes return ((), CBOR.encodeMapLen 0) +{-# ANN decodeBlock ("HLint: ignore Use <$>" :: String) #-} decodeBlock :: CBOR.Decoder s Block decodeBlock = do CBOR.decodeListLenCanonicalOf 2 @@ -76,7 +87,7 @@ decodeBlock = do case t of 0 -> do -- Genesis Block _ <- CBOR.decodeListLenCanonicalOf 3 - header <- decodeGenesisBlockHeader + h <- decodeGenesisBlockHeader -- NOTE -- We don't decode the body of genesis block because we don't need -- it. Genesis blocks occur at boundaries and contain various pieces @@ -87,14 +98,14 @@ decodeBlock = do -- In theory, we should also: -- -- _ <- decodeGenesisBlockBody - return $ Block header mempty + return $ Block h mempty 1 -> do -- Main Block _ <- CBOR.decodeListLenCanonicalOf 3 - header <- decodeMainBlockHeader - transactions <- decodeMainBlockBody + h <- decodeMainBlockHeader + txs <- decodeMainBlockBody -- _ <- decodeMainExtraData - return $ Block header transactions + return $ Block h txs _ -> do fail $ "decodeBlock: unknown block constructor: " <> show t @@ -144,7 +155,7 @@ decodeGenesisBlockHeader = do _ <- decodeProtocolMagic previous <- decodePreviousBlockHeader _ <- decodeGenesisProof - epochIndex <- decodeGenesisConsensusData + epoch <- decodeGenesisConsensusData _ <- decodeGenesisExtraData -- NOTE -- Careful here, we do return a slot number of 0, which means that if we @@ -152,14 +163,14 @@ decodeGenesisBlockHeader = do -- number of `0`. In practices, when parsing a full epoch, we can discard -- the genesis block entirely and we won't bother about modelling this -- extra complexity at the type-level. That's a bit dodgy though. - return $ BlockHeader epochIndex 0 previous + return $ BlockHeader epoch 0 previous decodeGenesisConsensusData :: CBOR.Decoder s Word64 decodeGenesisConsensusData = do _ <- CBOR.decodeListLenCanonicalOf 2 - epochIndex <- CBOR.decodeWord64 + epoch <- CBOR.decodeWord64 _ <- decodeDifficulty - return epochIndex + return epoch decodeGenesisExtraData :: CBOR.Decoder s () decodeGenesisExtraData = do @@ -205,9 +216,9 @@ decodeMainBlockHeader = do _ <- decodeProtocolMagic previous <- decodePreviousBlockHeader _ <- decodeMainProof - (epochIndex, slotNumber) <- decodeMainConsensusData + (epoch, slot) <- decodeMainConsensusData _ <- decodeMainExtraData - return $ BlockHeader epochIndex slotNumber previous + return $ BlockHeader epoch slot previous decodeMainConsensusData :: CBOR.Decoder s (Word64, Word16) decodeMainConsensusData = do @@ -262,7 +273,7 @@ decodeProtocolMagic = do return () decodeProxySignature - :: (forall s. CBOR.Decoder s ()) + :: (forall x. CBOR.Decoder x ()) -> CBOR.Decoder s () decodeProxySignature decodeIndex = do _ <- CBOR.decodeListLenCanonicalOf 2 @@ -303,9 +314,9 @@ decodeSharesProof = do decodeSlotId :: CBOR.Decoder s (Word64, Word16) decodeSlotId = do _ <- CBOR.decodeListLenCanonicalOf 2 - epochIndex <- CBOR.decodeWord64 - slotNumber <- CBOR.decodeWord16 - return (epochIndex, slotNumber) + epoch <- CBOR.decodeWord64 + slot <- CBOR.decodeWord16 + return (epoch, slot) decodeSoftwareVersion :: CBOR.Decoder s () decodeSoftwareVersion = do @@ -318,15 +329,16 @@ decodeTx :: CBOR.Decoder s Tx decodeTx = do _ <- CBOR.decodeListLenCanonicalOf 2 _ <- CBOR.decodeListLenCanonicalOf 3 - inputs <- decodeListIndef decodeTxIn - outputs <- decodeListIndef decodeTxOut + ins <- decodeListIndef decodeTxIn + outs <- decodeListIndef decodeTxOut _ <- decodeAttributes _ <- decodeList decodeTxWitness - return $ Tx inputs outputs + return $ Tx ins outs decodeTxPayload :: CBOR.Decoder s (Set Tx) decodeTxPayload = Set.fromList <$> decodeListIndef decodeTx +{-# ANN decodeTxIn ("HLint: ignore Use <$>" :: String) #-} decodeTxIn :: CBOR.Decoder s TxIn decodeTxIn = do _ <- CBOR.decodeListLenCanonicalOf 2 @@ -343,16 +355,17 @@ decodeTxIn = do decodeTxIn' :: CBOR.Decoder s TxIn decodeTxIn' = do _ <- CBOR.decodeListLenCanonicalOf 2 - txId <- CBOR.decodeBytes + tx <- Hash <$> CBOR.decodeBytes index <- CBOR.decodeWord32 - return $ TxIn (Hash txId) index + return $ TxIn tx index +{-# ANN decodeTxOut ("HLint: ignore Use <$>" :: String) #-} decodeTxOut :: CBOR.Decoder s TxOut decodeTxOut = do _ <- CBOR.decodeListLenCanonicalOf 2 addr <- decodeAddress - coin <- CBOR.decodeWord64 - return $ TxOut addr (Coin coin) + c <- CBOR.decodeWord64 + return $ TxOut addr (Coin c) decodeTxProof :: CBOR.Decoder s () decodeTxProof = do @@ -376,3 +389,49 @@ decodeUpdateProof :: CBOR.Decoder s () decodeUpdateProof = do _ <- CBOR.decodeBytes -- Update Hash return () + + +-- * Helpers + +-- | Inspect the next token that has to be decoded and print it to the console +-- as a trace. Useful for debugging Decoders. +-- Example: +-- +-- @ +-- myDecoder :: CBOR.Decoder s MyType +-- myDecoder = do +-- a <- CBOR.decodeWord64 +-- inspectNextToken +-- [...] +-- @ +inspectNextToken :: CBOR.Decoder s () +inspectNextToken = + CBOR.peekTokenType >>= flip traceShow (return ()) + +-- | Decode an list of known length. Very similar to @decodeListIndef@. +-- +-- @ +-- myDecoder :: CBOR.Decoder s [MyType] +-- myDecoder = decodeList decodeOne +-- where +-- decodeOne :: CBOR.Decoder s MyType +-- @ +decodeList :: forall s a . CBOR.Decoder s a -> CBOR.Decoder s [a] +decodeList decodeOne = do + l <- CBOR.decodeListLenCanonical + CBOR.decodeSequenceLenN (flip (:)) [] reverse l decodeOne + +-- | Decode an arbitrary long list. CBOR introduce a "break" character to +-- mark the end of the list, so we simply decode each item until we encounter +-- a break character. +-- +-- @ +-- myDecoder :: CBOR.Decoder s [MyType] +-- myDecoder = decodeListIndef decodeOne +-- where +-- decodeOne :: CBOR.Decoder s MyType +-- @ +decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a] +decodeListIndef decodeOne = do + _ <- CBOR.decodeListLenIndef + CBOR.decodeSequenceLenIndef (flip (:)) [] reverse decodeOne diff --git a/src/Cardano/Wallet/Binary/Helpers.hs b/src/Cardano/Wallet/Binary/Helpers.hs deleted file mode 100644 index bfdcc1b9123..00000000000 --- a/src/Cardano/Wallet/Binary/Helpers.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - --- | Some extra helpers on top of the CBOR library to help writing decoders. - -module Cardano.Wallet.Binary.Helpers - ( inspectNextToken - , decodeList - , decodeListIndef - ) where - -import qualified Codec.CBOR.Decoding as CBOR -import Debug.Trace - ( traceShow ) -import Prelude - --- | Inspect the next token that has to be decoded and print it to the console --- as a trace. Useful for debugging Decoders. --- Example: --- --- myDecoder :: CBOR.Decoder s MyType --- myDecoder = do --- a <- CBOR.decodeWord64 --- inspectNextToken --- [...] --- -inspectNextToken :: CBOR.Decoder s () -inspectNextToken = - CBOR.peekTokenType >>= flip traceShow (return ()) - --- | Decode an list of known length. Very similar to @decodeListIndef@. --- --- Example: --- --- myDecoder :: CBOR.Decoder s [MyType] --- myDecoder = decodeList decodeOne --- where --- decodeOne :: CBOR.Decoder s MyType --- -decodeList :: forall s a . CBOR.Decoder s a -> CBOR.Decoder s [a] -decodeList decodeOne = do - l <- CBOR.decodeListLenCanonical - CBOR.decodeSequenceLenN (flip (:)) [] reverse l decodeOne - --- | Decode an arbitrary long list. CBOR introduce a "break" character to --- mark the end of the list, so we simply decode each item until we encounter --- a break character. --- --- Example: --- --- myDecoder :: CBOR.Decoder s [MyType] --- myDecoder = decodeListIndef decodeOne --- where --- decodeOne :: CBOR.Decoder s MyType --- -decodeListIndef :: forall s a. CBOR.Decoder s a -> CBOR.Decoder s [a] -decodeListIndef decodeOne = do - _ <- CBOR.decodeListLenIndef - CBOR.decodeSequenceLenIndef (flip (:)) [] reverse decodeOne diff --git a/src/Cardano/Wallet/Binary/Packfile.hs b/src/Cardano/Wallet/Binary/Packfile.hs index 909029eb165..fd3213852bf 100644 --- a/src/Cardano/Wallet/Binary/Packfile.hs +++ b/src/Cardano/Wallet/Binary/Packfile.hs @@ -1,4 +1,8 @@ --- | Decoder for the rust-cardano packfile format. +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- Decoder for the rust-cardano packfile format. -- -- A pack file is a collection of bytestring blobs. -- diff --git a/test/data/epoch-mainnet-104 b/test/data/Cardano/Wallet/Binary/PackfileSpec-epoch-mainnet-104 similarity index 100% rename from test/data/epoch-mainnet-104 rename to test/data/Cardano/Wallet/Binary/PackfileSpec-epoch-mainnet-104 diff --git a/test/data/block-1 b/test/data/Cardano/Wallet/BinarySpec-block-1 similarity index 100% rename from test/data/block-1 rename to test/data/Cardano/Wallet/BinarySpec-block-1 diff --git a/test/data/block-2 b/test/data/Cardano/Wallet/BinarySpec-block-2 similarity index 100% rename from test/data/block-2 rename to test/data/Cardano/Wallet/BinarySpec-block-2 diff --git a/test/data/block-3 b/test/data/Cardano/Wallet/BinarySpec-block-3 similarity index 100% rename from test/data/block-3 rename to test/data/Cardano/Wallet/BinarySpec-block-3 diff --git a/test/data/block-header-1 b/test/data/Cardano/Wallet/BinarySpec-block-header-1 similarity index 100% rename from test/data/block-header-1 rename to test/data/Cardano/Wallet/BinarySpec-block-header-1 diff --git a/test/unit/Cardano/Wallet/Binary/PackfileSpec.hs b/test/unit/Cardano/Wallet/Binary/PackfileSpec.hs index e66ef10bae4..30a880d1b8c 100644 --- a/test/unit/Cardano/Wallet/Binary/PackfileSpec.hs +++ b/test/unit/Cardano/Wallet/Binary/PackfileSpec.hs @@ -6,7 +6,7 @@ import Cardano.Wallet.Binary ( decodeBlock ) import Cardano.Wallet.Binary.Packfile ( PackfileError (..), decodePackfile ) -import Cardano.Wallet.BinaryHelpers +import Cardano.Wallet.BinarySpec ( unsafeDeserialiseFromBytes ) import Cardano.Wallet.Primitive ( Block (..), BlockHeader (..) ) @@ -34,7 +34,7 @@ testTwoBlobs = packFileHeader -- Get this file from cardano-http-bridge with: -- wget -O test/data/epoch-mainnet-104 http://localhost:8080/mainnet/epoch/104 testPackfile :: FilePath -testPackfile = "test/data/epoch-mainnet-104" +testPackfile = "test/data/Cardano/Wallet/Binary/PackfileSpec-epoch-mainnet-104" spec :: Spec spec = do diff --git a/test/unit/Cardano/Wallet/BinaryHelpers.hs b/test/unit/Cardano/Wallet/BinaryHelpers.hs deleted file mode 100644 index 461002b2d97..00000000000 --- a/test/unit/Cardano/Wallet/BinaryHelpers.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE RankNTypes #-} - -module Cardano.Wallet.BinaryHelpers - ( hash16 - , addr58 - , unsafeDeserialiseFromBytes - ) where - -import Cardano.Wallet.Primitive -import qualified Codec.CBOR.Decoding as CBOR -import qualified Codec.CBOR.Read as CBOR -import Data.ByteArray.Encoding - ( Base (Base16), convertFromBase ) -import Data.ByteString - ( ByteString ) -import Data.ByteString.Base58 - ( bitcoinAlphabet, decodeBase58 ) -import qualified Data.ByteString.Lazy as BL -import Prelude - --- | Make a Hash from a Base16 encoded string, without error handling. -hash16 :: ByteString -> Hash a -hash16 = either bomb Hash . convertFromBase Base16 - where - bomb msg = error ("Could not decode test string: " <> msg) - --- | Make an Address from a Base58 encoded string, without error handling. -addr58 :: ByteString -> Address -addr58 = maybe (error "addr58: Could not decode") Address . decodeBase58 bitcoinAlphabet - --- | CBOR deserialise without error handling - handy for prototypes or testing. -unsafeDeserialiseFromBytes :: (forall s. CBOR.Decoder s a) -> BL.ByteString -> a -unsafeDeserialiseFromBytes decoder bytes = - either (\e -> error $ "unsafeDeserialiseFromBytes: " <> show e) snd $ - CBOR.deserialiseFromBytes decoder bytes diff --git a/test/unit/Cardano/Wallet/BinarySpec.hs b/test/unit/Cardano/Wallet/BinarySpec.hs index 49cc6c2567a..18caf858f7c 100644 --- a/test/unit/Cardano/Wallet/BinarySpec.hs +++ b/test/unit/Cardano/Wallet/BinarySpec.hs @@ -1,22 +1,65 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RankNTypes #-} -module Cardano.Wallet.BinarySpec (spec) where +module Cardano.Wallet.BinarySpec + ( spec + + -- * Helpers + , unsafeDeserialiseFromBytes + ) where import Prelude -import qualified Data.Set as Set +import Cardano.Wallet.Binary + ( decodeBlock, decodeBlockHeader ) +import Cardano.Wallet.Primitive + ( Address (..) + , Block (..) + , BlockHeader (..) + , Coin (..) + , Hash (..) + , Tx (..) + , TxIn (..) + , TxOut (..) + ) +import Data.ByteArray.Encoding + ( Base (Base16), convertFromBase ) +import Data.ByteString + ( ByteString ) +import Data.ByteString.Base58 + ( bitcoinAlphabet, decodeBase58 ) +import Test.Hspec + ( Spec, describe, it, shouldBe ) +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Read as CBOR +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as L8 +import qualified Data.Set as Set -import Test.Hspec - ( Spec, describe, it, shouldBe ) -import Cardano.Wallet.Binary - ( decodeBlock, decodeBlockHeader ) -import Cardano.Wallet.BinaryHelpers - ( addr58, hash16, unsafeDeserialiseFromBytes ) -import Cardano.Wallet.Primitive - ( Block (..), BlockHeader (..), Coin (..), Tx (..), TxIn (..), TxOut (..) ) +spec :: Spec +spec = do + describe "Decoding blocks" $ do + it "should decode a block header" $ do + bs <- L8.readFile "test/data/Cardano/Wallet/BinarySpec-block-header-1" + let decoded = unsafeDeserialiseFromBytes decodeBlockHeader bs + decoded `shouldBe` blockHeader1 + + it "should decode a block without transactions" $ do + bs <- L8.readFile "test/data/Cardano/Wallet/BinarySpec-block-1" + let decoded = unsafeDeserialiseFromBytes decodeBlock bs + decoded `shouldBe` block1 + + it "should decode a block with transactions" $ do + bs <- L8.readFile "test/data/Cardano/Wallet/BinarySpec-block-2" + let decoded = unsafeDeserialiseFromBytes decodeBlock bs + decoded `shouldBe` block2 + + it "should decode a testnet block with a transaction" $ do + bs <- L8.readFile "test/data/Cardano/Wallet/BinarySpec-block-3" + let decoded = unsafeDeserialiseFromBytes decodeBlock bs + decoded `shouldBe` block3 + -- A mainnet block header blockHeader1 :: BlockHeader @@ -98,25 +141,21 @@ block3 = Block ] } -spec :: Spec -spec = do - describe "Decoding blocks" $ do - it "should decode a block header" $ do - bs <- L8.readFile "test/data/block-header-1" - let decoded = unsafeDeserialiseFromBytes decodeBlockHeader bs - decoded `shouldBe` blockHeader1 - it "should decode a block without transactions" $ do - bs <- L8.readFile "test/data/block-1" - let decoded = unsafeDeserialiseFromBytes decodeBlock bs - decoded `shouldBe` block1 +-- * Helpers - it "should decode a block with transactions" $ do - bs <- L8.readFile "test/data/block-2" - let decoded = unsafeDeserialiseFromBytes decodeBlock bs - decoded `shouldBe` block2 +-- | Make a Hash from a Base16 encoded string, without error handling. +hash16 :: ByteString -> Hash a +hash16 = either bomb Hash . convertFromBase Base16 + where + bomb msg = error ("Could not decode test string: " <> msg) - it "should decode a testnet block with a transaction" $ do - bs <- L8.readFile "test/data/block-3" - let decoded = unsafeDeserialiseFromBytes decodeBlock bs - decoded `shouldBe` block3 +-- | Make an Address from a Base58 encoded string, without error handling. +addr58 :: ByteString -> Address +addr58 = maybe (error "addr58: Could not decode") Address . decodeBase58 bitcoinAlphabet + +-- | CBOR deserialise without error handling - handy for prototypes or testing. +unsafeDeserialiseFromBytes :: (forall s. CBOR.Decoder s a) -> BL.ByteString -> a +unsafeDeserialiseFromBytes decoder bytes = + either (\e -> error $ "unsafeDeserialiseFromBytes: " <> show e) snd $ + CBOR.deserialiseFromBytes decoder bytes