Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Sort metadata keys for no-schema json for canonical CBOR #517

Merged
merged 1 commit into from
Apr 12, 2024
Merged

Sort metadata keys for no-schema json for canonical CBOR #517

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions cardano-api/cardano-api.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -319,6 +319,7 @@ test-suite cardano-api-test
, hedgehog >= 1.1
, hedgehog-extras
, hedgehog-quickcheck
, interpolatedstring-perl6
, mtl
, QuickCheck
, tasty
Expand Down
32 changes: 25 additions & 7 deletions cardano-api/internal/Cardano/Api/TxMetadata.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ import Cardano.Api.SerialiseCBOR (SerialiseAsCBOR (..))
import qualified Cardano.Ledger.Binary as CBOR
import qualified Cardano.Ledger.Shelley.TxAuxData as Shelley

import qualified Codec.CBOR.Magic as CBOR
import Control.Applicative (Alternative (..))
import Control.Monad (guard, when)
import qualified Data.Aeson as Aeson
Expand Down Expand Up @@ -85,13 +86,11 @@ import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Vector as Vector
import Data.Word

{- HLINT ignore "Use lambda-case" -}

-- ----------------------------------------------------------------------------
-- TxMetadata types
--

newtype TxMetadata = TxMetadata (Map Word64 TxMetadataValue)
newtype TxMetadata = TxMetadata { unTxMetadata :: Map Word64 TxMetadataValue }
deriving (Eq, Show)

data TxMetadataValue = TxMetaMap [(TxMetadataValue, TxMetadataValue)]
Expand Down Expand Up @@ -133,7 +132,7 @@ instance SerialiseAsCBOR TxMetadata where
-- protocol version be supplied as an argument.
CBOR.serialize' CBOR.shelleyProtVer
. toShelleyMetadata
. (\(TxMetadata m) -> m)
. unTxMetadata

deserialiseFromCBOR AsTxMetadata bs =
TxMetadata
Expand Down Expand Up @@ -429,7 +428,7 @@ metadataFromJson :: TxMetadataJsonSchema
-> Aeson.Value
-> Either TxMetadataJsonError TxMetadata
metadataFromJson schema =
\vtop -> case vtop of
\case
-- The top level has to be an object
-- with unsigned integer (decimal or hex) keys
Aeson.Object m ->
Expand Down Expand Up @@ -556,9 +555,11 @@ metadataValueFromJsonNoSchema = conv
$ Vector.toList vs

conv (Aeson.Object kvs) =
fmap TxMetaMap
fmap
( TxMetaMap
. sortCanonicalForCbor
)
. traverse (\(k,v) -> (,) (convKey k) <$> conv v)
. List.sortOn fst
Copy link
Contributor Author

@carbolymer carbolymer Apr 10, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The JSON map was previously sorted lexicographically by keys and then it was processed down the line as a list of pairs until it got serialised to CBOR. So this place was deciding about the sorting order of the object fields' names.

Copy link
Contributor

@Jimbo4350 Jimbo4350 Apr 11, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So this will work but I think a more robust solution would be to do something similar to HashableScriptData. We should serialize the metadata to CBOR once and carry around the canonical representation. I think this distinction is useful for the reader.

Copy link
Contributor Author

@carbolymer carbolymer Apr 11, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I see. This would complicate things a bit because here we're converting here our type:

cardano-api/cardano-api/internal/Cardano/Api/TxMetadata.hs

Line 135 in 03de67a

. toShelleyMetadata
to ledger type (isomorphic to ours): https://github.com/IntersectMBO/cardano-ledger/blob/dbce4e4a3ad508b2bfd2df897b617c19b7f049de/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxAuxData.hs#L95
So I guess I'd have to modify SerialiseAsCBOR to handle different metadata types 🤔

Copy link
Contributor

@Jimbo4350 Jimbo4350 Apr 11, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It would look like HashableScriptData's SerialiseAsCBOR instance:

instance SerialiseAsCBOR HashableScriptData where
    serialiseToCBOR (HashableScriptData origBytes _) = origBytes

Upon constructing "HashableTxMetaData" you would already have the CBOR of the metadata.

. fmap (first Aeson.toText)
$ KeyMap.toList kvs

