Review remarks

Author: carbolymer

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

@@ -29,15 +29,16 @@ import Data.ByteString.Lazy qualified as LBS
 import Data.List (sortBy)
 import Data.Tuple.Extra (both)
 
--- | This function implements CBOR canonicalisation:
+-- | 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 canonicalisation from CIP-29:
--- https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format
--- See also: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
+-- 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
 

cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs

@@ -46,6 +46,7 @@ import Cardano.Api.Internal.SerialiseTextEnvelope
   , TextEnvelopeType (TextEnvelopeType)
   , deserialiseFromTextEnvelope
   , legacyComparison
+  , serialiseTextEnvelope
   , serialiseToTextEnvelope
   )
 import Cardano.Api.Internal.Tx.Sign
@@ -57,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
@@ -136,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 =
@@ -217,63 +215,51 @@ writeTxFileTextEnvelopeCddl
   -> File content Out
   -> Tx era
   -> IO (Either (FileError ()) ())
-writeTxFileTextEnvelopeCddl sbe = writeTxFileTextEnvelopeCddl' sbe False
+writeTxFileTextEnvelopeCddl sbe path =
+  writeLazyByteStringFile path
+    . serialiseTextEnvelope
+    . serialiseTxToTextEnvelope sbe
 
--- | Write transaction in the text envelope format, the CBOR will be in canonical format according
--- to CIP-21 https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format
+-- | 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 = writeTxFileTextEnvelopeCddl' sbe True
-
-writeTxFileTextEnvelopeCddl'
-  :: ()
-  => ShelleyBasedEra era
-  -> Bool
-  -- ^ True to produce canonical CBOR
-  -> File content Out
-  -> Tx era
-  -> IO (Either (FileError ()) ())
-writeTxFileTextEnvelopeCddl' era isCanonicalCbor path tx =
-  runExceptT $ do
-    handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson
+writeTxFileTextEnvelopeCanonicalCddl sbe path =
+  writeLazyByteStringFile path
+    . serialiseTextEnvelope
+    . canonicaliseTextEnvelopeCbor
+    . serialiseTxToTextEnvelope sbe
  where
-  txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseTxLedgerCddl era tx) <> "\n"
-
-  serialiseTxLedgerCddl :: ShelleyBasedEra era -> Tx era -> TextEnvelope
-  serialiseTxLedgerCddl era' tx' =
-    shelleyBasedEraConstraints era' $ do
-      let te = serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format")) tx'
-      if isCanonicalCbor
-        then do
-          let canonicalisedTxBs =
-                either
-                  (\err -> error $ "Impossible - deserialisation of just serialised bytes failed " <> show err)
-                  id
-                  . canonicaliseCborBs
-                  $ teRawCBOR te
-          te{teRawCBOR = canonicalisedTxBs}
-        else te
+  canonicaliseTextEnvelopeCbor :: TextEnvelope -> TextEnvelope
+  canonicaliseTextEnvelopeCbor te = do
+    let canonicalisedTxBs =
+          either
+            (\err -> error $ "Impossible - deserialisation of just serialised bytes failed " <> show err)
+            id
+            . canonicaliseCborBs
+            $ teRawCBOR te
+    te{teRawCBOR = canonicalisedTxBs}
+
+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.

cardano-api/src/Cardano/Api/Internal/SerialiseTextEnvelope.hs

@@ -25,6 +25,7 @@ module Cardano.Api.Internal.SerialiseTextEnvelope
   , readTextEnvelopeFromFile
   , readTextEnvelopeOfTypeFromFile
   , textEnvelopeToJSON
+  , serialiseTextEnvelope
   , legacyComparison
 
     -- * Reading one of several key types
@@ -115,11 +116,11 @@ instance FromJSON TextEnvelope where
     parseJSONBase16 v =
       either fail return . Base16.decode . Text.encodeUtf8 =<< parseJSON v
 
-textEnvelopeJSONConfig :: Config
-textEnvelopeJSONConfig = defConfig{confCompare = textEnvelopeJSONKeyOrder}
+textEnvelopeJsonConfig :: Config
+textEnvelopeJsonConfig = defConfig{confCompare = textEnvelopeJsonKeyOrder}
 
-textEnvelopeJSONKeyOrder :: Text -> Text -> Ordering
-textEnvelopeJSONKeyOrder = keyOrder ["type", "description", "cborHex"]
+textEnvelopeJsonKeyOrder :: Text -> Text -> Ordering
+textEnvelopeJsonKeyOrder = keyOrder ["type", "description", "cborHex"]
 
 textEnvelopeRawCBOR :: TextEnvelope -> ByteString
 textEnvelopeRawCBOR = teRawCBOR
@@ -254,7 +255,11 @@ writeFileTextEnvelope outputFile mbDescr a =
 
 textEnvelopeToJSON :: HasTextEnvelope a => Maybe TextEnvelopeDescr -> a -> LBS.ByteString
 textEnvelopeToJSON mbDescr a =
-  encodePretty' textEnvelopeJSONConfig (serialiseToTextEnvelope mbDescr a) <> "\n"
+  serialiseTextEnvelope $ serialiseToTextEnvelope mbDescr a
+
+-- | Serialise text envelope to pretty JSON
+serialiseTextEnvelope :: TextEnvelope -> LBS.ByteString
+serialiseTextEnvelope te = encodePretty' textEnvelopeJsonConfig te <> "\n"
 
 readFileTextEnvelope
   :: HasTextEnvelope a

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

@@ -348,7 +348,7 @@ prop_roundtrip_GovernancePollAnswer_CBOR :: Property
 prop_roundtrip_GovernancePollAnswer_CBOR = property $ do
   H.trippingCbor AsGovernancePollAnswer =<< forAll genGovernancePollAnswer
 
--- | Test CBOR canonicalisation (according to CIP-21)
+-- | Test CBOR canonicalisation (according to RFC 7049, part of CIP-21)
 -- We're only testing ordering of the map keys and converting to finite collections here
 -- - the smallest representation is implemented in cborg library.
 prop_canonicalise_cbor :: Property