blob: 4e293c8a8bac8d84920900215bdc9b501839f36a (
plain)
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
|
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
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, asks, runReader)
import Effectful.Resource (runResource)
import Hsm.Core.App (launch)
import Hsm.Core.Env (deriveFromYaml)
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 :: Int
}
$(deriveFromYaml ''Env)
singleError :: (Concurrent :> es, Reader Env :> es) => Stream (Eff es) Error
singleError =
fromEffect $ do
-- Seemingly, the service needs to be alive for a bit for ZMQ comms to
-- kick in.
asks alive >>= threadDelay
return $ Error 0 "Sent from dummy-fail service"
-- Dummy fail service:
-- Proof of concept. Publishes a single error that can be catched by a
-- listening client.
main :: IO ()
main =
launch @Env "dummy-fail" withoutInputEcho $ \env logger level ->
(singleError & send @Env)
& runServer @Env
& runConcurrent
& runLog env.name logger level
& runReader env
& runResource
& runEff
|
