polysemy effects

definitions/package.yaml

@@ -11,6 +11,8 @@ extra-source-files:
   - readme.md
 
 ghc-options:
+  # - -fplugin=Polysemy.Plugin
+  - -O2
   - -Wall
   - -Wcompat
   - -Werror=incomplete-patterns
@@ -23,6 +25,8 @@ dependencies:
   - aeson
   - base >= 4.7 && < 5
   - freer-indexed
+  - polysemy
+  # - polysemy-plugin
   - lens
   - mtl
   - singletons

definitions/src/Simplex/Messaging/Broker.hs

@@ -1,14 +1,17 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 module Simplex.Messaging.Broker where
 
 import Control.Monad.Trans.Except
+import Polysemy.Internal
 import Simplex.Messaging.Protocol
 
 instance Monad m => PartyProtocol m Broker where
@@ -31,3 +34,20 @@ instance Monad m => PartyProtocol m Broker where
     ExceptT String m (Connection Broker s')
   action (PushConfirm _ _) = actionStub
   action (PushMsg _ _) = actionStub
+
+type SimplexBroker = SimplexParty Broker
+
+api' ::
+  Member SimplexBroker r =>
+  Command from '(Broker, s, s') a ->
+  Connection Broker s ->
+  Sem r (Either String (a, Connection Broker s'))
+api' cmd conn = send $ Api cmd conn
+
+action' ::
+  Member SimplexBroker r =>
+  Command '(Broker, s, s') to a ->
+  Connection Broker s ->
+  Either String a ->
+  Sem r (Either String (Connection Broker s'))
+action' cmd conn res = send $ Action cmd conn res

definitions/src/Simplex/Messaging/Client.hs

@@ -1,14 +1,17 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
 
 module Simplex.Messaging.Client where
 
 import Control.Monad.Trans.Except
+import Polysemy.Internal
 import Simplex.Messaging.Protocol
 
 instance Monad m => PartyProtocol m Recipient where
@@ -45,3 +48,37 @@ instance Monad m => PartyProtocol m Sender where
     ExceptT String m (Connection Sender s')
   action (ConfirmConn _ _) = actionStub
   action (SendMsg _ _) = actionStub
+
+type SimplexRecipient = SimplexParty Recipient
+
+type SimplexSender = SimplexParty Sender
+
+rApi ::
+  Member SimplexRecipient r =>
+  Command from '(Recipient, s, s') a ->
+  Connection Recipient s ->
+  Sem r (Either String (a, Connection Recipient s'))
+rApi cmd conn = send $ Api cmd conn
+
+rAction ::
+  Member SimplexRecipient r =>
+  Command '(Recipient, s, s') to a ->
+  Connection Recipient s ->
+  Either String a ->
+  Sem r (Either String (Connection Recipient s'))
+rAction cmd conn res = send $ Action cmd conn res
+
+sApi ::
+  Member SimplexSender r =>
+  Command from '(Sender, s, s') a ->
+  Connection Sender s ->
+  Sem r (Either String (a, Connection Sender s'))
+sApi cmd conn = send $ Api cmd conn
+
+sAction ::
+  Member SimplexSender r =>
+  Command '(Sender, s, s') to a ->
+  Connection Sender s ->
+  Either String a ->
+  Sem r (Either String (Connection Sender s'))
+sAction cmd conn res = send $ Action cmd conn res

definitions/src/Simplex/Messaging/Protocol.hs

@@ -129,6 +129,17 @@ apiStub _ = throwE "api not implemented"
 actionStub :: Monad m => Connection p s -> ExceptT String m a -> ExceptT String m (Connection p s')
 actionStub _ _ = throwE "action not implemented"
 
+data SimplexParty (p :: Party) m a where
+  Api ::
+    Command from '(p, s, s') x ->
+    Connection p s ->
+    SimplexParty p m (Either String (x, Connection p s'))
+  Action ::
+    Command '(p, s, s') to x ->
+    Connection p s ->
+    Either String x ->
+    SimplexParty p m (Either String (Connection p s'))
+
 type ProtocolState = (ConnState, ConnState, ConnState)
 
 type family HasProtoSt (s :: ProtocolState) :: Constraint where