Upgrade to hydra-0.16

Hydra 0.16 drops JSON encoding of transactions in favour of a CBOR representation only. This updates the hydra submodule to provide a golden test file in the new format.

Co-Authored by Daniel Firth <[email protected]>

Author: ffakenz

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 #### Added
 
+* Compatibility with hydra-node 0.16.0.
+
 - A new mode `--read-only` which can be used to boot-up an HTTP server with only read access to the underlying database. This option comes as an alternative to the other options for chain producers (e.g. `--node-socket` and `--node-config`). The replica can only reply successfully to GET queries with the exception of queries under `/metadata`. The latter must go through the master server.
 
 - Automatic restart and setup indexes when `--defer-db-indexes` is provided and the tip of the chain is reached.

kupo.cabal

@@ -9,12 +9,25 @@ import Cardano.Crypto.Hash
     , hashToBytes
     , hashWith
     )
+import Cardano.Ledger.Allegra.Scripts (translateTimelock)
+import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
+import Cardano.Ledger.Alonzo.TxWits (unTxDats)
+import Cardano.Ledger.Api (
+    outputsTxBodyL,
+    inputsTxBodyL,
+    datsTxWitsL,
+    scriptTxWitsL,
+    witsTxL,
+    bodyTxL
+    )
+import Cardano.Ledger.Binary (decodeFullAnnotator)
+import Cardano.Ledger.Block (txid)
+import Cardano.Ledger.Plutus.Data (translateDatum, dataToBinaryData, upgradeData)
 import Cardano.Ledger.SafeHash
     ( unsafeMakeSafeHash
     )
 import Data.Aeson
-    ( (.!=)
-    , (.:)
+    ( (.:)
     , (.:?)
     )
 import Kupo.Data.Cardano
@@ -57,7 +70,9 @@ import Kupo.Data.PartialBlock
     ( PartialBlock (..)
     , PartialTransaction (..)
     )
-
+import qualified Cardano.Ledger.Api as LedgerApi
+import qualified Cardano.Ledger.Babbage.TxBody as Babbage
+import qualified Cardano.Ledger.Core as Ledger
 import qualified Codec.CBOR.Decoding as Cbor
 import qualified Codec.CBOR.Read as Cbor
 import qualified Data.Aeson.Key as Key
@@ -156,15 +171,21 @@ decodeGenesisTxForUTxO id indexOutputs = do
 
 decodePartialTransaction :: Json.Value -> Json.Parser PartialTransaction
 decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do
-    id <- o .: "id" >>= decodeTransactionId
+    hexText <- o .: "cborHex"
+
+    bytes <- decodeBase16' hexText
 
-    body <- o .: "body"
-    inputs <- body .: "inputs" >>= traverse decodeInput
-    outputs <- body .:? "outputs" .!= [] >>= traverse decodeOutput
+    tx <- case decodeFullAnnotator (Ledger.eraProtVerLow @(BabbageEra StandardCrypto)) "foo" decCBOR (fromStrict bytes) of
+      Left e -> fail $ show e
+      Right tx -> pure tx
 
-    wits <- o.: "witnesses"
-    datums <- wits .:? "datums" .!= Json.Object mempty >>= decodeDatums
-    scripts <- wits .:? "scripts" .!= Json.Object mempty >>= decodeScripts
+    let body' = tx ^. bodyTxL
+    let inputs = toList (body' ^. inputsTxBodyL)
+    let outputs = map convertOutput $ toList (body' ^. outputsTxBodyL)
+    let wits' = tx ^. witsTxL
+    let scripts = Map.map convertScript (wits' ^. scriptTxWitsL)
+    let datums = Map.map convertData $ unTxDats (wits' ^. datsTxWitsL)
+    let id = txid body'
 
     -- TODO
     -- This is 'acceptable' for now because:
@@ -185,6 +206,18 @@ decodePartialTransaction = Json.withObject "PartialTransaction" $ \o -> do
         , scripts
         , metadata
         }
+    where
+        convertOutput :: Babbage.BabbageTxOut (BabbageEra StandardCrypto) -> Output
+        convertOutput (Babbage.BabbageTxOut addr val datum maybeScript) =
+            (Babbage.BabbageTxOut addr val (translateDatum datum) (convertScript <$> maybeScript))
+
+        convertData :: LedgerApi.Data (BabbageEra StandardCrypto) -> BinaryData
+        convertData = dataToBinaryData . upgradeData
+
+        convertScript :: AlonzoScript (BabbageEra StandardCrypto) -> Script
+        convertScript = \case
+            TimelockScript timelock -> TimelockScript (translateTimelock timelock)
+            PlutusScript script -> PlutusScript script
 
 decodeDatums :: Json.Value -> Json.Parser (Map DatumHash BinaryData)
 decodeDatums = Json.withObject "Datums" $
@@ -333,7 +366,7 @@ decodeValue
     :: Json.Value
     -> Json.Parser Value
 decodeValue = Json.withObject "Value" $ \o -> do
-    coins <- o .: "lovelace"
+    coins <- o .:? "lovelace"
     assets <- KeyMap.foldrWithKey
         (\k v accum ->
             if k == "lovelace" then accum else do
@@ -344,7 +377,7 @@ decodeValue = Json.withObject "Value" $ \o -> do
         )
         (pure mempty)
         o
-    pure (unsafeValueFromList coins assets)
+    pure (unsafeValueFromList (maybe 0 (\x -> x) coins) assets)
   where
     decodeAssets
         :: ByteString