Merge pull request #785 from IntersectMBO/mgalazyn/feature/sort-tx-maps

carbolymer · web-flow · commit c91a37c9b372 · 2025-04-04T08:28:26.000Z
Sort transaction fields in CBOR representation
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -90,6 +90,7 @@ library
     Cardano.Api.Internal.ProtocolParameters
     Cardano.Api.Internal.Query
     Cardano.Api.Internal.Script
+    Cardano.Api.Internal.Serialise.Cbor.Canonical
     Cardano.Api.Internal.SerialiseLedgerCddl
     Cardano.Api.Internal.SerialiseTextEnvelope
     Cardano.Api.Internal.Tx.Body
@@ -254,8 +255,8 @@ library
     Cardano.Api.Internal.ReexposeNetwork
     Cardano.Api.Internal.Rewards
     Cardano.Api.Internal.ScriptData
+    Cardano.Api.Internal.Serialise.Cbor
     Cardano.Api.Internal.SerialiseBech32
-    Cardano.Api.Internal.SerialiseCBOR
     Cardano.Api.Internal.SerialiseJSON
     Cardano.Api.Internal.SerialiseRaw
     Cardano.Api.Internal.SerialiseUsing
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -758,6 +758,7 @@ module Cardano.Api
   , readFileTextEnvelopeCddlAnyOf
   , deserialiseFromTextEnvelopeCddlAnyOf
   , writeTxFileTextEnvelopeCddl
+  , writeTxFileTextEnvelopeCanonicalCddl
   , writeTxWitnessFileTextEnvelopeCddl
   , deserialiseByronTxCddl
   , serialiseWitnessLedgerCddl
@@ -1158,8 +1159,8 @@ import Cardano.Api.Internal.Query.Expr
 import Cardano.Api.Internal.Rewards
 import Cardano.Api.Internal.Script
 import Cardano.Api.Internal.ScriptData
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseBech32
-import Cardano.Api.Internal.SerialiseCBOR
 import Cardano.Api.Internal.SerialiseJSON
 import Cardano.Api.Internal.SerialiseLedgerCddl
 import Cardano.Api.Internal.SerialiseRaw
diff --git a/cardano-api/src/Cardano/Api/Internal/Certificate.hs b/cardano-api/src/Cardano/Api/Internal/Certificate.hs
@@ -94,7 +94,7 @@ import Cardano.Api.Internal.Keys.Shelley
 import Cardano.Api.Internal.Pretty (Doc)
 import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
 import Cardano.Api.Internal.Script
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.StakePoolMetadata
 import Cardano.Api.Internal.Utils (noInlineMaybeToStrictMaybe)
diff --git a/cardano-api/src/Cardano/Api/Internal/Governance/Actions/ProposalProcedure.hs b/cardano-api/src/Cardano/Api/Internal/Governance/Actions/ProposalProcedure.hs
@@ -17,7 +17,7 @@ import Cardano.Api.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.ProtocolParameters
 import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.TxIn
 
diff --git a/cardano-api/src/Cardano/Api/Internal/Governance/Actions/VotingProcedure.hs b/cardano-api/src/Cardano/Api/Internal/Governance/Actions/VotingProcedure.hs
@@ -20,7 +20,7 @@ import Cardano.Api.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Internal.Governance.Actions.ProposalProcedure
 import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseTextEnvelope
 
 import Cardano.Binary qualified as CBOR
diff --git a/cardano-api/src/Cardano/Api/Internal/Governance/Poll.hs b/cardano-api/src/Cardano/Api/Internal/Governance/Poll.hs
@@ -41,7 +41,7 @@ import Cardano.Api.Internal.Eras
 import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Hash
 import Cardano.Api.Internal.Keys.Shelley
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.SerialiseUsing
diff --git a/cardano-api/src/Cardano/Api/Internal/Keys/Byron.hs b/cardano-api/src/Cardano/Api/Internal/Keys/Byron.hs
@@ -32,7 +32,7 @@ import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Hash
 import Cardano.Api.Internal.Keys.Class
 import Cardano.Api.Internal.Keys.Shelley
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.SerialiseUsing
diff --git a/cardano-api/src/Cardano/Api/Internal/Keys/Praos.hs b/cardano-api/src/Cardano/Api/Internal/Keys/Praos.hs
@@ -28,8 +28,8 @@ where
 import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Hash
 import Cardano.Api.Internal.Keys.Class
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseBech32
-import Cardano.Api.Internal.SerialiseCBOR
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.SerialiseUsing
diff --git a/cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs b/cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs
@@ -45,8 +45,8 @@ import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Hash
 import Cardano.Api.Internal.Keys.Class
 import Cardano.Api.Internal.Pretty
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseBech32
-import Cardano.Api.Internal.SerialiseCBOR
 import Cardano.Api.Internal.SerialiseJSON
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
diff --git a/cardano-api/src/Cardano/Api/Internal/OperationalCertificate.hs b/cardano-api/src/Cardano/Api/Internal/OperationalCertificate.hs
@@ -27,7 +27,7 @@ import Cardano.Api.Internal.Keys.Class
 import Cardano.Api.Internal.Keys.Praos
 import Cardano.Api.Internal.Keys.Shelley
 import Cardano.Api.Internal.ProtocolParameters
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.Tx.Sign
 
