Skip to content

Commit

Permalink
Review folder structure, file documentation and pragmas
Browse files Browse the repository at this point in the history
- Review haddock documentation for Cardano.Wallet.Binary
- Remove unnecessart intermediary modules 'BinaryHelpers' and 'Binary/Helpers'
- Rename and organize test data to reflect source code organization
- Add license and copyright to source files' header
  • Loading branch information
KtorZ committed Mar 7, 2019
1 parent 8ec4cfd commit 9cb4ca3
Show file tree
Hide file tree
Showing 12 changed files with 183 additions and 180 deletions.
14 changes: 5 additions & 9 deletions cardano-wallet.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,6 @@ library
ghc-options: -Werror
build-depends:
base

-- Hackage Dependencies
, binary
, bytestring
, cborg
Expand All @@ -45,9 +43,8 @@ library
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

Expand Down Expand Up @@ -100,7 +97,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
145 changes: 100 additions & 45 deletions src/Cardano/Wallet/Binary.hs
Original file line number Diff line number Diff line change
@@ -1,36 +1,28 @@
{-# 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).

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 (..)
Expand All @@ -41,8 +33,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
Expand All @@ -69,14 +75,15 @@ 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
t <- CBOR.decodeWordCanonical
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
Expand All @@ -87,14 +94,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
Expand Down Expand Up @@ -144,22 +151,22 @@ 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
-- naively parse all blocks from an epoch, two of them will have a slot
-- 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
Expand Down Expand Up @@ -205,9 +212,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
Expand Down Expand Up @@ -262,7 +269,7 @@ decodeProtocolMagic = do
return ()

decodeProxySignature
:: (forall s. CBOR.Decoder s ())
:: (forall x. CBOR.Decoder x ())
-> CBOR.Decoder s ()
decodeProxySignature decodeIndex = do
_ <- CBOR.decodeListLenCanonicalOf 2
Expand Down Expand Up @@ -303,9 +310,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
Expand All @@ -318,15 +325,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
Expand All @@ -343,16 +351,17 @@ decodeTxIn = do
decodeTxIn' :: CBOR.Decoder s TxIn
decodeTxIn' = do
_ <- CBOR.decodeListLenCanonicalOf 2
txId <- CBOR.decodeBytes
tx <- CBOR.decodeBytes
index <- CBOR.decodeWord32
return $ TxIn (Hash txId) index
return $ TxIn (Hash 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
Expand All @@ -376,3 +385,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
58 changes: 0 additions & 58 deletions src/Cardano/Wallet/Binary/Helpers.hs

This file was deleted.

6 changes: 5 additions & 1 deletion src/Cardano/Wallet/Binary/Packfile.hs
Original file line number Diff line number Diff line change
@@ -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.
--
Expand Down
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
4 changes: 2 additions & 2 deletions test/unit/Cardano/Wallet/Binary/PackfileSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..) )
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 9cb4ca3

Please sign in to comment.