From 421ffac352aecb250db0e07331593dd194592fef Mon Sep 17 00:00:00 2001 From: Daniel Firth Date: Fri, 17 Jan 2025 10:44:18 +0000 Subject: [PATCH] cardano-api: 10.6 --- cabal.project | 8 +- flake.lock | 6 +- hydra-cardano-api/hydra-cardano-api.cabal | 2 +- .../src/Hydra/Cardano/Api/Prelude.hs | 2 +- .../src/Hydra/Cardano/Api/ScriptData.hs | 2 +- hydra-node/exe/hydra-net/Main.hs | 15 ++-- hydra-node/hydra-node.cabal | 1 + hydra-node/src/Hydra/Ledger/Cardano.hs | 1 + hydra-node/src/Hydra/Network.hs | 1 - hydra-node/src/Hydra/Network/Ouroboros.hs | 39 +++++---- .../src/Hydra/Network/Ouroboros/Client.hs | 15 ++-- .../src/Hydra/Network/Ouroboros/Codec.hs | 37 ++++++++ .../src/Hydra/Network/Ouroboros/Server.hs | 16 ++-- .../src/Hydra/Network/Ouroboros/Type.hs | 86 ++++++++----------- .../Network/Ouroboros/VersionedProtocol.hs | 3 +- hydra-plutus/src/Hydra/Contract/Head.hs | 5 +- hydra-plutus/src/Hydra/Contract/HeadTokens.hs | 5 +- hydra-plutus/src/Hydra/Contract/Util.hs | 3 +- 18 files changed, 139 insertions(+), 108 deletions(-) create mode 100644 hydra-node/src/Hydra/Network/Ouroboros/Codec.hs diff --git a/cabal.project b/cabal.project index 818f82bf657..6b7116788da 100644 --- a/cabal.project +++ b/cabal.project @@ -12,8 +12,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING.md for information about when and how to update these. index-state: - , hackage.haskell.org 2024-11-22T14:59:16Z - , cardano-haskell-packages 2024-12-20T15:52:56Z + , hackage.haskell.org 2025-01-15T13:32:16Z + , cardano-haskell-packages 2025-01-15T09:59:24Z packages: hydra-prelude @@ -41,7 +41,3 @@ test-show-details: direct program-options ghc-options: -fwrite-ide-info - -constraints: - quickcheck-instances==0.3.31, - data-default==0.7.1.3 diff --git a/flake.lock b/flake.lock index f72483a22d6..7558745e0d3 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1734943824, - "narHash": "sha256-kcyysnPJbjdJOmtTldC08xj2Ttp2XcY6ecbYOYdwkmY=", + "lastModified": 1736937016, + "narHash": "sha256-dmLSu2SvSaTDjSE03cU6DwY62J3nWJbVhIn/kKtMwJg=", "owner": "IntersectMBO", "repo": "cardano-haskell-packages", - "rev": "6ec767f1afd771816c5f3b383d0e1d3b577d72fe", + "rev": "045875beec586ff57a7333c0563fd5c2b1a308fa", "type": "github" }, "original": { diff --git a/hydra-cardano-api/hydra-cardano-api.cabal b/hydra-cardano-api/hydra-cardano-api.cabal index f4130ffcc78..2130f6798eb 100644 --- a/hydra-cardano-api/hydra-cardano-api.cabal +++ b/hydra-cardano-api/hydra-cardano-api.cabal @@ -77,7 +77,7 @@ library , aeson >=2 , base >=4.16 , bytestring - , cardano-api ^>=10.5 + , cardano-api ^>=10.6 , cardano-api:gen , cardano-binary , cardano-crypto-class diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs index e3f3c028f68..a2052eed88b 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs @@ -38,9 +38,9 @@ import Cardano.Api.Shelley hiding ( import Cardano.Api.UTxO (UTxO, UTxO' (..)) import Cardano.Crypto.Hash.Class qualified as CC import Cardano.Ledger.Binary qualified as Ledger +import Cardano.Ledger.Core (EraCrypto) import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Ledger.Era (EraCrypto) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.ByteString (ByteString) import Data.ByteString.Lazy (fromStrict, toStrict) diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs index 2efc3ab5e46..6ebce1c9b2b 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs @@ -4,7 +4,7 @@ module Hydra.Cardano.Api.ScriptData where import Hydra.Cardano.Api.Prelude hiding (left) -import Cardano.Ledger.Era qualified as Ledger +import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Plutus.Data qualified as Ledger import PlutusLedgerApi.V3 qualified as Plutus diff --git a/hydra-node/exe/hydra-net/Main.hs b/hydra-node/exe/hydra-net/Main.hs index b920cd5b202..b935c57c1cb 100644 --- a/hydra-node/exe/hydra-net/Main.hs +++ b/hydra-node/exe/hydra-net/Main.hs @@ -64,6 +64,7 @@ import Ouroboros.Network.Protocol.Handshake.Unversioned ( ) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, queryVersion) import Ouroboros.Network.Socket ( + ConnectToArgs (..), HandshakeCallbacks (..), NetworkConnectTracers (..), connectToNodeSocket, @@ -181,16 +182,18 @@ injectReqSn peer snapshotNumber hydraKeyFile fakeHydraKeyFile = do traceWith tracer $ ConnectingTo sockAddr connect sock (addrAddress sockAddr) traceWith tracer $ ConnectedTo sockAddr - runClient iomgr (mkApplication sk party tracer) sock + void $ runClient iomgr (mkApplication sk party tracer) sock where runClient iomgr app = connectToNodeSocket iomgr - unversionedHandshakeCodec - noTimeLimitsHandshake - unversionedProtocolDataCodec - networkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) + ConnectToArgs + { ctaHandshakeCodec = unversionedHandshakeCodec + , ctaHandshakeTimeLimits = noTimeLimitsHandshake + , ctaVersionDataCodec = unversionedProtocolDataCodec + , ctaConnectTracers = networkConnectTracers + , ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion + } (unversionedProtocol app) networkConnectTracers = diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 30e014f13b7..38234ece5f7 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -83,6 +83,7 @@ library Hydra.Network.Heartbeat Hydra.Network.Message Hydra.Network.Ouroboros + Hydra.Network.Ouroboros.Codec Hydra.Network.Ouroboros.Client Hydra.Network.Ouroboros.Server Hydra.Network.Ouroboros.Type diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs index 5b03ee33921..9dcf0aa6835 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano.hs +++ b/hydra-node/src/Hydra/Ledger/Cardano.hs @@ -96,6 +96,7 @@ newLedgerEnv protocolParams = Ledger.ledgerAccount = Ledger.AccountState mempty mempty , Ledger.ledgerPp = protocolParams , Ledger.ledgerMempool = False + , Ledger.ledgerEpochNo = Nothing } -- * Conversions and utilities diff --git a/hydra-node/src/Hydra/Network.hs b/hydra-node/src/Hydra/Network.hs index a1edb7f49aa..f0ee1596ba6 100644 --- a/hydra-node/src/Hydra/Network.hs +++ b/hydra-node/src/Hydra/Network.hs @@ -31,7 +31,6 @@ import Cardano.Ledger.Orphans () import Data.IP (IP, toIPv4w) import Data.Text (pack, unpack) import Network.Socket (PortNumber, close) -import Network.TypedProtocol.Pipelined () import Test.QuickCheck (elements, listOf, suchThat) import Text.Read (Read (readsPrec)) import Text.Show (Show (show)) diff --git a/hydra-node/src/Hydra/Network/Ouroboros.hs b/hydra-node/src/Hydra/Network/Ouroboros.hs index 1a517c6faa6..82d58fe3f22 100644 --- a/hydra-node/src/Hydra/Network/Ouroboros.hs +++ b/hydra-node/src/Hydra/Network/Ouroboros.hs @@ -58,9 +58,6 @@ import Hydra.Network.Ouroboros.Type ( Message (..), codecFireForget, ) -import Network.Mux.Compat ( - WithMuxBearer (..), - ) import Network.Socket ( AddrInfo (addrAddress), NameInfoFlag (..), @@ -72,9 +69,10 @@ import Network.Socket ( getPeerName, ) import Network.TypedProtocol.Codec ( - AnyMessageAndAgency (..), + AnyMessage (..), ) -import Network.TypedProtocol.Pipelined () + +import Network.Mux (Mode (..), WithBearer (..)) import Ouroboros.Network.Driver.Simple ( TraceSendRecv (..), ) @@ -94,7 +92,6 @@ import Ouroboros.Network.Mux ( MiniProtocolCb, MiniProtocolLimits (..), MiniProtocolNum (MiniProtocolNum), - MuxMode (..), OuroborosApplication (..), OuroborosApplicationWithMinimalCtx, RunMiniProtocol (..), @@ -107,6 +104,7 @@ import Ouroboros.Network.Server.Socket (AcceptedConnectionsLimit (AcceptedConnec import Ouroboros.Network.Snocket (makeSocketBearer, socketSnocket) import Ouroboros.Network.Socket ( AcceptConnectionsPolicyTrace, + ConnectToArgs (..), ConnectionId (..), HandshakeCallbacks (..), NetworkConnectTracers (..), @@ -236,15 +234,18 @@ withOuroborosNetwork IO () actualConnect iomgr newBroadcastChannel app sn = do chan <- newBroadcastChannel - connectToNodeSocket - iomgr - (codecHandshake hydraVersionedProtocolCodec) - noTimeLimitsHandshake - hydraVersionedProtocolDataCodec - networkConnectTracers - (HandshakeCallbacks acceptableVersion queryVersion) - (simpleSingletonVersions protocolVersion MkHydraVersionedProtocolData (app chan)) - sn + void $ + connectToNodeSocket + iomgr + ConnectToArgs + { ctaHandshakeCodec = codecHandshake hydraVersionedProtocolCodec + , ctaHandshakeTimeLimits = noTimeLimitsHandshake + , ctaVersionDataCodec = hydraVersionedProtocolDataCodec + , ctaConnectTracers = networkConnectTracers + , ctaHandshakeCallbacks = HandshakeCallbacks acceptableVersion queryVersion + } + (simpleSingletonVersions protocolVersion MkHydraVersionedProtocolData (app chan)) + sn where networkConnectTracers :: NetworkConnectTracers SockAddr HydraVersionedProtocolNumber networkConnectTracers = @@ -376,7 +377,7 @@ data TraceOuroborosNetwork msg = TraceSubscriptions (WithIPList (SubscriptionTrace SockAddr)) | TraceErrorPolicy (WithAddr SockAddr ErrorPolicyTrace) | TraceAcceptPolicy AcceptConnectionsPolicyTrace - | TraceHandshake (WithMuxBearer (ConnectionId SockAddr) (TraceSendRecv (Handshake HydraVersionedProtocolNumber CBOR.Term))) + | TraceHandshake (WithBearer (ConnectionId SockAddr) (TraceSendRecv (Handshake HydraVersionedProtocolNumber CBOR.Term))) | TraceSendRecv (TraceSendRecv (FireForget msg)) -- NOTE: cardano-node would have orphan ToObject instances for most of these @@ -415,16 +416,16 @@ encodeWithAddr (WithAddr addr ev) = ] encodeTraceSendRecvHandshake :: - WithMuxBearer (ConnectionId SockAddr) (TraceSendRecv (Handshake HydraVersionedProtocolNumber CBOR.Term)) -> + WithBearer (ConnectionId SockAddr) (TraceSendRecv (Handshake HydraVersionedProtocolNumber CBOR.Term)) -> [Aeson.Pair] encodeTraceSendRecvHandshake = \case - WithMuxBearer peerId (TraceSendMsg (AnyMessageAndAgency agency msg)) -> + WithBearer peerId (TraceSendMsg (AnyMessageAndAgency agency msg)) -> [ "event" .= ("send" :: String) , "agency" .= (show agency :: Text) , "peer" .= (show peerId :: Text) ] ++ encodeMsg msg - WithMuxBearer peerId (TraceRecvMsg (AnyMessageAndAgency agency msg)) -> + WithBearer peerId (TraceRecvMsg (AnyMessageAndAgency agency msg)) -> [ "event" .= ("receive" :: Text) , "agency" .= (show agency :: Text) , "peer" .= (show peerId :: Text) diff --git a/hydra-node/src/Hydra/Network/Ouroboros/Client.hs b/hydra-node/src/Hydra/Network/Ouroboros/Client.hs index f3b524ed9cd..abbfe8b424e 100644 --- a/hydra-node/src/Hydra/Network/Ouroboros/Client.hs +++ b/hydra-node/src/Hydra/Network/Ouroboros/Client.hs @@ -3,15 +3,16 @@ module Hydra.Network.Ouroboros.Client where import Hydra.Prelude import Hydra.Network.Ouroboros.Type ( - ClientHasAgency (TokIdle), FireForget (..), Message (MsgDone, MsgSend), - NobodyHasAgency (TokDone), ) import Network.TypedProtocol.Core ( - Peer (..), - PeerHasAgency (..), + IsPipelined (..), PeerRole (..), + ReflRelativeAgency (..), + ) +import Network.TypedProtocol.Peer ( + Peer (..), ) data FireForgetClient msg m a where @@ -22,13 +23,13 @@ data FireForgetClient msg m a where fireForgetClientPeer :: Monad m => FireForgetClient msg m a -> - Peer (FireForget msg) 'AsClient 'StIdle m a + Peer (FireForget msg) 'AsClient 'NonPipelined 'StIdle m a fireForgetClientPeer = \case Idle next -> Effect $ fireForgetClientPeer <$> next SendMsg msg next -> - Yield (ClientAgency TokIdle) (MsgSend msg) $ + Yield ReflClientAgency (MsgSend msg) $ Effect $ fireForgetClientPeer <$> next SendDone action -> - Effect $ Yield (ClientAgency TokIdle) MsgDone . Done TokDone <$> action + Effect $ Yield ReflClientAgency MsgDone . Done ReflNobodyAgency <$> action diff --git a/hydra-node/src/Hydra/Network/Ouroboros/Codec.hs b/hydra-node/src/Hydra/Network/Ouroboros/Codec.hs new file mode 100644 index 00000000000..61223ccfe43 --- /dev/null +++ b/hydra-node/src/Hydra/Network/Ouroboros/Codec.hs @@ -0,0 +1,37 @@ +module Hydra.Network.Ouroboros.Codec where + +import Hydra.Prelude + +import Cardano.Binary qualified as CBOR +import Codec.CBOR.Read qualified as CBOR +import Network.TypedProtocol.Codec +import Network.TypedProtocol.Codec.CBOR (mkCodecCborLazyBS) +import Network.TypedProtocol.Core +import Hydra.Network.Ouroboros.Type (FireForget(..), SFireForget(..), Message(..)) + +codecFireForget :: + forall m msg. + (MonadST m, FromCBOR msg, ToCBOR msg) => + Codec (FireForget msg) CBOR.DeserialiseFailure m LByteString +codecFireForget = + mkCodecCborLazyBS encode decode + where + encode :: + forall msg' (st :: FireForget msg') (st' :: FireForget msg'). + ToCBOR msg' => + Message (FireForget msg') st st' -> + CBOR.Encoding + encode MsgDone = CBOR.encodeWord 0 + encode (MsgSend msg) = CBOR.encodeWord 1 <> toCBOR msg + + decode :: + forall msg' s (st :: FireForget msg'). + (FromCBOR msg', ActiveState st) => + StateToken st -> + CBOR.Decoder s (SomeMessage st) + decode stok = do + key <- CBOR.decodeWord + case (stok, key) of + (SingIdle, 0) -> pure $ SomeMessage MsgDone + (SingIdle, 1) -> SomeMessage . MsgSend <$> fromCBOR + (_, _) -> fail "codedFireForget.StIdle: unexpected" diff --git a/hydra-node/src/Hydra/Network/Ouroboros/Server.hs b/hydra-node/src/Hydra/Network/Ouroboros/Server.hs index b3899bbe062..14ca688a0ae 100644 --- a/hydra-node/src/Hydra/Network/Ouroboros/Server.hs +++ b/hydra-node/src/Hydra/Network/Ouroboros/Server.hs @@ -3,15 +3,17 @@ module Hydra.Network.Ouroboros.Server where import Hydra.Prelude import Hydra.Network.Ouroboros.Type ( - ClientHasAgency (TokIdle), FireForget (StIdle), Message (MsgDone, MsgSend), - NobodyHasAgency (TokDone), ) import Network.TypedProtocol ( - Peer (Await, Done, Effect), - PeerHasAgency (ClientAgency), + IsPipelined (..), PeerRole (AsServer), + ReflRelativeAgency (..), + ) + +import Network.TypedProtocol.Peer ( + Peer (Await, Done, Effect), ) data FireForgetServer msg m a = FireForgetServer @@ -26,11 +28,11 @@ data FireForgetServer msg m a = FireForgetServer fireForgetServerPeer :: Monad m => FireForgetServer msg m a -> - Peer (FireForget msg) 'AsServer 'StIdle m a + Peer (FireForget msg) 'AsServer 'NonPipelined 'StIdle m a fireForgetServerPeer FireForgetServer{recvMsg, recvMsgDone} = -- In the 'StIdle' the server is awaiting a request message - Await (ClientAgency TokIdle) $ \case + Await ReflClientAgency $ \case -- The client got to choose between two messages and we have to handle -- either of them MsgSend payload -> Effect $ fireForgetServerPeer <$> recvMsg payload - MsgDone -> Effect $ Done TokDone <$> recvMsgDone + MsgDone -> Effect $ Done ReflNobodyAgency <$> recvMsgDone diff --git a/hydra-node/src/Hydra/Network/Ouroboros/Type.hs b/hydra-node/src/Hydra/Network/Ouroboros/Type.hs index f0e28a92251..eabc19d5de0 100644 --- a/hydra-node/src/Hydra/Network/Ouroboros/Type.hs +++ b/hydra-node/src/Hydra/Network/Ouroboros/Type.hs @@ -4,12 +4,9 @@ import Hydra.Prelude import Cardano.Binary qualified as CBOR import Codec.CBOR.Read qualified as CBOR -import GHC.Show (Show (show)) -import Network.TypedProtocol (PeerHasAgency (ClientAgency), Protocol (..)) -import Network.TypedProtocol.Codec (Codec) +import Network.TypedProtocol.Codec import Network.TypedProtocol.Codec.CBOR (mkCodecCborLazyBS) -import Network.TypedProtocol.Core (PeerRole) -import Network.TypedProtocol.Driver (SomeMessage (SomeMessage)) +import Network.TypedProtocol.Core import Ouroboros.Consensus.Util (ShowProxy (..)) -- | TODO explain Protocol @@ -21,6 +18,17 @@ data FireForget msg where StIdle :: FireForget msg StDone :: FireForget msg +data SFireForget (st :: FireForget msg) where + SingIdle :: SFireForget StIdle + SingDone :: SFireForget StDone + +deriving instance Show (SFireForget st) + +instance StateTokenI StIdle where + stateToken = SingIdle +instance StateTokenI StDone where + stateToken = SingDone + instance ShowProxy (FireForget msg) where showProxy _ = "FireForget" @@ -34,62 +42,38 @@ instance Protocol (FireForget msg) where MsgSend :: msg -> Message (FireForget msg) 'StIdle 'StIdle MsgDone :: Message (FireForget msg) 'StIdle 'StDone - -- We have to explain to the framework what our states mean, in terms of - -- who is expected to send and receive in the different states. - -- - -- Idle states are where it is for the client to send a message. - data ClientHasAgency st where - TokIdle :: ClientHasAgency 'StIdle - - -- In our protocol the server is always receiving, thus in no state the server - -- has agency. - data ServerHasAgency st - - -- In the done state neither client nor server can send messages. - data NobodyHasAgency st where - TokDone :: NobodyHasAgency 'StDone + type StateAgency StIdle = ClientAgency + type StateAgency StDone = NobodyAgency - exclusionLemma_ClientAndServerHaveAgency TokIdle tok = case tok of {} - exclusionLemma_NobodyAndClientHaveAgency TokDone tok = case tok of {} - exclusionLemma_NobodyAndServerHaveAgency TokDone tok = case tok of {} + type StateToken = SFireForget deriving stock instance Show msg => Show (Message (FireForget msg) from to) deriving stock instance Eq msg => Eq (Message (FireForget msg) from to) -instance Show (ClientHasAgency (st :: FireForget msg)) where - show TokIdle = "TokIdle" - -instance Show (ServerHasAgency (st :: FireForget msg)) where - show _ = error "absurd" - codecFireForget :: - forall a m. - ( MonadST m - , ToCBOR a - , FromCBOR a - ) => - Codec (FireForget a) CBOR.DeserialiseFailure m LByteString -codecFireForget = mkCodecCborLazyBS encodeMsg decodeMsg + forall m msg. + (MonadST m, FromCBOR msg, ToCBOR msg) => + Codec (FireForget msg) CBOR.DeserialiseFailure m LByteString +codecFireForget = + mkCodecCborLazyBS encode decode where - encodeMsg :: - forall (pr :: PeerRole) st st'. - PeerHasAgency pr st -> - Message (FireForget a) st st' -> + encode :: + forall msg' (st :: FireForget msg') (st' :: FireForget msg'). + ToCBOR msg' => + Message (FireForget msg') st st' -> CBOR.Encoding - encodeMsg (ClientAgency TokIdle) MsgDone = CBOR.encodeWord 0 - encodeMsg (ClientAgency TokIdle) (MsgSend msg) = CBOR.encodeWord 1 <> toCBOR msg + encode MsgDone = CBOR.encodeWord 0 + encode (MsgSend msg) = CBOR.encodeWord 1 <> toCBOR msg - decodeMsg :: - forall (pr :: PeerRole) s (st :: FireForget a). - PeerHasAgency pr st -> + decode :: + forall msg' s (st :: FireForget msg'). + (FromCBOR msg', ActiveState st) => + StateToken st -> CBOR.Decoder s (SomeMessage st) - decodeMsg stok = do + decode stok = do key <- CBOR.decodeWord case (stok, key) of - (ClientAgency TokIdle, 0) -> - return $ SomeMessage MsgDone - (ClientAgency TokIdle, 1) -> do - SomeMessage . MsgSend <$> fromCBOR - (ClientAgency TokIdle, _) -> - fail "codecFireForget.StIdle: unexpected key" + (SingIdle, 0) -> pure $ SomeMessage MsgDone + (SingIdle, 1) -> SomeMessage . MsgSend <$> fromCBOR + (_, _) -> fail "codedFireForget.StIdle: unexpected" diff --git a/hydra-node/src/Hydra/Network/Ouroboros/VersionedProtocol.hs b/hydra-node/src/Hydra/Network/Ouroboros/VersionedProtocol.hs index 6ca0d7f6e7d..e144a325e32 100644 --- a/hydra-node/src/Hydra/Network/Ouroboros/VersionedProtocol.hs +++ b/hydra-node/src/Hydra/Network/Ouroboros/VersionedProtocol.hs @@ -8,7 +8,8 @@ import GHC.Natural (naturalFromInteger, naturalToInteger) import GHC.Num (integerToInt) import Hydra.Network (Host (..)) import Hydra.Network.Message (HydraVersionedProtocolNumber (..)) -import Network.TypedProtocol.Pipelined () + +-- import Network.TypedProtocol.Pipelined () import Ouroboros.Network.CodecCBORTerm (CodecCBORTerm (..)) import Ouroboros.Network.Protocol.Handshake.Codec (VersionDataCodec, cborTermVersionDataCodec) import Ouroboros.Network.Protocol.Handshake.Version (Accept (..), Acceptable, Queryable, acceptableVersion, queryVersion) diff --git a/hydra-plutus/src/Hydra/Contract/Head.hs b/hydra-plutus/src/Hydra/Contract/Head.hs index a8bbe976b0c..ed2d6fc098f 100644 --- a/hydra-plutus/src/Hydra/Contract/Head.hs +++ b/hydra-plutus/src/Hydra/Contract/Head.hs @@ -60,6 +60,7 @@ import PlutusLedgerApi.V3 ( TxOut (..), UpperBound (..), Value (Value), + mintValueMinted, ) import PlutusLedgerApi.V3.Contexts (findOwnInput, findTxInByTxOutRef) import PlutusTx (CompiledCode) @@ -117,7 +118,7 @@ checkAbort ctx@ScriptContext{scriptContextTxInfo = txInfo} headCurrencySymbol pa && mustBeSignedByParticipant ctx headCurrencySymbol && mustReimburseCommittedUTxO where - minted = txInfoMint txInfo + minted = mintValueMinted $ txInfoMint txInfo mustReimburseCommittedUTxO = traceIfFalse $(errorCode ReimbursedOutputsDontMatch) $ @@ -653,7 +654,7 @@ checkFanout ScriptContext{scriptContextTxInfo = txInfo} closedDatum numberOfFano && hasSameDecommitUTxOHash && afterContestationDeadline where - minted = txInfoMint txInfo + minted = mintValueMinted $ txInfoMint txInfo hasSameUTxOHash = traceIfFalse $(errorCode FanoutUTxOHashMismatch) $ diff --git a/hydra-plutus/src/Hydra/Contract/HeadTokens.hs b/hydra-plutus/src/Hydra/Contract/HeadTokens.hs index 664fb7374ba..c4bfbd2cd6e 100644 --- a/hydra-plutus/src/Hydra/Contract/HeadTokens.hs +++ b/hydra-plutus/src/Hydra/Contract/HeadTokens.hs @@ -45,6 +45,7 @@ import PlutusLedgerApi.V3 ( TxInfo (..), TxOutRef, Value (getValue), + mintValueMinted, serialiseCompiledCode, ) import PlutusLedgerApi.V3.Contexts (ownCurrencySymbol) @@ -136,6 +137,7 @@ validateTokensMinting initialValidator headValidator seedInput context = maybe 0 sum . AssocMap.lookup currency . getValue + . mintValueMinted $ txInfoMint txInfo (headId, seed, nParties) = @@ -173,7 +175,8 @@ validateTokensBurning context = ScriptContext{scriptContextTxInfo = txInfo} = context - minted = getValue $ txInfoMint txInfo + -- TODO: Should this be burned our minted?! + minted = getValue . mintValueMinted $ txInfoMint txInfo burnHeadTokens = case AssocMap.lookup currency minted of diff --git a/hydra-plutus/src/Hydra/Contract/Util.hs b/hydra-plutus/src/Hydra/Contract/Util.hs index be0c5b0552b..d610e6216b1 100644 --- a/hydra-plutus/src/Hydra/Contract/Util.hs +++ b/hydra-plutus/src/Hydra/Contract/Util.hs @@ -20,6 +20,7 @@ import PlutusLedgerApi.V3 ( TxOut (..), TxOutRef (..), Value (getValue), + mintValueMinted, toBuiltinData, ) import PlutusTx.AssocMap qualified as AssocMap @@ -57,7 +58,7 @@ mustBurnAllHeadTokens minted headCurrencySymbol parties = mustNotMintOrBurn :: TxInfo -> Bool mustNotMintOrBurn TxInfo{txInfoMint} = traceIfFalse "U01" $ - isZero txInfoMint + isZero (mintValueMinted txInfoMint) {-# INLINEABLE mustNotMintOrBurn #-} infix 4 ===