From ebb88408c1d0884b5ca9b7d68bf76d31c33d2e5b Mon Sep 17 00:00:00 2001
From: Paul Oliver <contact@pauloliver.dev>
Date: Fri, 17 Jan 2025 14:37:20 -0800
Subject: Allows services to publish different topics

---
 hsm-status/Main.hs | 41 ++++++++++++++++++++++-------------------
 1 file changed, 22 insertions(+), 19 deletions(-)

(limited to 'hsm-status/Main.hs')

diff --git a/hsm-status/Main.hs b/hsm-status/Main.hs
index 6220474..ec883ff 100644
--- a/hsm-status/Main.hs
+++ b/hsm-status/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
+import Data.ByteString (ByteString)
 import Data.Function ((&))
 import Data.Set (Set, singleton)
 import Data.Text (Text, pack)
@@ -13,6 +14,7 @@ import Effectful.State.Static.Local (evalState)
 import Hsm.Core.App (launch)
 import Hsm.Core.Env (deriveFromYaml)
 import Hsm.Core.Fsm qualified as F
+import Hsm.Core.Message (body)
 import Hsm.Core.Zmq.Client (poll, runClient)
 import Hsm.GPIO (GPIO, GPIOEffect, runGPIO, toggle)
 import Hsm.Status.Error (Error(Error))
@@ -33,28 +35,29 @@ $(deriveFromYaml ''Env)
 
 result ::
      Bool
-  -> F.FsmState [Error] Bool Env ()
-  -> [Error]
-  -> F.FsmOutput [Error] Bool Env ()
-result sta next es =
-  F.FsmOutput (Just $ F.FsmResult sta () next) (logError <$> es)
+  -> F.FsmState [ByteString] Bool Env ()
+  -> [ByteString]
+  -> F.FsmOutput [ByteString] Bool Env ()
+result sta next errs =
+  F.FsmOutput (Just $ F.FsmResult sta () next) (logError <$> errs)
   where
-    logError (Error code msg) =
-      ( LogAttention
-      , "Error received with code "
-          <> pack (show code)
-          <> " and message: "
-          <> msg)
+    logError err =
+      let Error code msg = body err
+       in ( LogAttention
+          , "Error received with code "
+              <> pack (show code)
+              <> " and message: "
+              <> msg)
 
-stateOk :: F.FsmState [Error] Bool Env ()
+stateOk :: F.FsmState [ByteString] Bool Env ()
 stateOk =
-  F.FsmState "ok" $ \msg _ _ ->
-    if null msg
-      then result True stateOk msg
-      else result False stateError msg
+  F.FsmState "ok" $ \errs _ _ ->
+    if null errs
+      then result True stateOk errs
+      else result False stateError errs
 
-stateError :: F.FsmState [Error] Bool Env ()
-stateError = F.FsmState "error" $ \msg _ _ -> result False stateError msg
+stateError :: F.FsmState [ByteString] Bool Env ()
+stateError = F.FsmState "error" $ \errs _ _ -> result False stateError errs
 
 handle ::
      (GPIOEffect Bool :> es, Log :> es, Reader Env :> es)
@@ -75,7 +78,7 @@ mapper env False = singleton env.gpioError
 main :: IO ()
 main =
   launch "status" withoutInputEcho $ \env logger level ->
-    (poll @_ @Error & F.fsm @_ @_ @Env @() & handle)
+    (poll & F.fsm @_ @_ @Env @() & handle)
       & runClient @Env
       & runGPIO (mapper env)
       & evalState ()
-- 
cgit v1.2.1