Merge pull request #1422 from input-output-hk/ensemble/fix-tx-type

Fix Tx json instances
input-output-hk · May 9, 2024 · 6d75c29 · 6d75c29
2 parents f081958 + d664784
commit 6d75c29
Show file tree

Hide file tree

Showing 12 changed files with 25,670 additions and 22,058 deletions.
diff --git a/hydra-node/golden/ReasonablySized (ClientInput (Tx BabbageEra)).json b/hydra-node/golden/ReasonablySized (ClientInput (Tx BabbageEra)).json
diff --git a/hydra-node/golden/ReasonablySized (DraftCommitTxRequest (Tx BabbageEra)).json b/hydra-node/golden/ReasonablySized (DraftCommitTxRequest (Tx BabbageEra)).json
@@ -821,7 +821,7 @@
                 "cborHex": "84ab00818258206a680b5268d5d4fa35646cbe8b950fc8ff893200ed911d3ef0202ac20a1b6e240b0181a400583921723fc52e62468988ed24670cf10c0b319981b754b77c1ede4cd98bda7c7c8014b8978a16c6b2425914d36e34792bc0de4930019382e6c2cb018200a1581c2db8410d969b6ad6b6969703c77ebf6c44061aa51c5d6ceba46557e2a149a6a500dd40b089074d1b639a5d1448c22110028201d8184d9fd87c9fd87e9f4040ffff04ff03d8184a8202474601000022001110a4005839003d23fb802eeea2069ce33d2c127d5ca0e9b2be22d1960a18065abfc22cc43e009329859bb0996c199d41da3d8ce30af071610a7fd1390bb4018200a1581c3b54651d1d57e502b5866a52158cc5a23c900324e1dfea032b1158d3a141341b5403644dc827fb3902820058208c1559be875555a6b2a4986a4978f9cb80c2ab69788fbd34bf79f66d1118cbc103d818458200820506021a0001255e04868304581c255148304ff826ddb0abbc5e8f43eb641e0f28d8caf5f194b22cabee028304581c8b877632ed521cae938f804a0afcc834edec774e1ed1a79deb38528b0a82018201581c00cab54aa82b180cd99c689cc8cd70e9004c61b8b4b107806a7eb7a782068201a38200581c7aaf21cc6418e43a45c39f30feeddfcf38ebee7065335b96f05717901a000f1f128200581c7ef8775f41538241aba7d4cd2601907b7640dfd3e67a4468272b00f83a0001dd408200581ca628bab394852154ace133cbf55ce1577463db6d2d1387aba20506803a000142158304581c05bad8a483b209b70f1e6ed7e8a4eb1bd6e5f71891981d0b6e1596dc0e82018201581cef078d2ac33fec7ce07f791f47f6c9060c0146d9cf45f4d865eb8be405a6581df044c060a5600a561e527e92aebb486f48851c9101e7764be81c9b20be1a000497e5581de0459c9f8a1427dfe228bb07cec9f8b5e5918405aea5566afe66c9e8791a000a45e4581df1b03a1003c2f7d117122a481b02b949d681fb5f54878060ddd9bf0bf919a961581df1f5375108450776b8cd3a33676efd23985fcb27a0fa74c6c10238c2ef1a0006f9df581de1bd91c1569c64927f23f6a6e6fcb174b26ae1ac0d2366ac57f20a59261a00033947581de1f8b470d74ea631da45fc3d1119f0e24785ae8acf5919a13e5b0c78111a0005059d08040e85581c2cab970ed95ebeb110c286c13982f834b43ed447fd0ea3549a0c287a581c2ccffaf7565317e858debbd6fc19e4c651c6580877a1de1dd5129590581c33d7f48cd19e3a2111206565b2d32bcf12409635d6a5960594375aa7581c626c7dbee79548091358454ae45abfedbd62a5614c55eda6db8ad611581c73b984c3055f3f551583324bddcf5d563bac9c97b2d9ef4d8dfc4d6809a1581c2d32344cff305cd943ae9661114a968667836ef26387bc1be22c24a6a141391b635c9db406047b64075820326b0350ca3a7c0d1678c7a6bcc480635bc301ce84793778863bd8de9090cdae0f00a30084825820425858d4c9b3fbf4eaf373657ff48b102eb60184819d1b66cc75b4828158b8c8584086f38b7f3b454145555435c889cc9c44ae1e0d480d688b6cda1644268b01d0c2b076304437e4e91d2b611928fff4f3c1e7dc821ca79675210b6a33d2e986f3d7825820da2ae99063b6b980c1fe1a525279e2c8be9d0e53a50a0e4a54e70db7408756b35840602d33fa28b0fdb9f157bac577888ac6961e50602b797f2644d69ce48bc9a6b2f2de6d6257e0325fe9c67572c0e782fd72a868cde13d67af02cd569c03e8c5488258206bd7f6e7065f5065e08dd482c6d0941f76224450e2f12726d14a3e1f33f7931b58406df1961a2126138a08980c6b6e2b3191cb57dbd8cc6bee1213602507e272fa96172bc74759800eca8ee666e05429f4ef596ce8462ef68cbbf1828e5df600d7c58258203e718bb6ca2d784d6b44e0c7c5c96dd0d190bd7614326697152e614fd1d9e6e8584066a4afd983bd4dbc084debf4aa4e252b944fab892cb75a6184a5a7e5a0abdbdc569229e0b64bed04d9f617ba05f489f85f177d05d3e9db69b22d0dc5210986f504819fa120a14042a088d87e9fa44454e2bf8d05054040034358dfed20d87c9f04ffff24427cec43f8062bff0581840107a30243b54d97d87b9fd8799f20040242e270ff431a98ead87b80ff208005821b6bb75a9f798019371b5cb0725442de00c9f5f6",
                 "description": "",
                 "txId": "1b624e3638fecc7a4f547e4e0e1b71bc46c02bfe0a02bc0eef38ef79be964a96",
