From d74c109328dc62d9f3ae5fbb661558b9e23d9f2f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 31 May 2020 22:37:08 +0100
Subject: [PATCH] use ExceptT

---
 definitions/package.yaml                      |  1 +
 definitions/src/Simplex/Messaging/Broker.hs   |  7 ++++---
 definitions/src/Simplex/Messaging/Client.hs   | 13 +++++++------
 definitions/src/Simplex/Messaging/Protocol.hs | 15 ++++++++-------
 4 files changed, 20 insertions(+), 16 deletions(-)

diff --git a/definitions/package.yaml b/definitions/package.yaml
index 7cd5218aa7..89c4f273fc 100644
--- a/definitions/package.yaml
+++ b/definitions/package.yaml
@@ -38,6 +38,7 @@ dependencies:
   - servant-docs
   - servant-server
   - template-haskell
+  - transformers
 
 library:
   source-dirs: src
diff --git a/definitions/src/Simplex/Messaging/Broker.hs b/definitions/src/Simplex/Messaging/Broker.hs
index 86ca6cfe0a..e525a6152b 100644
--- a/definitions/src/Simplex/Messaging/Broker.hs
+++ b/definitions/src/Simplex/Messaging/Broker.hs
@@ -8,13 +8,14 @@
 
 module Simplex.Messaging.Broker where
 
+import Control.Monad.Trans.Except
 import Simplex.Messaging.Protocol
 
 instance Monad m => PartyProtocol m Broker where
   api ::
     Command from fs fs' Broker ps ps' res ->
     Connection Broker ps ->
-    m (Either String (res, Connection Broker ps'))
+    ExceptT String m (res, Connection Broker ps')
   api (CreateConn _) = apiStub
   api (Subscribe _) = apiStub
   api (Unsubscribe _) = apiStub
@@ -26,7 +27,7 @@ instance Monad m => PartyProtocol m Broker where
   action ::
     Command Broker ps ps' to ts ts' res ->
     Connection Broker ps ->
-    Either String res ->
-    m (Either String (Connection Broker ps'))
+    ExceptT String m res ->
+    ExceptT String m (Connection Broker ps')
   action (PushConfirm _ _) = actionStub
   action (PushMsg _ _) = actionStub
diff --git a/definitions/src/Simplex/Messaging/Client.hs b/definitions/src/Simplex/Messaging/Client.hs
index 126e22af8c..91f0117bec 100644
--- a/definitions/src/Simplex/Messaging/Client.hs
+++ b/definitions/src/Simplex/Messaging/Client.hs
@@ -8,21 +8,22 @@
 
 module Simplex.Messaging.Client where
 
+import Control.Monad.Trans.Except
 import Simplex.Messaging.Protocol
 
 instance Monad m => PartyProtocol m Recipient where
   api ::
     Command from fs fs' Recipient ps ps' res ->
     Connection Recipient ps ->
-    m (Either String (res, Connection Recipient ps'))
+    ExceptT String m (res, Connection Recipient ps')
   api (PushConfirm _ _) = apiStub
   api (PushMsg _ _) = apiStub
 
   action ::
     Command Recipient ps ps' to ts ts' res ->
     Connection Recipient ps ->
-    Either String res ->
-    m (Either String (Connection Recipient ps'))
+    ExceptT String m res ->
+    ExceptT String m (Connection Recipient ps')
   action (CreateConn _) = actionStub
   action (Subscribe _) = actionStub
   action (Unsubscribe _) = actionStub
@@ -34,13 +35,13 @@ instance Monad m => PartyProtocol m Sender where
   api ::
     Command from fs fs' Sender ps ps' res ->
     Connection Sender ps ->
-    m (Either String (res, Connection Sender ps'))
+    ExceptT String m (res, Connection Sender ps')
   api (SendInvite _) = apiStub
 
   action ::
     Command Sender ps ps' to ts ts' res ->
     Connection Sender ps ->
-    Either String res ->
-    m (Either String (Connection Sender ps'))
+    ExceptT String m res ->
+    ExceptT String m (Connection Sender ps')
   action (ConfirmConn _ _) = actionStub
   action (SendMsg _ _) = actionStub
diff --git a/definitions/src/Simplex/Messaging/Protocol.hs b/definitions/src/Simplex/Messaging/Protocol.hs
index c15e97ceac..fa3241c60e 100644
--- a/definitions/src/Simplex/Messaging/Protocol.hs
+++ b/definitions/src/Simplex/Messaging/Protocol.hs
@@ -20,6 +20,7 @@
 
 module Simplex.Messaging.Protocol where
 
+import Control.Monad.Trans.Except
 import Data.Kind
 import Data.Singletons
 import Data.Singletons.TH
@@ -118,18 +119,18 @@ class Monad m => PartyProtocol m (p :: Party) where
   api ::
     Command from fs fs' p ps ps' res ->
     Connection p ps ->
-    m (Either String (res, Connection p ps'))
+    ExceptT String m (res, Connection p ps')
   action ::
     Command p ps ps' to ts ts' res ->
     Connection p ps ->
-    Either String res ->
-    m (Either String (Connection p ps'))
+    ExceptT String m res ->
+    ExceptT String m (Connection p ps')
 
-apiStub :: Monad m => Connection p ps -> m (Either String (res, Connection p ps'))
-apiStub _ = return $ Left "api not implemented"
+apiStub :: Monad m => Connection p ps -> ExceptT String m (res, Connection p ps')
+apiStub _ = throwE "api not implemented"
 
-actionStub :: Monad m => Connection p ps -> Either String res -> m (Either String (Connection p ps'))
-actionStub _ _ = return $ Left "action not implemented"
+actionStub :: Monad m => Connection p ps -> ExceptT String m res -> ExceptT String m (Connection p ps')
+actionStub _ _ = throwE "action not implemented"
 
 type AllowedStates from fs fs' to ts ts' =
   ( HasState from fs,