diff --git a/cardano-api/src/Cardano/Api/Internal/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/Internal/ProtocolParameters.hs
@@ -104,7 +104,7 @@ import Cardano.Api.Internal.Keys.Shelley
 import Cardano.Api.Internal.Orphans ()
 import Cardano.Api.Internal.Pretty
 import Cardano.Api.Internal.Script
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
 import Cardano.Api.Internal.SerialiseUsing
diff --git a/cardano-api/src/Cardano/Api/Internal/Query.hs b/cardano-api/src/Cardano/Api/Internal/Query.hs
@@ -79,7 +79,7 @@ import Cardano.Api.Internal.Modes
 import Cardano.Api.Internal.NetworkId
 import Cardano.Api.Internal.Query.Types
 import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
-import Cardano.Api.Internal.SerialiseCBOR (SerialiseAsCBOR (deserialiseFromCBOR, serialiseToCBOR))
+import Cardano.Api.Internal.Serialise.Cbor (SerialiseAsCBOR (deserialiseFromCBOR, serialiseToCBOR))
 import Cardano.Api.Internal.SerialiseTextEnvelope
   ( HasTextEnvelope (textEnvelopeType)
   , TextEnvelopeType
diff --git a/cardano-api/src/Cardano/Api/Internal/Script.hs b/cardano-api/src/Cardano/Api/Internal/Script.hs
@@ -130,7 +130,7 @@ import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Hash
 import Cardano.Api.Internal.Keys.Shelley
 import Cardano.Api.Internal.ScriptData
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseJSON
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseTextEnvelope
diff --git a/cardano-api/src/Cardano/Api/Internal/ScriptData.hs b/cardano-api/src/Cardano/Api/Internal/ScriptData.hs
@@ -51,7 +51,7 @@ import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.Hash
 import Cardano.Api.Internal.Keys.Shelley
 import Cardano.Api.Internal.Pretty
-import Cardano.Api.Internal.SerialiseCBOR
+import Cardano.Api.Internal.Serialise.Cbor
 import Cardano.Api.Internal.SerialiseJSON
 import Cardano.Api.Internal.SerialiseRaw
 import Cardano.Api.Internal.SerialiseUsing
diff --git a/cardano-api/src/Cardano/Api/Internal/Serialise/Cbor.hs b/cardano-api/src/Cardano/Api/Internal/Serialise/Cbor.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DefaultSignatures #-}
 
 -- | CBOR serialisation
-module Cardano.Api.Internal.SerialiseCBOR
+module Cardano.Api.Internal.Serialise.Cbor
   ( SerialiseAsCBOR (..)
   , FromCBOR (..)
   , ToCBOR (..)
diff --git a/cardano-api/src/Cardano/Api/Internal/Serialise/Cbor/Canonical.hs b/cardano-api/src/Cardano/Api/Internal/Serialise/Cbor/Canonical.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.Api.Internal.Serialise.Cbor.Canonical
+  ( canonicaliseCborBs
+  , canonicaliseTerm
+  )
+where
+
+import Cardano.Api.Internal.HasTypeProxy
+import Cardano.Api.Internal.Serialise.Cbor
+
+import Cardano.Binary (DecoderError (..))
+
+import Codec.CBOR.Read (deserialiseFromBytes)
+import Codec.CBOR.Term
+  ( Term (..)
+  , decodeTerm
+  , encodeTerm
+  )
+import Codec.CBOR.Write (toBuilder)
+import Control.Monad
+import Control.Monad.Except
+import Data.Bifunctor (first)
+import Data.ByteString qualified as BS
+import Data.ByteString.Builder qualified as BSB
+import Data.ByteString.Lazy qualified as LBS
+import Data.List (sortBy)
+import Data.Tuple.Extra (both)
+
+-- | This function implements CBOR canonicalisation (RFC 7049):
+--
+-- * Map keys are sorted lexicographically
+-- * Indefinite-length maps/lists are converted to finite-length maps/lists
+-- * The representation of the CBOR major types is as small as possible (provided by "cborg" package)
+--
+-- This function implements only CBOR canonicalisation from CIP-21. Other requirements from CIP-21 are not implemented.
+--
+-- 1. CBOR RFC 7049, Canonicalisation description: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
+-- 2. CIP-21: https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format
+canonicaliseCborBs :: BS.ByteString -> Either DecoderError BS.ByteString
+canonicaliseCborBs originalCborBytes = serialiseToCBOR . canonicaliseTerm <$> deserialiseFromCBOR AsTerm originalCborBytes
+
+decodeTermFromBs
+  :: LBS.ByteString
+  -> Either DecoderError Term
+decodeTermFromBs input = do
+  (leftover, result) <-
+    first (DecoderErrorDeserialiseFailure "Cannot decode Term") $
+      deserialiseFromBytes decodeTerm input
+  unless (LBS.null leftover) $ do
+    throwError $
+      DecoderErrorLeftover "Invalid CBOR: some bytes were not consumed" (LBS.toStrict leftover)
+  pure result
+
+-- | This function implements CBOR canonicalisation at the Term level:
+--
+-- * Map keys are sorted lexicographically
+-- * Indefinite-length maps/lists are converted to finite-length maps/lists
+canonicaliseTerm :: Term -> Term
+canonicaliseTerm = \case
+  (TMap termPairs) ->
+    TMap . sortBy compareKeyTerms $ map (both canonicaliseTerm) termPairs
+  (TMapI termPairs) ->
+    TMap . sortBy compareKeyTerms $ map (both canonicaliseTerm) termPairs
+  (TTagged tag term) ->
+    TTagged tag $ canonicaliseTerm term
+  (TListI terms) ->
+    TList terms
+  term -> term
+
+-- | Implements sorting of CBOR terms for canonicalisation. CBOR terms are compared by lexical order of their
+-- bytes representation. We are only sorting the keys of the map here.
+-- See: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
+compareKeyTerms
+  :: (Term, a)
+  -- ^ (key, value) from a map
+  -> (Term, a)
+  -> Ordering
+compareKeyTerms (t1, _) (t2, _) = compare (serialiseToCBOR t1) (serialiseToCBOR t2)
+
+instance HasTypeProxy Term where
+  data AsType Term = AsTerm
+  proxyToAsType _ = AsTerm
+
+instance SerialiseAsCBOR Term where
+  serialiseToCBOR = LBS.toStrict . BSB.toLazyByteString . toBuilder . encodeTerm
+  deserialiseFromCBOR _proxy = decodeTermFromBs . LBS.fromStrict
diff --git a/cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs
@@ -20,6 +20,7 @@ module Cardano.Api.Internal.SerialiseLedgerCddl
   , readFileTextEnvelopeCddlAnyOf
   , deserialiseFromTextEnvelopeCddlAnyOf
   , writeTxFileTextEnvelopeCddl
+  , writeTxFileTextEnvelopeCanonicalCddl
   , writeTxWitnessFileTextEnvelopeCddl
   -- Exported for testing
   , deserialiseByronTxCddl
@@ -37,13 +38,15 @@ import Cardano.Api.Internal.Error
 import Cardano.Api.Internal.HasTypeProxy
 import Cardano.Api.Internal.IO
 import Cardano.Api.Internal.Pretty
+import Cardano.Api.Internal.Serialise.Cbor.Canonical
 import Cardano.Api.Internal.SerialiseTextEnvelope
   ( TextEnvelope (..)
   , TextEnvelopeDescr (TextEnvelopeDescr)
   , TextEnvelopeError (..)
   , TextEnvelopeType (TextEnvelopeType)
   , deserialiseFromTextEnvelope
   , legacyComparison
+  , serialiseTextEnvelope
   , serialiseToTextEnvelope
   )
 import Cardano.Api.Internal.Tx.Sign
@@ -55,13 +58,11 @@ import Cardano.Ledger.Binary qualified as CBOR
 
 import Control.Monad.Trans.Except.Extra
   ( firstExceptT
-  , handleIOExceptT
   , hoistEither
   , newExceptT
   , runExceptT
   )
 import Data.Aeson qualified as Aeson
-import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder)
 import Data.Bifunctor (first)
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy qualified as LBS
@@ -134,11 +135,10 @@ writeByronTxFileTextEnvelopeCddl
   :: File content Out
   -> Byron.ATxAux ByteString
   -> IO (Either (FileError ()) ())
-writeByronTxFileTextEnvelopeCddl path w =
-  runExceptT $ do
-    handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson
- where
-  txJson = encodePretty' textEnvelopeCddlJSONConfig (serializeByronTx w) <> "\n"
+writeByronTxFileTextEnvelopeCddl path =
+  writeLazyByteStringFile path
+    . serialiseTextEnvelope
+    . serializeByronTx
 
 serializeByronTx :: Byron.ATxAux ByteString -> TextEnvelope
 serializeByronTx tx =
@@ -211,39 +211,59 @@ deserialiseWitnessLedgerCddl sbe te =
   legacyDecoding _ v = v
 
 writeTxFileTextEnvelopeCddl
-  :: ()
-  => ShelleyBasedEra era
+  :: ShelleyBasedEra era
   -> File content Out
   -> Tx era
   -> IO (Either (FileError ()) ())
-writeTxFileTextEnvelopeCddl era path tx =
-  runExceptT $ do
-    handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson
+writeTxFileTextEnvelopeCddl sbe path =
+  writeLazyByteStringFile path
+    . serialiseTextEnvelope
+    . serialiseTxToTextEnvelope sbe
+
+-- | Write transaction in the text envelope format. The CBOR will be in canonical format according
+-- to RFC 7049. It is also a requirement of CIP-21, which is not fully implemented.
+--
+-- 1. RFC 7049: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
+-- 2. CIP-21: https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format
+writeTxFileTextEnvelopeCanonicalCddl
+  :: ShelleyBasedEra era
+  -> File content Out
+  -> Tx era
+  -> IO (Either (FileError ()) ())
+writeTxFileTextEnvelopeCanonicalCddl sbe path =
+  writeLazyByteStringFile path
+    . serialiseTextEnvelope
+    . canonicaliseTextEnvelopeCbor
+    . serialiseTxToTextEnvelope sbe
  where
-  txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseTxLedgerCddl era tx) <> "\n"
+  canonicaliseTextEnvelopeCbor :: TextEnvelope -> TextEnvelope
+  canonicaliseTextEnvelopeCbor te = do
+    let canonicalisedTxBs =
+          either
+            ( \err ->
+                error $
+                  "writeTxFileTextEnvelopeCanonicalCddl: Impossible - deserialisation of just serialised bytes failed "
+                    <> show err
+            )
+            id
+            . canonicaliseCborBs
+            $ teRawCBOR te
+    te{teRawCBOR = canonicalisedTxBs}
 