Expand All @@ -574,6 +575,23 @@ bytesPrefix :: Text
bytesPrefix = "0x"


-- | Sorts the list by the first value in the tuple using the rules for canonical CBOR (RFC 7049 section 3.9)
--
-- This function is used when transforming data from JSON. In principle the JSON standard and aeson library
-- do not provide any guarantees about the order of keys in 'Aeson.Object' which means we are free to pick any.
-- Because we're dumping data into CBOR we are picking a canonical way of sorting keys in a map - the keys are
-- sorted according to the value of their byte representation.
--
-- Details described here: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
sortCanonicalForCbor :: [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
sortCanonicalForCbor =
map snd
. List.sortOn fst
. map (\e@(k, _) -> (CBOR.uintegerFromBytes $ serialiseKey k, e))
where
serialiseKey = CBOR.serialize' CBOR.shelleyProtVer . toShelleyMetadatum

-- ----------------------------------------------------------------------------
-- JSON conversion using the "detailed schema" style
--
Expand Down
179 changes: 136 additions & 43 deletions cardano-api/test/cardano-api-test/Test/Cardano/Api/Metadata.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Test.Cardano.Api.Metadata
( tests
Expand All @@ -14,11 +15,14 @@ import Data.ByteString (ByteString)
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import Data.Word (Word64)
import GHC.Stack
import Text.InterpolatedString.Perl6

import Test.Gen.Cardano.Api.Metadata

import Hedgehog (Gen, Property, property, (===))
import qualified Hedgehog
import Hedgehog (Gen, Property, (===))
import qualified Hedgehog as H
import qualified Hedgehog.Extras as H
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty (TestTree, testGroup)
Expand All @@ -29,63 +33,151 @@ import Test.Tasty.Hedgehog (testProperty)
--

prop_golden_1 :: Property
prop_golden_1 = matchMetadata
"{\"0\": 1}"
prop_golden_1 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": 1}|]
(TxMetadata (Map.fromList [(0, TxMetaNumber 1)]))

prop_golden_2 :: Property
prop_golden_2 = matchMetadata
"{\"0\": \"deadbeef\"}"
prop_golden_2 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": "deadbeef"}|]
(txMetadataSingleton 0 (TxMetaText "deadbeef"))

prop_golden_3 :: Property
prop_golden_3 = matchMetadata
"{\"0\": \"0xDEADBEEF\"}"
prop_golden_3 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": "0xDEADBEEF"}|]
(txMetadataSingleton 0 (TxMetaText "0xDEADBEEF"))

prop_golden_4 :: Property
prop_golden_4 = matchMetadata
"{\"0\": \"0xdeadbeef\"}"
prop_golden_4 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": "0xdeadbeef"}|]
(txMetadataSingleton 0 (TxMetaBytes "\xde\xad\xbe\xef"))

prop_golden_5 :: Property
prop_golden_5 = matchMetadata
"{\"0\": [] }"
prop_golden_5 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": [] }|]
(txMetadataSingleton 0 (TxMetaList []))

prop_golden_6 :: Property
prop_golden_6 = matchMetadata
"{\"0\": [1, \"a\", \"0x42\"] }"
prop_golden_6 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": [1, "a", "0x42"] }|]
(txMetadataSingleton 0
(TxMetaList [TxMetaNumber 1
,TxMetaText "a"
,TxMetaBytes "\x42"]))

prop_golden_7 :: Property
prop_golden_7 = matchMetadata
"{\"0\": {} }"
prop_golden_7 = matchMetadata TxMetadataJsonNoSchema
[q|{"0": {} }|]
(txMetadataSingleton 0 (TxMetaMap []))

prop_golden_8 :: Property
prop_golden_8 = matchMetadata
"{\"0\": { \"0x41\": \"0x42\", \"1\": 2, \"a\" : \"b\" }}"
(txMetadataSingleton 0
(TxMetaMap [(TxMetaBytes "\x41", TxMetaBytes "\x42")
,(TxMetaNumber 1, TxMetaNumber 2)
,(TxMetaText "a", TxMetaText "b")]))
prop_golden_8 =
matchMetadata TxMetadataJsonNoSchema
[q|{"0": {
"0x41": "0x42",
"0x154041": "0x44",
"0x104041": "0x43",
"0x3041": "0x45",
"aab": "ba",
"abb": "ba",
"11": 3,
"1": 2,
"a": "b",
"aa": "bb",
"ab": "ba",
"aba": {
"0x41": "0x42",
"0x154041": "0x44",
"0x104041": "0x43",
"0x3041": "0x45",
"aab": "ba",
"abb": "ba",
"11": 3,
"1": 2,
"a": "b",
"aa": "bb",
"ab": "ba"
}
}}|]
( txMetadataSingleton 0
( TxMetaMap
[ ( TxMetaNumber 1 , TxMetaNumber 2 )
, ( TxMetaNumber 11 , TxMetaNumber 3 )
, ( TxMetaBytes "A" , TxMetaBytes "B" )
, ( TxMetaText "a" , TxMetaText "b" )
, ( TxMetaBytes "0A" , TxMetaBytes "E" )
, ( TxMetaText "aa" , TxMetaText "bb" )
, ( TxMetaText "ab" , TxMetaText "ba" )
, ( TxMetaBytes "\DLE@A" , TxMetaBytes "C" )
, ( TxMetaBytes "\NAK@A" , TxMetaBytes "D" )
, ( TxMetaText "aab" , TxMetaText "ba" )
, ( TxMetaText "aba"
, TxMetaMap
[ ( TxMetaNumber 1 , TxMetaNumber 2 )
, ( TxMetaNumber 11 , TxMetaNumber 3 )
, ( TxMetaBytes "A" , TxMetaBytes "B" )
, ( TxMetaText "a" , TxMetaText "b" )
, ( TxMetaBytes "0A" , TxMetaBytes "E" )
, ( TxMetaText "aa" , TxMetaText "bb" )
, ( TxMetaText "ab" , TxMetaText "ba" )
, ( TxMetaBytes "\DLE@A" , TxMetaBytes "C" )
, ( TxMetaBytes "\NAK@A" , TxMetaBytes "D" )
, ( TxMetaText "aab" , TxMetaText "ba" )
, ( TxMetaText "abb" , TxMetaText "ba" )
]
)
, ( TxMetaText "abb" , TxMetaText "ba" )
]
))

prop_golden_9 :: Property
prop_golden_9 =
matchMetadata TxMetadataJsonDetailedSchema
[q|{"0":
{"map":
[ { "k": {"string": "aaa"}
, "v": {"string": "b4"}
}
, { "k": {"int": 1}
, "v": {"string": "b6"}
}
, { "k": {"string": "aa"}
, "v": {"string": "b2"}
}
, { "k": {"string": "ab"}
, "v": {"string": "b3"}
}
, { "k": {"string": "b"}
, "v": {"string": "b5"}
}
, { "k": {"string": "a"}
, "v": {"string": "b1"}
}
]
}}|]
( txMetadataSingleton 0
( TxMetaMap
[ ( TxMetaText "aaa" , TxMetaText "b4" )
, ( TxMetaNumber 1 , TxMetaText "b6" )
, ( TxMetaText "aa" , TxMetaText "b2" )
, ( TxMetaText "ab" , TxMetaText "b3" )
, ( TxMetaText "b" , TxMetaText "b5" )
, ( TxMetaText "a" , TxMetaText "b1" )
]
))

txMetadataSingleton :: Word64 -> TxMetadataValue -> TxMetadata
txMetadataSingleton n v = TxMetadata (Map.fromList [(n, v)])

matchMetadata :: ByteString -> TxMetadata -> Property
matchMetadata jsonStr metadata =
Hedgehog.withTests 1 $ Hedgehog.property $ Hedgehog.test $
case Aeson.decodeStrict' jsonStr of
Nothing -> Hedgehog.failure
Just json -> do
Hedgehog.annotateShow json
metadataFromJson TxMetadataJsonNoSchema json === Right metadata

matchMetadata :: HasCallStack
=> TxMetadataJsonSchema
-> ByteString -- ^ json string to test
-> TxMetadata -- ^ expected metadata
Comment on lines +174 to +175
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
-> ByteString -- ^ json string to test
-> TxMetadata -- ^ expected metadata
-> ByteString -- ^ Json string to test
-> TxMetadata -- ^ Expected metadata

-> Property
matchMetadata hasSchema jsonStr expectedMetadata = withFrozenCallStack $ H.propertyOnce $ do
json <- H.noteShowM . H.nothingFail $ Aeson.decodeStrict' jsonStr
metadata <- H.noteShowM . H.leftFail $ metadataFromJson hasSchema json
metadata === expectedMetadata

-- ----------------------------------------------------------------------------
-- Round trip properties
Expand All @@ -99,17 +191,17 @@ matchMetadata jsonStr metadata =
-- original value.
--
prop_noschema_json_roundtrip_via_metadata :: Property
prop_noschema_json_roundtrip_via_metadata = Hedgehog.property $ do
json <- Hedgehog.forAll (genJsonForTxMetadata TxMetadataJsonNoSchema)
prop_noschema_json_roundtrip_via_metadata = H.property $ do
json <- H.forAll (genJsonForTxMetadata TxMetadataJsonNoSchema)
Right json === (fmap (metadataToJson TxMetadataJsonNoSchema)
. metadataFromJson TxMetadataJsonNoSchema) json

-- | Any JSON (fitting the detailed schema) can be converted to tx metadata and
-- back, to give the same original JSON.
--
prop_schema_json_roundtrip_via_metadata :: Property
prop_schema_json_roundtrip_via_metadata = Hedgehog.property $ do
json <- Hedgehog.forAll (genJsonForTxMetadata TxMetadataJsonDetailedSchema)
prop_schema_json_roundtrip_via_metadata = H.property $ do
json <- H.forAll (genJsonForTxMetadata TxMetadataJsonDetailedSchema)
Right json === (fmap (metadataToJson TxMetadataJsonDetailedSchema)
. metadataFromJson TxMetadataJsonDetailedSchema) json

Expand All @@ -118,8 +210,8 @@ prop_schema_json_roundtrip_via_metadata = Hedgehog.property $ do
-- back, to give the same original tx metadata.
--
prop_metadata_roundtrip_via_schema_json :: Property
prop_metadata_roundtrip_via_schema_json = Hedgehog.property $ do
md <- Hedgehog.forAll genTxMetadata
prop_metadata_roundtrip_via_schema_json = H.property $ do
md <- H.forAll genTxMetadata
Right md === (metadataFromJson TxMetadataJsonDetailedSchema
. metadataToJson TxMetadataJsonDetailedSchema) md

Expand All @@ -129,19 +221,19 @@ prop_metadata_chunks
-> (str -> TxMetadataValue)
-> (TxMetadataValue -> Maybe str)
-> Property
prop_metadata_chunks genStr toMetadataValue extractChunk = Hedgehog.property $ do
str <- Hedgehog.forAll genStr
prop_metadata_chunks genStr toMetadataValue extractChunk = H.property $ do
str <- H.forAll genStr
case toMetadataValue str of
metadataValue@(TxMetaList chunks) -> do
Hedgehog.cover 1 "Empty chunks" (null chunks)
Hedgehog.cover 5 "Single chunks" (length chunks == 1)
Hedgehog.cover 25 "Many chunks" (length chunks > 1)
H.cover 1 "Empty chunks" (null chunks)
H.cover 5 "Single chunks" (length chunks == 1)
H.cover 25 "Many chunks" (length chunks > 1)
str === mconcat (mapMaybe extractChunk chunks)
Right () === validateTxMetadata metadata
where
metadata = makeTransactionMetadata (Map.singleton 0 metadataValue)
_ ->
Hedgehog.failure
H.failure

prop_metadata_text_chunks :: Property
prop_metadata_text_chunks =
Expand Down Expand Up @@ -177,6 +269,7 @@ tests = testGroup "Test.Cardano.Api.Metadata"
, testProperty "golden 6" prop_golden_6
, testProperty "golden 7" prop_golden_7
, testProperty "golden 8" prop_golden_8
, testProperty "golden 9" prop_golden_9
, testProperty "noschema json roundtrip via metadata" prop_noschema_json_roundtrip_via_metadata
, testProperty "schema json roundtrip via metadata" prop_schema_json_roundtrip_via_metadata
, testProperty "metadata roundtrip via schema json" prop_metadata_roundtrip_via_schema_json
Expand Down
Loading