aboutsummaryrefslogtreecommitdiff
path: root/hsm-status/Hsm
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-status/Hsm')
-rw-r--r--hsm-status/Hsm/Status.hs41
-rw-r--r--hsm-status/Hsm/Status/Error.hs13
2 files changed, 41 insertions, 13 deletions
diff --git a/hsm-status/Hsm/Status.hs b/hsm-status/Hsm/Status.hs
new file mode 100644
index 0000000..8154611
--- /dev/null
+++ b/hsm-status/Hsm/Status.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hsm.Status
+ ( StatusEnv(..)
+ , statusEnvDefault
+ , status
+ ) where
+
+import Foreign.Ptr (Ptr)
+import GHC.Records (HasField)
+import Hsm.GPIO (GPIO(..), LineRequest, active, inactive, setPins)
+import Hsm.Log qualified as L
+
+data StatusEnv = StatusEnv
+ { gpioOk :: GPIO
+ , gpioError :: GPIO
+ }
+
+statusEnvDefault :: StatusEnv
+statusEnvDefault = StatusEnv {gpioOk = GPIO17, gpioError = GPIO27}
+
+status ::
+ HasField "statusEnv" env StatusEnv
+ => Ptr LineRequest
+ -> env
+ -> [Bool]
+ -> IO ()
+status lineRequest env signals = do
+ if and signals
+ then do
+ logMsg "All signals OK"
+ setPins lineRequest [env.statusEnv.gpioError] inactive
+ setPins lineRequest [env.statusEnv.gpioOk] active
+ else do
+ logMsg "Error signal received"
+ setPins lineRequest [env.statusEnv.gpioError] active
+ setPins lineRequest [env.statusEnv.gpioOk] inactive
+ where
+ logMsg = L.logMsg ["status"]
diff --git a/hsm-status/Hsm/Status/Error.hs b/hsm-status/Hsm/Status/Error.hs
deleted file mode 100644
index 2853d6b..0000000
--- a/hsm-status/Hsm/Status/Error.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
-module Hsm.Status.Error
- ( Error(Error)
- ) where
-
-import Data.Binary (Binary)
-import Data.Text (Text)
-import GHC.Generics (Generic)
-
-data Error =
- Error Int Text
- deriving (Binary, Generic, Show)