Check C jet costs in the jet decoding tests

Haskell/Tests/Simplicity/Bitcoin/FFI/Primitive.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Simplicity.Bitcoin.FFI.Primitive
   ( decodeJetCMR
+  , decodeJetCost
   , ErrorCode(..)
   ) where
 
@@ -28,10 +29,17 @@ decodeJetNode pstream k =
   error <- simplicity_bitcoin_decodeJet pnode pstream
   k (decodeError error >> return pnode)
 
-decodeJetCMR :: [Bool] -> Either ErrorCode Hash256
-decodeJetCMR codeWord = unsafeLocalState $
+decodeJetWith :: (Ptr DagNode -> IO a) -> [Bool] -> Either ErrorCode a
+decodeJetWith get codeWord = unsafeLocalState $
   initializeBitstream codeWord $ \pstream ->
   decodeJetNode pstream $ \result ->
   case result of
     Left err -> return $ Left err
-    Right pnode -> Right <$> dagNodeGetCMR pnode
+    Right pnode -> Right <$> get pnode
+
+decodeJetCMR :: [Bool] -> Either ErrorCode Hash256
+decodeJetCMR = decodeJetWith dagNodeGetCMR
+
+-- | The cost of the decoded jet in milli weight units.
+decodeJetCost :: [Bool] -> Either ErrorCode Integer
+decodeJetCost = decodeJetWith dagNodeGetCost

Haskell/Tests/Simplicity/Bitcoin/Serialization/Tests.hs

@@ -15,6 +15,7 @@ import Simplicity.MerkleRoot
 import Simplicity.Serialization
 import Simplicity.Ty
 import Simplicity.Ty.Word
+import Simplicity.Weight (milliWeight)
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit ((@=?), testCase)
@@ -37,11 +38,14 @@ testDecodeBitcoinJet jt = testCase (show jt) (Just (SomeArrow jt) @=? decode)
   decode = evalExactVector (Bitcoin.getJetBit mzero) vector
 
 testDecodeBitcoinJetFFI :: (TyC a, TyC b) => Bitcoin.JetType a b -> TestTree
-testDecodeBitcoinJetFFI jt = testCase (show jt) (Right cmr @=? Bitcoin.decodeJetCMR bitstream)
+testDecodeBitcoinJetFFI jt = testCase (show jt) $ do
+  Right cmr @=? Bitcoin.decodeJetCMR bitstream
+  Right cost @=? Bitcoin.decodeJetCost bitstream
  where
   -- All jet encodings should begin with a 1 bit, which we consume.
   True:bitstream = Bitcoin.putJetBit jt []
   cmr = commitmentRoot (asJet jt)
+  cost = milliWeight (jetCost jt)
 
 prop_wordCMR :: SomeConstWordContent -> Property
 prop_wordCMR (SomeConstWordContent cwc) = forAll prefix prop

Haskell/Tests/Simplicity/Elements/FFI/Primitive.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Simplicity.Elements.FFI.Primitive
   ( decodeJetCMR
+  , decodeJetCost
   , ErrorCode(..)
   ) where
 
@@ -28,10 +29,17 @@ decodeJetNode pstream k =
   error <- simplicity_elements_decodeJet pnode pstream
   k (decodeError error >> return pnode)
 
-decodeJetCMR :: [Bool] -> Either ErrorCode Hash256
-decodeJetCMR codeWord = unsafeLocalState $
+decodeJetWith :: (Ptr DagNode -> IO a) -> [Bool] -> Either ErrorCode a
+decodeJetWith get codeWord = unsafeLocalState $
   initializeBitstream codeWord $ \pstream ->
   decodeJetNode pstream $ \result ->
   case result of
     Left err -> return $ Left err
-    Right pnode -> Right <$> dagNodeGetCMR pnode
+    Right pnode -> Right <$> get pnode
+
+decodeJetCMR :: [Bool] -> Either ErrorCode Hash256
+decodeJetCMR = decodeJetWith dagNodeGetCMR
+
+-- | The cost of the decoded jet in milli weight units.
+decodeJetCost :: [Bool] -> Either ErrorCode Integer
+decodeJetCost = decodeJetWith dagNodeGetCost

