diff --git a/Haskell/Tests/Simplicity/Bitcoin/FFI/Primitive.hs b/Haskell/Tests/Simplicity/Bitcoin/FFI/Primitive.hs index f2b980b20..850d43999 100644 --- a/Haskell/Tests/Simplicity/Bitcoin/FFI/Primitive.hs +++ b/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 diff --git a/Haskell/Tests/Simplicity/Bitcoin/Serialization/Tests.hs b/Haskell/Tests/Simplicity/Bitcoin/Serialization/Tests.hs index 22108c9a1..523da10c2 100644 --- a/Haskell/Tests/Simplicity/Bitcoin/Serialization/Tests.hs +++ b/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 diff --git a/Haskell/Tests/Simplicity/Elements/FFI/Primitive.hs b/Haskell/Tests/Simplicity/Elements/FFI/Primitive.hs index dbe79e824..1db1718d1 100644 --- a/Haskell/Tests/Simplicity/Elements/FFI/Primitive.hs +++ b/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 diff --git a/Haskell/Tests/Simplicity/Elements/Serialization/Tests.hs b/Haskell/Tests/Simplicity/Elements/Serialization/Tests.hs index 979af2e9b..852022ea5 100644 --- a/Haskell/Tests/Simplicity/Elements/Serialization/Tests.hs +++ b/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 diff --git a/Haskell/Tests/Simplicity/FFI/Dag.hs b/Haskell/Tests/Simplicity/FFI/Dag.hs index ec04b0cde..f85de19c0 100644 --- a/Haskell/Tests/Simplicity/FFI/Dag.hs +++ b/Haskell/Tests/Simplicity/FFI/Dag.hs @@ -2,6 +2,7 @@ module Simplicity.FFI.Dag ( DagNode , dagNodeGetCMR + , dagNodeGetCost , withDagNode , computeWordCMR ) where @@ -9,6 +10,7 @@ module Simplicity.FFI.Dag 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) diff --git a/Haskell/cbits/dag.c b/Haskell/cbits/dag.c index 57327ed0e..efc85dd04 100644 --- a/Haskell/cbits/dag.c +++ b/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; +}