Merge pull request #1059 from IntersectMBO/backport/10.19/fix-canonical-cbor-bug

[backport for 10.19] Fix canonical CBOR bug

Author: palas

cardano-api/src/Cardano/Api/Serialise/Cbor/Canonical.hs

@@ -67,7 +67,9 @@ canonicaliseTerm = \case
   (TTagged tag term) ->
     TTagged tag $ canonicaliseTerm term
   (TListI terms) ->
-    TList terms
+    TList $ map canonicaliseTerm terms
+  (TList terms) ->
+    TList $ map canonicaliseTerm terms
   term -> term
 
 -- | Implements sorting of CBOR terms for canonicalisation. CBOR terms are compared by lexical order of their

cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs

@@ -25,6 +25,7 @@ import Data.ByteString.Short qualified as SBS
 import Data.List (sortOn)
 import Data.Text (Text)
 import Data.Text qualified as T
+import GHC.Stack (callStack)
 import GHC.Stack qualified as GHC
 
 import Test.Gen.Cardano.Api.Hardcoded
@@ -380,15 +381,27 @@ prop_canonicalise_cbor = property $ do
           , (TBytes "bb", TString "h")
           , (TBytes "ba", TListI [TString "i", TString "j"])
           ]
-      inputMapBs = CBOR.serialize' inputMap
-  inputMapTerm <- decodeExampleTerm inputMapBs
+      inputMapInIndefiniteList = TListI [inputMap]
+      inputMapInDefiniteList = TList [inputMap]
 
-  inputMapCanonicalisedBs <- H.leftFail $ canonicaliseCborBs inputMapBs
+  input <- forAll $ Gen.element [inputMap, inputMapInIndefiniteList, inputMapInDefiniteList]
+  let inputBs = CBOR.serialize' input
 
-  inputMapCanonicalisedTerm@(TMap elemTerms) <- decodeExampleTerm inputMapCanonicalisedBs
+  inputTerm <- decodeExampleTerm inputBs
+
+  inputCanonicalisedBs <- H.leftFail $ canonicaliseCborBs inputBs
+
+  decodedTerm <- decodeExampleTerm inputCanonicalisedBs
+  inputMapCanonicalisedTerm@(TMap elemTerms) <-
+    case decodedTerm of
+      TMap elemTerms -> pure $ TMap elemTerms
+      TList [TMap elemTerms] -> pure $ TMap elemTerms
+      t ->
+        H.failMessage callStack $
+          "Expected canonicalised term to be a map or a list with a single map: " <> show t
 
   H.annotate "sanity check that cbor round trip does not change the order"
-  inputMap === inputMapTerm
+  input === inputTerm
 
   H.annotate "Print bytes hex representation of the keys in the map"
   H.annotateShow