fixed minor possible leak on callService

hbs2-core/lib/HBS2/Net/Auth/Credentials.hs

@@ -158,6 +158,7 @@ instance ( Serialise  (PeerCredentials e)
     where
      bs = LBS.toStrict $ serialise c
 
+-- FIXME: move-thouse-instances-to-appropriate-place-ASAP
 
 instance Pretty (AsBase58 Sign.PublicKey) where
   pretty (AsBase58 pk) = pretty $ B8.unpack $ toBase58 (Crypto.encode pk)

hbs2-core/lib/HBS2/Net/Proto/Definition.hs

@@ -42,6 +42,8 @@ import Crypto.Saltine.Core.Sign qualified as Sign
 import Crypto.Saltine.Core.Box qualified as Encrypt
 
 
+
+-- FIXME: move-to-types-crypto-ASAP
 type instance Encryption L4Proto = HBS2Basic
 
 type instance Encryption UNIX = HBS2Basic

hbs2-core/lib/HBS2/Net/Proto/Service.hs

@@ -27,7 +27,7 @@ import System.Random (randomIO)
 import Data.Word
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
-
+import Control.Exception (bracket_)
 
 type family Input a  :: Type
 type family Output a :: Type
@@ -243,22 +243,24 @@ callService caller input = do
 
   resp <- UIO.newTQueueIO
 
-  atomically $ do
-    UIO.modifyTVar (callWaiters caller) (HashMap.insert (reqNum req) resp)
-    UIO.writeTQueue (callInQ caller) req
+  let addWaiter = atomically $ do
+        UIO.modifyTVar (callWaiters caller) (HashMap.insert (reqNum req) resp)
+        UIO.writeTQueue (callInQ caller) req
 
-  msg <- atomically $ UIO.readTQueue resp
+  let removeWaiter = atomically $
+        UIO.modifyTVar (callWaiters caller) (HashMap.delete (reqNum req))
 
-  case msg of
-    ServiceResponse _ (Right bs) -> do
-      case deserialiseOrFail @(Output method) bs of
-        Left _  -> pure (Left ErrorInvalidResponse)
-        Right x -> pure (Right x)
+  liftIO $ bracket_ addWaiter removeWaiter $ do
+    msg <- atomically $ UIO.readTQueue resp
 
+    case msg of
+      ServiceResponse _ (Right bs) ->
+        case deserialiseOrFail @(Output method) bs of
+          Left _  -> pure (Left ErrorInvalidResponse)
+          Right x -> pure (Right x)
 
-    ServiceResponse _ (Left wtf) -> pure (Left wtf)
-
-    _ -> pure (Left ErrorInvalidResponse)
+      ServiceResponse _ (Left wtf) -> pure (Left wtf)
+      _ -> pure (Left ErrorInvalidResponse)
 
 
 makeClient :: forall api e m  . ( MonadIO m

hbs2-core/lib/HBS2/Prelude.hs

@@ -46,6 +46,9 @@ import GHC.Generics
 import Data.Time.Clock (NominalDiffTime(..))
 import Codec.Serialise
 
+import UnliftIO
+import Control.Monad.IO.Unlift
+
 none :: forall m . Monad m => m ()
 none = pure ()