-  serialiseTxLedgerCddl :: ShelleyBasedEra era -> Tx era -> TextEnvelope
-  serialiseTxLedgerCddl era' tx' =
-    shelleyBasedEraConstraints era' $
-      serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format")) tx'
+serialiseTxToTextEnvelope :: ShelleyBasedEra era -> Tx era -> TextEnvelope
+serialiseTxToTextEnvelope era' tx' =
+  shelleyBasedEraConstraints era' $ do
+    serialiseToTextEnvelope (Just "Ledger Cddl Format") tx'
 
 writeTxWitnessFileTextEnvelopeCddl
   :: ShelleyBasedEra era
   -> File () Out
   -> KeyWitness era
   -> IO (Either (FileError ()) ())
-writeTxWitnessFileTextEnvelopeCddl sbe path w =
-  runExceptT $ do
-    handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson
- where
-  txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseWitnessLedgerCddl sbe w) <> "\n"
-
-textEnvelopeCddlJSONConfig :: Config
-textEnvelopeCddlJSONConfig =
-  defConfig{confCompare = textEnvelopeCddlJSONKeyOrder}
-
-textEnvelopeCddlJSONKeyOrder :: Text -> Text -> Ordering
-textEnvelopeCddlJSONKeyOrder = keyOrder ["type", "description", "cborHex"]
+writeTxWitnessFileTextEnvelopeCddl sbe path =
+  writeLazyByteStringFile path
+    . serialiseTextEnvelope
+    . serialiseWitnessLedgerCddl sbe
 
 -- | This GADT allows us to deserialise a tx or key witness without
 -- having to provide the era.
diff --git a/cardano-api/src/Cardano/Api/Internal/SerialiseTextEnvelope.hs b/cardano-api/src/Cardano/Api/Internal/SerialiseTextEnvelope.hs
diff --git a/cardano-api/src/Cardano/Api/Internal/SerialiseUsing.hs b/cardano-api/src/Cardano/Api/Internal/SerialiseUsing.hs
diff --git a/cardano-api/src/Cardano/Api/Internal/Tx/Body.hs b/cardano-api/src/Cardano/Api/Internal/Tx/Body.hs
diff --git a/cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs b/cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs
diff --git a/cardano-api/src/Cardano/Api/Internal/TxMetadata.hs b/cardano-api/src/Cardano/Api/Internal/TxMetadata.hs
diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs
