diff options
Diffstat (limited to 'hsm-core/Hsm/Core/Zmq/Server.hs')
-rw-r--r-- | hsm-core/Hsm/Core/Zmq/Server.hs | 27 |
1 files changed, 9 insertions, 18 deletions
diff --git a/hsm-core/Hsm/Core/Zmq/Server.hs b/hsm-core/Hsm/Core/Zmq/Server.hs index 2e9217b..6ea8aeb 100644 --- a/hsm-core/Hsm/Core/Zmq/Server.hs +++ b/hsm-core/Hsm/Core/Zmq/Server.hs @@ -10,15 +10,15 @@ module Hsm.Core.Zmq.Server , runServer ) where -import Data.Binary (Binary) -import Data.Text (Text, pack, unpack) +import Data.ByteString (ByteString) +import Data.Text (Text, unpack) import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>)) import Effectful.Dispatch.Static qualified as E import Effectful.Log (Log, localDomain, logInfo_, logTrace_) import Effectful.Reader.Static (Reader, ask) import Effectful.Resource (Resource) import GHC.Records (HasField) -import Hsm.Core.Message (message) +import Hsm.Core.Message (topic) import Hsm.Core.Zmq (withSocket) import Streamly.Data.Fold qualified as S (drain) import Streamly.Data.Stream qualified as S (Stream, fold, mapM) @@ -34,24 +34,15 @@ newtype instance E.StaticRep Server = domain :: Text domain = "server" -send :: - forall env es a. - ( HasField "name" env Text - , Log :> es - , Reader env :> es - , Server :> es - , Binary a - , Show a - ) - => S.Stream (Eff es) a - -> Eff es () +send :: (Log :> es, Server :> es) => S.Stream (Eff es) ByteString -> Eff es () send = S.fold S.drain . S.mapM sender where - sender payload = do + sender message = do Server sock <- E.getStaticRep - env <- ask @env - E.unsafeEff_ $ Z.send sock [] $ message env.name payload - localDomain domain $ logTrace_ $ "Message sent: " <> pack (show payload) + E.unsafeEff_ $ Z.send sock [] message + localDomain domain + $ logTrace_ + $ "Message sent with topic: " <> topic message runServer :: forall env es a. |