Skip to content

Commit

Permalink
Merge pull request #487 from input-output-hk/anviking/219/stricter-en…
Browse files Browse the repository at this point in the history
…coders

Stricter jörmungandr binary encoders regarding integer overflow
  • Loading branch information
KtorZ authored Jul 2, 2019
2 parents 0129cb2 + b399323 commit 5d67169
Show file tree
Hide file tree
Showing 2 changed files with 72 additions and 19 deletions.
26 changes: 19 additions & 7 deletions lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,14 @@
-- License: MIT
--
-- The format is for the Shelley era as implemented by the Jörmungandr node.
--
-- It is described [here](https://github.com/input-output-hk/rust-cardano/blob/master/chain-impl-mockchain/doc/format.md)
--
-- The module to some extent defines its own Jörmungandr-specific types,
-- different from "Cardano.Wallet.Primitive.Types". Here, transactions are just
-- one of many possible 'Message's that can be included in a block.
--
-- In some cases it also leads us to /throw exceptions/ when integers would
-- otherwise overflow (look for uses of 'toEnum').

module Cardano.Wallet.Jormungandr.Binary
( Block (..)
Expand Down Expand Up @@ -70,7 +76,7 @@ import Cardano.Wallet.Primitive.Types
import Control.Applicative
( many )
import Control.Monad
( replicateM )
( replicateM, unless )
import Data.Binary.Get
( Get
, bytesRead
Expand Down Expand Up @@ -133,7 +139,7 @@ getBlockHeader = label "getBlockHeader" $
version <- getWord16be
contentSize <- getWord32be
slotEpoch <- fromIntegral <$> getWord32be
slotId <- fromIntegral <$> getWord32be
slotId <- toEnum . fromEnum <$> getWord32be
chainLength <- getWord32be
contentHash <- Hash <$> getByteString 32 -- or 256 bits
parentHeaderHash <- Hash <$> getByteString 32
Expand Down Expand Up @@ -259,9 +265,11 @@ getTransaction = label "getTransaction" $ do
putSignedTx :: (Tx, [TxWitness]) -> Put
putSignedTx (tx@(Tx inputs outputs), witnesses) = withSizeHeader16be $ do
putWord8 2
putWord8 $ fromIntegral $ length inputs
putWord8 $ fromIntegral $ length outputs
putWord8 $ toEnum $ length inputs
putWord8 $ toEnum $ length outputs
putTx tx
unless (length inputs == length witnesses) $
fail "number of witnesses must equal number of inputs"
mapM_ putWitness witnesses
where
-- Assumes the `TxWitness` has been faithfully constructed
Expand All @@ -272,13 +280,17 @@ putSignedTx (tx@(Tx inputs outputs), witnesses) = withSizeHeader16be $ do

putTx :: Tx -> Put
putTx (Tx inputs outputs) = do
unless (length inputs <= fromIntegral (maxBound :: Word8)) $
fail "number of inputs cannot be greater than 255"
unless (length outputs <= fromIntegral (maxBound :: Word8)) $
fail "number of outputs cannot be greater than 255"
mapM_ putInput inputs
mapM_ putOutput outputs
where
putInput (TxIn inputId inputIx, coin) = do
-- NOTE: special value 0xff indicates account spending
-- only old utxo/address scheme supported for now
putWord8 $ fromIntegral inputIx
putWord8 . toEnum . fromEnum $ inputIx
putWord64be $ getCoin coin
putByteString $ getHash inputId

Expand Down Expand Up @@ -454,7 +466,7 @@ isolatePut l x = do
withSizeHeader16be :: Put -> Put
withSizeHeader16be x = do
let bs = BL.toStrict $ runPut x
putWord16be (fromIntegral $ BS.length bs)
putWord16be (toEnum $ BS.length bs)
putByteString bs

{-------------------------------------------------------------------------------
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}


module Cardano.Wallet.Jormungandr.NetworkSpec
( spec
) where
Expand All @@ -23,7 +24,6 @@ import Cardano.Wallet.Jormungandr.Primitive.Types
import Cardano.Wallet.Network
( ErrGetBlock (..)
, ErrNetworkTip (..)
, ErrPostTx (..)
, NetworkLayer (..)
, defaultRetryPolicy
, waitForConnection
Expand Down Expand Up @@ -70,7 +70,6 @@ import Test.Hspec
, beforeAll
, describe
, it
, pendingWith
, shouldBe
, shouldReturn
, shouldSatisfy
Expand All @@ -82,6 +81,8 @@ import Test.QuickCheck
import qualified Cardano.Wallet.Jormungandr.Network as Jormungandr
import qualified Data.ByteString as BS

{-# ANN spec ("HLint: ignore Use head" :: String) #-}

spec :: Spec
spec = do
let startNode' = startNode url (`waitForConnection` defaultRetryPolicy)
Expand Down Expand Up @@ -169,20 +170,26 @@ spec = do
$ beforeAll startNode' $ afterAll killNode $ do

it "empty tx succeeds" $ \(_, nw) -> do
-- Would be rejected eventually.
let signedEmpty = (Tx [] [], [])
runExceptT (postTx nw signedEmpty) `shouldReturn` Right ()

it "some tx succeeds" $ \(_, nw) -> do
let signed = (txNonEmpty, [pkWitness])
runExceptT (postTx nw signed) `shouldReturn` Right ()

it "more inputs than witnesses" $ \(_, nw) -> do
it "unbalanced tx (surplus) succeeds" $ \(_, nw) -> do
-- Jormungandr will eventually reject txs that are not perfectly
-- balanced though.
let signed = (unbalancedTx, [pkWitness])
runExceptT (postTx nw signed) `shouldReturn` Right ()

it "more inputs than witnesses - encoder throws" $ \(_, nw) -> do
let signed = (txNonEmpty, [])
let err = Left $ ErrPostTxBadRequest ""
runExceptT (postTx nw signed) `shouldReturn` err
runExceptT (postTx nw signed) `shouldThrow` someException

it "more witnesses than inputs - fine apparently" $ \(_, nw) -> do
-- Becase of how signed txs are encoded:
-- Because of how signed txs are encoded:
-- n :: Word8
-- m :: Word8
-- in_0 .. in_n :: [TxIn]
Expand All @@ -192,9 +199,10 @@ spec = do
-- this should in practice be like appending bytes to the end of
-- the message.
let signed = (txNonEmpty, [pkWitness, pkWitness, pkWitness])
runExceptT (postTx nw signed) `shouldReturn` Right ()
runExceptT (postTx nw signed) `shouldThrow` someException

it "no input, one output" $ \(_, nw) -> do
-- Would be rejected eventually.
let tx = (Tx []
[ (TxOut $ unsafeDecodeAddress proxy
"ca1qwunuat6snw60g99ul6qvte98fja\
Expand All @@ -203,13 +211,20 @@ spec = do
], [])
runExceptT (postTx nw tx) `shouldReturn` Right ()

it "fails when addresses and hashes have wrong length" $ \(_, nw) -> do
pendingWith "We need to handle errors in Jormungandr.Binary"
let tx = (Tx [] [ TxOut (Address "<not an address>") (Coin 1227362560) ], [])
let err = Left $ ErrPostTxBadRequest ""
runExceptT (postTx nw tx) `shouldReturn` err
it "throws when addresses and hashes have wrong length" $ \(_, nw) -> do
let out = TxOut (Address "<not an address>") (Coin 1227362560)
let tx = (Tx [] [out] , [])
runExceptT (postTx nw tx) `shouldThrow` someException

it "encoder throws an exception if tx is invalid (eg too many inputs)" $
\(_, nw) -> do
let inp = head (inputs txNonEmpty)
let out = head (outputs txNonEmpty)
let tx = (Tx (replicate 300 inp) (replicate 3 out), [])
runExceptT (postTx nw tx) `shouldThrow` someException
where
someException = (const True :: SomeException -> Bool)

url :: BaseUrl
url = BaseUrl Http "localhost" 8081 "/api"

Expand Down Expand Up @@ -269,3 +284,29 @@ spec = do
}
]
}

unbalancedTx :: Tx
unbalancedTx = Tx
{ inputs =
[ (TxIn
{ inputId = Hash $ unsafeFromHex
"666984dec4bc0ff1888be97bfe0694a9\
\6b35c58d025405ead51d5cc72a3019f4"
, inputIx = 0
}, Coin 100)
]
, outputs =
[ TxOut
{ address = unsafeDecodeAddress proxy
"ca1q0u7k6ltp3e52pch47rhdkld2gdv\
\gu26rwyqh02csu3ah3384f2nvhlk7a6"
, coin = Coin 5
}
, TxOut
{ address = unsafeDecodeAddress proxy
"ca1qwunuat6snw60g99ul6qvte98fja\
\le2k0uu5mrymylqz2ntgzs6vs386wxd"
, coin = Coin 5
}
]
}

0 comments on commit 5d67169

Please sign in to comment.