aboutsummaryrefslogtreecommitdiff
path: root/hsm-status
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-status')
-rw-r--r--hsm-status/Main.hs41
-rw-r--r--hsm-status/hsm-status.cabal1
2 files changed, 23 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 ()
diff --git a/hsm-status/hsm-status.cabal b/hsm-status/hsm-status.cabal
index 64528bd..feeff93 100644
--- a/hsm-status/hsm-status.cabal
+++ b/hsm-status/hsm-status.cabal
@@ -19,6 +19,7 @@ executable status
build-depends:
, base
, binary
+ , bytestring
, containers
, echo
, effectful-core