diff --git a/hbs2-tests/test/Peer2Main.hs b/hbs2-tests/test/Peer2Main.hs index bc845523..df143f37 100644 --- a/hbs2-tests/test/Peer2Main.hs +++ b/hbs2-tests/test/Peer2Main.hs @@ -194,12 +194,28 @@ instance Monad m => HasOwnPeer e (PeerM e m) where instance Monad m => HasFabriq e (PeerM e m) where getFabriq = asks (view envFab) +runPeerM :: Peer e -> Fabriq e -> PeerM e m a -> m a runPeerM p bus f = do let env = PeerEnv p bus runReaderT (fromPeerM f) env +instance ( MonadIO m + , HasProtocol e p + , HasFabriq e (PeerM e m) + , HasOwnPeer e (PeerM e m) + , Serialise (Encoded e) + ) => Response e p (ResponseM e (PeerM e m)) where + thatPeer _ = ask -instance (MonadIO m, HasProtocol e p) => Response e p (ResponseM e (PeerM e m)) + deferred = undefined + + response msg = do + let proto = protoId @e @p (Proxy @p) + who <- ask + self <- lift $ ownPeer @e + fab <- lift $ getFabriq @e + let bs = serialise (AnyMessage @e proto (encode msg)) + sendTo fab (To who) (From self) bs main :: IO () main = do