Skip to content

Commit

Permalink
cardano-api: 10.6
Browse files Browse the repository at this point in the history
  • Loading branch information
locallycompact committed Jan 17, 2025
1 parent af5c305 commit 421ffac
Show file tree
Hide file tree
Showing 18 changed files with 139 additions and 108 deletions.
8 changes: 2 additions & 6 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
6 changes: 3 additions & 3 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion hydra-cardano-api/hydra-cardano-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
15 changes: 9 additions & 6 deletions hydra-node/exe/hydra-net/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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 =
Expand Down
1 change: 1 addition & 0 deletions hydra-node/hydra-node.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions hydra-node/src/Hydra/Ledger/Cardano.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,7 @@ newLedgerEnv protocolParams =
Ledger.ledgerAccount = Ledger.AccountState mempty mempty
, Ledger.ledgerPp = protocolParams
, Ledger.ledgerMempool = False
, Ledger.ledgerEpochNo = Nothing
}

-- * Conversions and utilities
Expand Down
1 change: 0 additions & 1 deletion hydra-node/src/Hydra/Network.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
39 changes: 20 additions & 19 deletions hydra-node/src/Hydra/Network/Ouroboros.hs
Original file line number Diff line number Diff line change
Expand Up @@ -58,9 +58,6 @@ import Hydra.Network.Ouroboros.Type (
Message (..),
codecFireForget,
)
import Network.Mux.Compat (
WithMuxBearer (..),
)
import Network.Socket (
AddrInfo (addrAddress),
NameInfoFlag (..),
Expand All @@ -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 (..),
)
Expand All @@ -94,7 +92,6 @@ import Ouroboros.Network.Mux (
MiniProtocolCb,
MiniProtocolLimits (..),
MiniProtocolNum (MiniProtocolNum),
MuxMode (..),
OuroborosApplication (..),
OuroborosApplicationWithMinimalCtx,
RunMiniProtocol (..),
Expand All @@ -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 (..),
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
15 changes: 8 additions & 7 deletions hydra-node/src/Hydra/Network/Ouroboros/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
37 changes: 37 additions & 0 deletions hydra-node/src/Hydra/Network/Ouroboros/Codec.hs
Original file line number Diff line number Diff line change
@@ -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"
16 changes: 9 additions & 7 deletions hydra-node/src/Hydra/Network/Ouroboros/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Loading

0 comments on commit 421ffac

Please sign in to comment.