-                "type": "Tx BabbageEra"
+                "type": "Witnessed Tx BabbageEra"
             },
             "utxo": {
                 "0707080105000302030305010005080505070402080205010001010101050400#41": {

diff --git a/hydra-node/golden/ReasonablySized (DraftCommitTxResponse (Tx BabbageEra)).json b/hydra-node/golden/ReasonablySized (DraftCommitTxResponse (Tx BabbageEra)).json
diff --git a/hydra-node/golden/ReasonablySized (ServerOutput (Tx BabbageEra)).json b/hydra-node/golden/ReasonablySized (ServerOutput (Tx BabbageEra)).json
diff --git a/hydra-node/golden/ReasonablySized (SubmitTxRequest (Tx BabbageEra)).json b/hydra-node/golden/ReasonablySized (SubmitTxRequest (Tx BabbageEra)).json
diff --git a/hydra-node/golden/ReasonablySized (TimedServerOutput (Tx BabbageEra)).json b/hydra-node/golden/ReasonablySized (TimedServerOutput (Tx BabbageEra)).json
diff --git a/hydra-node/golden/ReasonablySized (Tx BabbageEra).json b/hydra-node/golden/ReasonablySized (Tx BabbageEra).json
diff --git a/hydra-node/json-schemas/api.yaml b/hydra-node/json-schemas/api.yaml
@@ -1720,8 +1720,7 @@ components:
       properties:
         type:
           type: string
-          enum:
-            - "Tx BabbageEra"
+          enum: ["Tx BabbageEra", "Unwitnessed Tx BabbageEra", "Witnessed Tx BabbageEra"]
         description:
           type: string
         cborHex:
@@ -2042,7 +2041,7 @@ components:
         hydraVersionedProtocolNumber:
           type: integer
           minimum: 0
-        
+
     KnownHydraVersions:
       oneOf:
         - title: NoKnownHydraVersions

diff --git a/hydra-node/src/Hydra/API/ServerOutput.hs b/hydra-node/src/Hydra/API/ServerOutput.hs
@@ -55,8 +55,8 @@ data ServerOutput tx
   | PeerDisconnected {peer :: NodeId}
   | PeerHandshakeFailure
       { remoteHost :: Host
-      , ourVersion :: Int
-      , theirVersions :: [Int]
+      , ourVersion :: Natural
+      , theirVersions :: [Natural]
       }
   | HeadIsInitializing {headId :: HeadId, parties :: [Party]}
   | Committed {headId :: HeadId, party :: Party, utxo :: UTxOType tx}

diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs
@@ -130,31 +130,33 @@ instance FromCBOR Tx where
         (fail . toString . toLazyText . build)
         (pure . fromLedgerTx)
 
+txType :: Tx -> Text
+txType tx' = case getTxWitnesses tx' of
+  [] -> "Unwitnessed Tx BabbageEra"
+  _ -> "Witnessed Tx BabbageEra"
+
 instance ToJSON Tx where
   toJSON tx =
-    let TextEnvelopeType envelopeType = textEnvelopeType (proxyToAsType (Proxy @Tx))
-     in object
-          [ "cborHex" .= Aeson.String (decodeUtf8 $ Base16.encode $ serialiseToCBOR tx)
-          , "txId" .= txId tx
-          , "type" .= envelopeType
-          , "description" .= Aeson.String mempty
-          ]
+    object
+      [ "cborHex" .= Aeson.String (decodeUtf8 $ Base16.encode $ serialiseToCBOR tx)
+      , "txId" .= txId tx
+      , "type" .= txType tx
+      , "description" .= Aeson.String mempty
+      ]
 
 instance FromJSON Tx where
   parseJSON =
     withObject "Tx" $ \o -> do
-      let TextEnvelopeType envelopeType = textEnvelopeType (proxyToAsType (Proxy @Tx))
       hexText <- o .: "cborHex"
       ty <- o .: "type"
-      guard (envelopeType == ty)
       bytes <- decodeBase16 hexText
-
       case deserialiseFromCBOR (proxyToAsType (Proxy @Tx)) bytes of
         Left e -> fail $ show e
         Right tx ->
           (o .:? "txId") >>= \case
             Nothing -> pure tx
             Just txid' -> do
+              guard (txType tx == ty)
               guard (txid' == txId tx)
               pure tx
 

diff --git a/hydra-node/src/Hydra/Network/Message.hs b/hydra-node/src/Hydra/Network/Message.hs
@@ -22,7 +22,7 @@ instance Arbitrary msg => Arbitrary (NetworkEvent msg) where
   arbitrary = genericArbitrary
 
 type HydraVersionedProtocolNumber :: Type
-newtype HydraVersionedProtocolNumber = MkHydraVersionedProtocolNumber {hydraVersionedProtocolNumber :: Int}
+newtype HydraVersionedProtocolNumber = MkHydraVersionedProtocolNumber {hydraVersionedProtocolNumber :: Natural}
   deriving stock (Eq, Show, Generic, Ord)
   deriving anyclass (ToJSON, FromJSON)
 

diff --git a/hydra-node/src/Hydra/Network/Ouroboros/VersionedProtocol.hs b/hydra-node/src/Hydra/Network/Ouroboros/VersionedProtocol.hs
@@ -4,6 +4,8 @@ import Hydra.Prelude
 
 import Codec.CBOR.Term qualified as CBOR
 import Data.Text qualified as T
+import GHC.Natural (naturalFromInteger, naturalToInteger)
+import GHC.Num (integerToInt)
 import Hydra.Network (Host (..))
 import Hydra.Network.Message (HydraVersionedProtocolNumber (..))
 import Network.TypedProtocol.Pipelined ()
@@ -15,10 +17,10 @@ hydraVersionedProtocolCodec :: CodecCBORTerm (String, Maybe Int) HydraVersionedP
 hydraVersionedProtocolCodec = CodecCBORTerm{encodeTerm, decodeTerm}
  where
   encodeTerm :: HydraVersionedProtocolNumber -> CBOR.Term
-  encodeTerm x = CBOR.TInt $ hydraVersionedProtocolNumber x
+  encodeTerm x = CBOR.TInt $ integerToInt . naturalToInteger $ hydraVersionedProtocolNumber x
 
   decodeTerm :: CBOR.Term -> Either (String, Maybe Int) HydraVersionedProtocolNumber
-  decodeTerm (CBOR.TInt x) = Right $ MkHydraVersionedProtocolNumber x
+  decodeTerm (CBOR.TInt x) = Right $ MkHydraVersionedProtocolNumber (naturalFromInteger (toInteger x))
   decodeTerm _ = Left ("unknown tag", Nothing)
 
 type HydraVersionedProtocolData :: Type