WIP: Use typed-protocols-0.2.0.0

input-output-hk · Sep 27, 2023 · 4058b3a · 4058b3a
1 parent 9257480
commit 4058b3a
Show file tree

Hide file tree

Showing 8 changed files with 198 additions and 110 deletions.
diff --git a/cabal.project b/cabal.project
@@ -17,7 +17,7 @@ repository cardano-haskell-packages
 
 index-state:
   , hackage.haskell.org 2023-08-02T14:18:01Z
-  , cardano-haskell-packages 2023-08-24T12:17:17Z
+  , cardano-haskell-packages 2023-09-05T08:50:43Z
 
 packages: ./.
 
@@ -31,3 +31,27 @@ if impl(ghc >= 9.6)
     , *:base
     , ekg-core:*
     , protolude:*
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/typed-protocols
+  tag: fdfc6c580b964458e53776ea48417b67c7494d71
+  --sha256: sha256-LoPuQIlMu1QNEzb/p2Gnb/SqMxJpBQLUQVGz0TlyIho=
+  subdir:
+    typed-protocols
+    typed-protocols-cborg
+    typed-protocols-examples
+    typed-protocols-stateful
+    typed-protocols-stateful-cborg
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/ouroboros-network
+  tag: f1bb5e5fce3e704c9f252df9f36e687bd3d4f1cc
+  --sha256: sha256-n9aom5Jw23pNNCLeVBczSyAomBqHOByJ7htVo36csh0=
+  subdir: network-mux
+          ouroboros-network
+          ouroboros-network-api
+          ouroboros-network-framework
+          ouroboros-network-protocols
+          ouroboros-network-testing
diff --git a/ekg-forward.cabal b/ekg-forward.cabal
@@ -62,15 +62,16 @@ library
                        , cborg
                        , contra-tracer
                        , ekg-core
-                       , io-classes >= 0.3
+                       , io-classes >= 1.2
                        , network
                        , ouroboros-network-api
                        , ouroboros-network-framework >= 0.8 && < 0.10
+                       , singletons >= 3.0.0
                        , serialise
                        , stm
                        , text
                        , time
-                       , typed-protocols ^>= 0.1
+                       , typed-protocols ^>= 0.2
                        , typed-protocols-cborg
                        , unordered-containers
 

diff --git a/flake.lock b/flake.lock
diff --git a/flake.nix b/flake.nix
@@ -3,7 +3,6 @@
 
   inputs = {
     haskellNix.url = "github:input-output-hk/haskell.nix";
-    haskellNix.inputs.tullia.follows = "tullia";
     nixpkgs.follows = "haskellNix/nixpkgs-unstable";
     iohkNix.url = "github:input-output-hk/iohk-nix";
     flake-utils.url = "github:hamishmack/flake-utils/hkm/nested-hydraJobs";

diff --git a/src/System/Metrics/Protocol/Acceptor.hs b/src/System/Metrics/Protocol/Acceptor.hs
@@ -12,8 +12,8 @@ module System.Metrics.Protocol.Acceptor (
   , ekgAcceptorPeer
   ) where
 
-import           Network.TypedProtocol.Core (Peer (..), PeerHasAgency (..),
-                                             PeerRole (..))
+import           Network.TypedProtocol.Core
+import           Network.TypedProtocol.Peer.Client
 
 import           System.Metrics.Protocol.Type
 
@@ -36,14 +36,14 @@ data EKGAcceptor req resp m a where
 ekgAcceptorPeer
   :: Monad m
   => EKGAcceptor req resp m a
-  -> Peer (EKGForward req resp) 'AsClient 'StIdle m a
+  -> Client (EKGForward req resp) 'NonPipelined 'Empty 'StIdle m stm a
 ekgAcceptorPeer = \case
   SendMsgReq req next ->
     -- Send our message (request for the new metrics from the forwarder).
-    Yield (ClientAgency TokIdle) (MsgReq req) $
+    Yield (MsgReq req) $
       -- We're now into the 'StBusy' state, and now we'll wait for a reply
       -- from the forwarder.
-      Await (ServerAgency TokBusy) $ \(MsgResp resp) ->
+      Await $ \(MsgResp resp) ->
         Effect $
           ekgAcceptorPeer <$> next resp
 
@@ -53,4 +53,4 @@ ekgAcceptorPeer = \case
       -- 'done', with a return value.
       Effect $ do
         r <- getResult
-        return $ Yield (ClientAgency TokIdle) MsgDone (Done TokDone r)
+        return $ Yield MsgDone (Done r)