1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.ByteString (ByteString)
import Data.Function ((&))
import Data.Text (Text)
import Effectful (Eff, (:>), runEff)
import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
import Effectful.Log (runLog)
import Effectful.Reader.Static (Reader, ask, runReader)
import Effectful.Resource (runResource)
import Hsm.Core.App (launch)
import Hsm.Core.Env (deriveFromYaml)
import Hsm.Core.Message (message)
import Hsm.Core.Zmq.Server (runServer, send)
import Hsm.Status.Error (Error(Error))
import Streamly.Data.Stream (Stream, fromEffect)
import System.IO.Echo (withoutInputEcho)
data Env = Env
{ name :: Text
, pubEp :: Text
, alive :: Word
}
$(deriveFromYaml ''Env)
singleError ::
(Concurrent :> es, Reader Env :> es) => Stream (Eff es) ByteString
singleError =
fromEffect $ do
env <- ask @Env
-- The service needs to remain active for a short time to ensure the ZMQ
-- message is sent. Without this delay, the service may exit before
-- the communication occurs, preventing the message from being
-- transmitted.
threadDelay $ fromIntegral env.alive
return $ message env.name $ Error 0 "Sent from dummy-fail service"
-- Dummy Fail Service: A proof of concept that publishes a single error
-- message, which can be caught by a listening client.
main :: IO ()
main =
launch @Env "dummy-fail" withoutInputEcho $ \env logger level ->
(singleError & send)
& runServer @Env
& runConcurrent
& runLog env.name logger level
& runReader env
& runResource
& runEff
|
