diff options
Diffstat (limited to 'hsm-status/Main.hs')
-rw-r--r-- | hsm-status/Main.hs | 41 |
1 files changed, 22 insertions, 19 deletions
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 () |