diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs index be4410cabc6..19840d6dafa 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs @@ -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 (..) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 {------------------------------------------------------------------------------- diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs index 30122813c75..2ace8c1692d 100644 --- a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs +++ b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} + module Cardano.Wallet.Jormungandr.NetworkSpec ( spec ) where @@ -23,7 +24,6 @@ import Cardano.Wallet.Jormungandr.Primitive.Types import Cardano.Wallet.Network ( ErrGetBlock (..) , ErrNetworkTip (..) - , ErrPostTx (..) , NetworkLayer (..) , defaultRetryPolicy , waitForConnection @@ -70,7 +70,6 @@ import Test.Hspec , beforeAll , describe , it - , pendingWith , shouldBe , shouldReturn , shouldSatisfy @@ -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) @@ -169,6 +170,7 @@ 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 () @@ -176,13 +178,18 @@ spec = 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] @@ -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\ @@ -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 "") (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 "") (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" @@ -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 + } + ] + }