Haskell/Tests/Simplicity/Elements/Serialization/Tests.hs

@@ -15,6 +15,7 @@ import Simplicity.MerkleRoot
 import Simplicity.Serialization
 import Simplicity.Ty
 import Simplicity.Ty.Word
+import Simplicity.Weight (milliWeight)
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit ((@=?), testCase)
@@ -37,11 +38,14 @@ testDecodeElementsJet jt = testCase (show jt) (Just (SomeArrow jt) @=? decode)
   decode = evalExactVector (Elements.getJetBit mzero) vector
 
 testDecodeElementsJetFFI :: (TyC a, TyC b) => Elements.JetType a b -> TestTree
-testDecodeElementsJetFFI jt = testCase (show jt) (Right cmr @=? Elements.decodeJetCMR bitstream)
+testDecodeElementsJetFFI jt = testCase (show jt) $ do
+  Right cmr @=? Elements.decodeJetCMR bitstream
+  Right cost @=? Elements.decodeJetCost bitstream
  where
   -- All jet encodings should begin with a 1 bit, which we consume.
   True:bitstream = Elements.putJetBit jt []
   cmr = commitmentRoot (asJet jt)
+  cost = milliWeight (jetCost jt)
 
 prop_wordCMR :: SomeConstWordContent -> Property
 prop_wordCMR (SomeConstWordContent cwc) = forAll prefix prop

Haskell/Tests/Simplicity/FFI/Dag.hs

@@ -2,13 +2,15 @@
 module Simplicity.FFI.Dag
   ( DagNode
   , dagNodeGetCMR
+  , dagNodeGetCost
   , withDagNode
   , computeWordCMR
   ) where
 
 import qualified Data.ByteString as BS
 import Data.Serialize (decode)
 import Data.Serialize.Put (runPut)
+import Data.Word (Word64)
 import Foreign.C.Types (CSize(..), CChar(..))
 import Foreign.Ptr (Ptr)
 import Foreign.Marshal.Alloc (allocaBytes)
@@ -25,6 +27,7 @@ newtype DagNode = DagNode DagNode
 foreign import ccall unsafe "&" c_sizeof_dag_node :: Ptr CSize
 
 foreign import ccall unsafe "" c_dag_node_get_cmr :: Ptr CChar -> Ptr DagNode -> IO ()
+foreign import ccall unsafe "" c_dag_node_get_cost :: Ptr DagNode -> IO Word64
 foreign import ccall unsafe "" c_compute_word_cmr :: Ptr CChar -> Ptr Bitstream -> CSize -> CSize -> IO ()
 
 sizeof_dag_node :: Int
@@ -40,6 +43,10 @@ dagNodeGetCMR pnode =
   Right hash <- decode <$> BS.packCStringLen (buf, 32)
   return hash
 
+-- | The cost of a 'DagNode' in milli weight units.
+dagNodeGetCost :: Ptr DagNode -> IO Integer
+dagNodeGetCost pnode = toInteger <$> c_dag_node_get_cost pnode
+
 computeWordCMR :: Int -> [Bool] -> Hash256
 computeWordCMR offset stream = case log2Of (length stream - offset) of
   Nothing -> error $ "Simplicity.FFI.Dag.computeWordCMR: Bad stream length " ++ show (length stream - offset)

Haskell/cbits/dag.c

@@ -16,3 +16,7 @@ void c_compute_word_cmr(unsigned char *cmr, bitstream* stream, size_t offset, si
 void c_dag_node_get_cmr(unsigned char *cmr, const dag_node* node) {
   sha256_fromMidstate(cmr, node->cmr.s);
 }
+
+uint64_t c_dag_node_get_cost(const dag_node* node) {
+  return node->cost;
+}