voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

fixed minor possible leak on callService

This commit is contained in:
Dmitry Zuikov 2023-10-29 07:46:15 +03:00
parent 408cfb2c51
commit eab3175d52
4 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
hbs2-core/lib/HBS2/Net/Auth/Credentials.hs
View File

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

2
hbs2-core/lib/HBS2/Net/Proto/Definition.hs
View File

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

28
hbs2-core/lib/HBS2/Net/Proto/Service.hs
View File

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

3
hbs2-core/lib/HBS2/Prelude.hs
View File

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