Check for overflow in Jörmungandr.Binary

- Particulary in encoders (putX)
- Somewhat for decoders (getX)

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs

@@ -76,7 +76,7 @@ import Cardano.Wallet.Primitive.Types
 import Control.Applicative
     ( many )
 import Control.Monad
-    ( replicateM )
+    ( replicateM, unless )
 import Data.Binary.Get
     ( Get
     , bytesRead
@@ -138,8 +138,8 @@ getBlockHeader = label "getBlockHeader" $
         -- Common structure.
         version <- getWord16be
         contentSize <- getWord32be
-        slotEpoch <- fromIntegral <$> getWord32be
-        slotId <- fromIntegral <$> getWord32be
+        slotEpoch <- unsafeFromIntegral <$> getWord32be
+        slotId <- unsafeFromIntegral <$> getWord32be
         chainLength <- getWord32be
         contentHash <- Hash <$> getByteString 32 -- or 256 bits
         parentHeaderHash <- Hash <$> getByteString 32
@@ -246,9 +246,12 @@ getTransaction = label "getTransaction" $ do
         outs <- replicateM outCount getOutput
         return (ins, outs)
       where
+        convert :: Word8 -> Word32
+        convert = fromIntegral
+
         getInput = isolate 41 $ do
             -- NOTE: special value 0xff indicates account spending
-            index <- fromIntegral <$> getWord8
+            index <- convert <$> getWord8
             coin <- Coin <$> getWord64be
             tx <- Hash <$> getByteString 32
             return (TxIn tx index, coin)
@@ -265,9 +268,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
@@ -278,13 +283,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 . unsafeFromIntegral $ inputIx
         putWord64be $ getCoin coin
         putByteString $ getHash inputId
 
@@ -460,9 +469,13 @@ 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
 
+-- Like 'fromIntegral', but throws an exception instead of overflowing.
+unsafeFromIntegral :: (Enum a, Enum b) => a -> b
+unsafeFromIntegral = toEnum . fromEnum
+
 {-------------------------------------------------------------------------------
                                 Conversions
 -------------------------------------------------------------------------------}