Initial commitHEADmaster

18 files changed, 887 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c33954f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle/
diff --git a/README b/README
new file mode 100644
index 0000000..f20662e
--- /dev/null
+++ b/README
@@ -0,0 +1,33 @@
+HS-MOUSE
+========
+
+Repo containing experimental control code for robotics. Services are
+implemented as finite state machines that communicate using the ZMQ pub/sub
+protocol.
+
+SETUP
+-----
+Use GHCUP to install specific Cabal/GHC versions:
+
+  https://www.haskell.org/ghcup/
+
+Compilation requires the following:
+
+- Cabal >= 3.12.1.0
+- GHC >= 9.10.1
+
+BUILD
+-----
+Build the project with:
+
+  $> cabal build all
+
+TEST
+----
+To check that it works, on one terminal run the "dummy-receiver" service:
+
+  $> cabal exec dummy-receiver -- -ltrace
+
+On a different terminal run the "dummy-pulser" service:
+
+  $> cabal exec dummy-pulser -- -ltrace
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..6fde971
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1,3 @@
+allow-newer: all
+constraints: text >= 2.1.2
+packages: */*.cabal
diff --git a/config.yaml b/config.yaml
new file mode 100644
index 0000000..e9410e3
--- /dev/null
+++ b/config.yaml
@@ -0,0 +1,12 @@
+dummy-pulser:
+  name: pulser
+  pubEp: tcp://127.0.0.1:10001
+  period: 1000000
+  pulses: 10
+dummy-receiver:
+  name: receiver
+  subEps: [tcp://127.0.0.1:10001]
+  topics: [pulser]
+command:
+  name: command
+  pubEp: tcp://127.0.0.1:10002
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..e9bb370
--- /dev/null
+++ b/fourmolu.yaml
@@ -0,0 +1,53 @@
+# Number of spaces per indentation step
+indentation: 2
+
+# Max line length for automatic line breaking
+column-limit: 80
+
+# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
+function-arrows: leading
+
+# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
+comma-style: leading
+
+# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
+import-export-style: leading
+
+# Whether to full-indent or half-indent 'where' bindings past the preceding body
+indent-wheres: false
+
+# Whether to leave a space before an opening record brace
+record-brace-space: true
+
+# Number of spaces between top-level declarations
+newlines-between-decls: 1
+
+# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
+haddock-style: multi-line
+
+# How to print module docstring
+haddock-style-module: null
+
+# Styling of let blocks (choices: auto, inline, newline, or mixed)
+let-style: auto
+
+# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
+in-style: right-align
+
+# Whether to put parentheses around a single constraint (choices: auto, always, or never)
+single-constraint-parens: never
+
+# Whether to put parentheses around a single deriving class (choices: auto, always, or never)
+single-deriving-parens: never
+
+# Output Unicode syntax (choices: detect, always, or never)
+unicode: never
+
+# Give the programmer more choice on where to insert blank lines
+respectful: false
+
+# Fixity information for operators
+fixities: []
+
+# Module reexports Fourmolu should know about
+reexports: []
diff --git a/hsm-command/Hsm/Command/Command.hs b/hsm-command/Hsm/Command/Command.hs
new file mode 100644
index 0000000..2080143
--- /dev/null
+++ b/hsm-command/Hsm/Command/Command.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Hsm.Command.Command
+  ( Direction (Forward, Backward, Left, Right)
+  , Angle (CW, CCW)
+  , Speed (Slow, Mid, Fast)
+  , Command (Move, Rotate)
+  , commandStream
+  )
+where
+
+import Data.Binary (Binary)
+import Data.Function ((&))
+import Data.Maybe (fromJust, isJust)
+import Data.Text (pack)
+import Effectful (Eff, (:>))
+import Effectful.Log (Log, logAttention_)
+import GHC.Generics (Generic)
+import Hsm.Command.Readline (Readline, readline)
+import Streamly.Data.Stream (Stream, mapMaybeM, repeatM, takeWhile)
+import Text.Read (readEither)
+import Prelude hiding (Left, Right, takeWhile)
+import Prelude qualified as P
+
+data Direction
+  = Forward
+  | Backward
+  | Left
+  | Right
+  deriving (Binary, Generic, Read, Show)
+
+data Angle
+  = CW
+  | CCW
+  deriving (Binary, Generic, Read, Show)
+
+data Speed
+  = Slow
+  | Mid
+  | Fast
+  deriving (Binary, Generic, Read, Show)
+
+data Command
+  = Move Direction Speed Int
+  | Rotate Angle Speed Int
+  deriving (Binary, Generic, Read, Show)
+
+commandStream
+  :: forall es
+   . ( Log :> es
+     , Readline :> es
+     )
+  => Stream (Eff es) Command
+commandStream =
+  repeatM readline
+    & takeWhile isJust
+    & mapMaybeM (parse . fromJust)
+ where
+  parse
+    :: Log :> es
+    => String
+    -> Eff es (Maybe Command)
+  parse string =
+    case readEither string of
+      P.Left err -> logAttention_ (pack err) >> return Nothing
+      P.Right command -> return $ Just command
diff --git a/hsm-command/Hsm/Command/Readline.hs b/hsm-command/Hsm/Command/Readline.hs
new file mode 100644
index 0000000..66246b5
--- /dev/null
+++ b/hsm-command/Hsm/Command/Readline.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Command.Readline
+  ( Readline
+  , readline
+  , runReadline
+  )
+where
+
+import Data.Function ((&))
+import Effectful (Dispatch (Static), DispatchOf, Eff, Effect, IOE, (:>))
+import Effectful.Dispatch.Static qualified as S
+import Effectful.Log (Log, getLoggerEnv, leLogger, waitForLogger)
+import Effectful.Resource (Resource, allocate)
+import System.Console.Haskeline qualified as H
+import System.Console.Haskeline.IO qualified as H
+import Prelude hiding (takeWhile)
+
+data Readline :: Effect
+
+type instance DispatchOf Readline = Static S.WithSideEffects
+
+newtype instance S.StaticRep Readline = Readline H.InputState
+
+readline
+  :: forall es
+   . ( Log :> es
+     , Readline :> es
+     )
+  => Eff es (Maybe String)
+readline = do
+  flushLogger
+  Readline handle <- S.getStaticRep
+  H.getInputLine "% "
+    & H.withInterrupt
+    & H.handleInterrupt (return Nothing)
+    & H.queryInput handle
+    & S.unsafeEff_
+ where
+  flushLogger :: Eff es ()
+  flushLogger = getLoggerEnv >>= S.unsafeEff_ . waitForLogger . leLogger
+
+runReadline
+  :: ( IOE :> es
+     , Resource :> es
+     )
+  => Eff (Readline : es) a
+  -> Eff es a
+runReadline action = do
+  handle <- snd <$> allocate state H.cancelInput
+  S.evalStaticRep (Readline handle) action
+ where
+  settings :: H.Settings IO
+  settings = H.defaultSettings {H.historyFile = Just "/tmp/hsm_command_history"}
+
+  state :: IO H.InputState
+  state = H.initializeInput settings
diff --git a/hsm-command/Main.hs b/hsm-command/Main.hs
new file mode 100644
index 0000000..78fa607
--- /dev/null
+++ b/hsm-command/Main.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main
+  ( main
+  )
+where
+
+import Data.Aeson.TH (defaultOptions, deriveFromJSON, rejectUnknownFields)
+import Data.Function ((&))
+import Data.Text (Text)
+import Effectful (runEff)
+import Effectful.Log qualified as L
+import Effectful.Reader.Static (runReader)
+import Effectful.Resource (runResource)
+import Hsm.Command.Command (commandStream)
+import Hsm.Command.Readline (runReadline)
+import Hsm.Core.App (launchWithEcho)
+import Hsm.Core.Zmq (runServer, send)
+import Streamly.Data.Fold (drain)
+import Streamly.Data.Stream (fold, mapM)
+import Prelude hiding (mapM, takeWhile)
+
+data Env = Env
+  { name :: Text
+  , pubEp :: Text
+  }
+
+$(deriveFromJSON defaultOptions {rejectUnknownFields = True} ''Env)
+
+main :: IO ()
+main =
+  launchWithEcho @Env "command" $ \env logger level ->
+    (commandStream & mapM (send @_ @Env) & fold drain)
+      & runServer @Env
+      & L.runLog env.name logger level
+      & runReader env
+      & runReadline
+      & runResource
+      & runEff
diff --git a/hsm-command/hsm-command.cabal b/hsm-command/hsm-command.cabal
new file mode 100644
index 0000000..95f9ffa
--- /dev/null
+++ b/hsm-command/hsm-command.cabal
@@ -0,0 +1,45 @@
+cabal-version: 3.4
+author:        Paul Oliver
+build-type:    Simple
+maintainer:    contact@pauloliver.dev
+name:          hsm-command
+version:       0.1.0.0
+
+library
+  build-depends:
+    , base
+    , binary
+    , effectful-core
+    , haskeline
+    , log-effectful
+    , resourcet-effectful
+    , streamly-core
+    , text
+
+  exposed-modules:
+    Hsm.Command.Command
+    Hsm.Command.Readline
+
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024
+
+executable command
+  build-depends:
+    , aeson
+    , base
+    , binary
+    , effectful-core
+    , haskeline
+    , hsm-core
+    , log-effectful
+    , resourcet-effectful
+    , streamly-core
+    , text
+
+  main-is:          Main.hs
+  other-modules:
+    Hsm.Command.Command
+    Hsm.Command.Readline
+
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024
diff --git a/hsm-core/Hsm/Core/App.hs b/hsm-core/Hsm/Core/App.hs
new file mode 100644
index 0000000..1bb3465
--- /dev/null
+++ b/hsm-core/Hsm/Core/App.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Hsm.Core.App
+  ( launch
+  , launchWithEcho
+  )
+where
+
+import Control.Applicative ((<**>))
+import Data.Aeson (FromJSON, Result (Error, Success), Value, fromJSON)
+import Data.Aeson.Key (fromString)
+import Data.Aeson.KeyMap (KeyMap, (!?))
+import Data.Composition ((.:))
+import Data.Function.Slip (slipl)
+import Data.Maybe (fromMaybe)
+import Data.Text (pack, unpack)
+import Data.Yaml (decodeFileThrow)
+import Effectful.Log qualified as L
+import Log.Backend.StandardOutput (withStdOutLogger)
+import Options.Applicative qualified as P
+import System.IO.Echo (withoutInputEcho)
+
+data Options = Options String L.LogLevel
+
+type App e a = e -> L.Logger -> L.LogLevel -> IO a
+
+parser :: P.Parser Options
+parser = do
+  config <-
+    P.strOption $
+      P.help "Path to services config file"
+        <> P.short 'c'
+        <> P.long "config"
+        <> P.metavar "PATH"
+        <> P.value "config.yaml"
+        <> P.showDefault
+  level <-
+    P.option (P.eitherReader $ L.readLogLevelEither . pack) $
+      P.help "Log level"
+        <> P.short 'l'
+        <> P.long "log-level"
+        <> P.metavar "LEVEL"
+        <> P.value L.LogInfo
+        <> P.showDefaultWith (unpack . L.showLogLevel)
+  pure $ Options config level
+
+launchWith
+  :: forall e a
+   . FromJSON e
+  => String
+  -> App e a
+  -> (IO a -> IO a)
+  -> IO a
+launchWith name app wrapper = do
+  Options path level <- P.execParser info
+  returnEnv path >>= runApp level
+ where
+  title :: String
+  title = "Launch " <> name <> " service"
+
+  description :: P.InfoMod Options
+  description = P.fullDesc <> P.progDesc title
+
+  info :: P.ParserInfo Options
+  info = P.info (parser <**> P.helper) description
+
+  err :: String
+  err = "Service configuration for " <> name <> " not found"
+
+  load :: KeyMap Value -> Value
+  load configs = fromMaybe (error err) $ configs !? fromString name
+
+  check :: Result e -> e
+  check (Success e) = e
+  check (Error str) = error str
+
+  returnEnv :: String -> IO e
+  returnEnv = fmap (check . fromJSON . load) . decodeFileThrow
+
+  runApp :: L.LogLevel -> e -> IO a
+  runApp = wrapper . withStdOutLogger .: slipl app
+
+launch :: FromJSON e => String -> App e a -> IO a
+launch = slipl launchWith withoutInputEcho
+
+launchWithEcho :: FromJSON e => String -> App e a -> IO a
+launchWithEcho = slipl launchWith id
diff --git a/hsm-core/Hsm/Core/Fsm.hs b/hsm-core/Hsm/Core/Fsm.hs
new file mode 100644
index 0000000..e0f54a3
--- /dev/null
+++ b/hsm-core/Hsm/Core/Fsm.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hsm.Core.Fsm
+  ( FsmState (FsmState)
+  , FsmResult (FsmResult)
+  , FsmOutput (FsmOutput)
+  , fsm
+  , fsmStream
+  , pLogAttention
+  , pLogInfo
+  , pLogTrace
+  )
+where
+
+import Control.Monad (forM_)
+import Data.Aeson.Types (emptyObject)
+import Data.Composition ((.:))
+import Data.Function.Slip (slipl)
+import Data.List (singleton)
+import Data.Maybe (fromJust, isJust)
+import Data.Text (Text)
+import Effectful (Eff, (:>))
+import Effectful.Log qualified as L
+import Effectful.Reader.Static (Reader, ask)
+import Effectful.State.Static.Local (State, get, put)
+import Streamly.Data.Stream (Stream, mapM, takeWhile)
+import Prelude hiding (mapM, takeWhile)
+
+data FsmState i o e s
+  = FsmState Text (i -> e -> s -> FsmOutput i o e s)
+
+data FsmResult i o e s
+  = FsmResult o s (FsmState i o e s)
+
+data FsmOutput i o e s
+  = FsmOutput (Maybe (FsmResult i o e s)) [(L.LogLevel, Text)]
+
+type FsmConstraint i o e s es =
+  ( L.Log :> es
+  , Reader e :> es
+  , State (FsmState i o e s) :> es
+  , State s :> es
+  )
+
+fsm :: forall i o e s es. FsmConstraint i o e s es => i -> Eff es (Maybe o)
+fsm input =
+  L.localDomain "fsm" $ do
+    FsmState name action <- get
+    state <- get
+    env <- ask
+    L.logTrace_ $ "Entering state " <> name
+    FsmOutput res logs <- return $ action input env state
+    L.localDomain name $ forM_ logs $ uncurry $ slipl L.logMessage emptyObject
+    L.logTrace_ $ "Exiting state " <> name
+    maybe exit push res
+ where
+  push :: FsmResult i o e s -> Eff es (Maybe o)
+  push (FsmResult output state next) = do
+    put state
+    put next
+    return $ Just output
+
+  exit :: Eff es (Maybe o)
+  exit = do
+    L.logAttention_ "No state returned, exiting FSM"
+    return Nothing
+
+fsmStream
+  :: forall i o e s es
+   . FsmConstraint i o e s es
+  => Stream (Eff es) i
+  -> Stream (Eff es) o
+fsmStream = mapM (return . fromJust) . takeWhile isJust . mapM (fsm @_ @_ @e @s)
+
+type LogList = [(L.LogLevel, Text)]
+
+pLog :: L.LogLevel -> Text -> LogList
+pLog = singleton .: (,)
+
+pLogAttention :: Text -> LogList
+pLogAttention = pLog L.LogAttention
+
+pLogInfo :: Text -> LogList
+pLogInfo = pLog L.LogInfo
+
+pLogTrace :: Text -> LogList
+pLogTrace = pLog L.LogTrace
diff --git a/hsm-core/Hsm/Core/Message.hs b/hsm-core/Hsm/Core/Message.hs
new file mode 100644
index 0000000..2fb5d3c
--- /dev/null
+++ b/hsm-core/Hsm/Core/Message.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hsm.Core.Message
+  ( message
+  , topic
+  , body
+  )
+where
+
+import Data.Binary (Binary, decode, encode)
+import Data.ByteString (ByteString, fromStrict, toStrict)
+import Data.ByteString.Char8 qualified as B (breakSubstring, drop, length)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+
+sep :: ByteString
+sep = "//"
+
+message :: Binary a => Text -> a -> ByteString
+message t b = encodeUtf8 t <> sep <> toStrict (encode b)
+
+topic :: ByteString -> Text
+topic = decodeUtf8 . fst . B.breakSubstring sep
+
+body :: Binary a => ByteString -> a
+body = decode . fromStrict . B.drop (B.length sep) . snd . B.breakSubstring sep
diff --git a/hsm-core/Hsm/Core/Zmq.hs b/hsm-core/Hsm/Core/Zmq.hs
new file mode 100644
index 0000000..fe764eb
--- /dev/null
+++ b/hsm-core/Hsm/Core/Zmq.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Core.Zmq
+  ( Client
+  , receive
+  , runClient
+  , Server
+  , send
+  , runServer
+  )
+where
+
+import Control.Monad (forM_)
+import Data.Aeson.Types (Value, emptyObject)
+import Data.Binary (Binary)
+import Data.Function ((&))
+import Data.Text (Text, show, unpack)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Effectful (Dispatch (Static), DispatchOf, Eff, Effect, IOE, (:>))
+import Effectful.Dispatch.Static qualified as S
+import Effectful.Log qualified as L
+import Effectful.Reader.Static (Reader, ask)
+import Effectful.Resource (Resource, allocate)
+import GHC.Records (HasField)
+import Hsm.Core.Message (body, message, topic)
+import System.ZMQ4 qualified as Z
+import Prelude hiding (show)
+
+type DefaultLoggerIO = UTCTime -> L.LogLevel -> Text -> Value -> IO ()
+
+type LoggerIO = L.LogLevel -> Text -> IO ()
+
+type ZmqResource t = (Z.Context, Z.Socket t)
+
+type ZmqConstraint es = (IOE :> es, L.Log :> es, Resource :> es)
+
+withSocket
+  :: forall t es
+   . ( Z.SocketType t
+     , ZmqConstraint es
+     )
+  => t
+  -> Eff es (Z.Socket t)
+withSocket stype = L.getLoggerIO >>= withResource . logIO
+ where
+  logIO :: DefaultLoggerIO -> LoggerIO
+  logIO loggerIO level msg = do
+    now <- getCurrentTime
+    loggerIO now level msg emptyObject
+
+  withResource :: LoggerIO -> Eff es (Z.Socket t)
+  withResource logger = snd . snd <$> allocate acquire release
+   where
+    acquire :: IO (ZmqResource t)
+    acquire = do
+      logger L.LogTrace "Acquiring ZMQ context"
+      context <- Z.context
+      socket <- Z.socket context stype
+      return (context, socket)
+
+    release :: ZmqResource t -> IO ()
+    release (context, socket) = do
+      logger L.LogTrace "Releasing ZMQ context"
+      Z.close socket
+      Z.shutdown context
+
+data Client :: Effect
+
+type instance DispatchOf Client = Static S.WithSideEffects
+
+newtype instance S.StaticRep Client = Client (Z.Socket Z.Sub)
+
+clientDomain :: Text
+clientDomain = "client"
+
+receive
+  :: forall a es
+   . ( Binary a
+     , Client :> es
+     , L.Log :> es
+     , Show a
+     )
+  => Eff es a
+receive = do
+  Client socket <- S.getStaticRep
+  msg <- S.unsafeEff_ $ Z.receive socket
+  "Message received [" <> topic msg <> "]: " <> show (body @a msg)
+    & L.logTrace_
+    & L.localDomain clientDomain
+  return $ body msg
+
+runClient
+  :: forall e es a
+   . ( HasField "subEps" e [Text]
+     , HasField "topics" e [Text]
+     , Reader e :> es
+     , ZmqConstraint es
+     )
+  => Eff (Client : es) a
+  -> Eff es a
+runClient action = withSocket Z.Sub >>= runAction
+ where
+  runAction :: Z.Socket Z.Sub -> Eff es a
+  runAction socket = S.evalStaticRep (Client socket) $ initialize >> action
+   where
+    connect :: Text -> Eff (Client : es) ()
+    connect = S.unsafeEff_ . Z.connect socket . unpack
+
+    subscribe :: Text -> Eff (Client : es) ()
+    subscribe = S.unsafeEff_ . Z.subscribe socket . encodeUtf8
+
+    initialize :: Eff (Client : es) ()
+    initialize =
+      L.localDomain clientDomain $ do
+        L.logInfo_ "Initializing ZMQ client"
+        env <- ask @e
+        forM_ env.subEps connect
+        forM_ env.topics subscribe
+        L.logTrace_ $ "Listening to " <> show env.subEps
+        L.logTrace_ $ "Subscribed to " <> show env.topics
+
+data Server :: Effect
+
+type instance DispatchOf Server = Static S.WithSideEffects
+
+newtype instance S.StaticRep Server = Server (Z.Socket Z.Pub)
+
+serverDomain :: Text
+serverDomain = "server"
+
+send
+  :: forall a e es
+   . ( Binary a
+     , HasField "name" e Text
+     , L.Log :> es
+     , Reader e :> es
+     , Server :> es
+     , Show a
+     )
+  => a
+  -> Eff es ()
+send payload = do
+  Server s <- S.getStaticRep
+  env <- ask @e
+  S.unsafeEff_ $ Z.send s [] $ message env.name payload
+  L.localDomain serverDomain $ L.logTrace_ $ "Message sent: " <> show payload
+
+runServer
+  :: forall e es a
+   . ( HasField "pubEp" e Text
+     , Reader e :> es
+     , ZmqConstraint es
+     )
+  => Eff (Server : es) a
+  -> Eff es a
+runServer action = withSocket Z.Pub >>= runAction
+ where
+  runAction :: Z.Socket Z.Pub -> Eff es a
+  runAction socket = S.evalStaticRep (Server socket) $ initialize >> action
+   where
+    bind :: Text -> Eff (Server : es) ()
+    bind = S.unsafeEff_ . Z.bind socket . unpack
+
+    initialize :: Eff (Server : es) ()
+    initialize =
+      L.localDomain serverDomain $ do
+        L.logInfo_ "Initializing ZMQ server"
+        env <- ask @e
+        bind env.pubEp
+        L.logTrace_ $ "Publishing to " <> env.pubEp
diff --git a/hsm-core/hsm-core.cabal b/hsm-core/hsm-core.cabal
new file mode 100644
index 0000000..60a8e2f
--- /dev/null
+++ b/hsm-core/hsm-core.cabal
@@ -0,0 +1,35 @@
+cabal-version: 3.4
+author:        Paul Oliver
+build-type:    Simple
+maintainer:    contact@pauloliver.dev
+name:          hsm-core
+version:       0.1.0.0
+
+library
+  build-depends:
+    , aeson
+    , base
+    , binary
+    , bytestring
+    , composition
+    , composition-extra
+    , echo
+    , effectful-core
+    , log-base
+    , log-effectful
+    , optparse-applicative
+    , resourcet-effectful
+    , streamly-core
+    , text
+    , time
+    , yaml
+    , zeromq4-haskell
+
+  exposed-modules:
+    Hsm.Core.App
+    Hsm.Core.Fsm
+    Hsm.Core.Message
+    Hsm.Core.Zmq
+
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024
diff --git a/hsm-dummy-pulser/Main.hs b/hsm-dummy-pulser/Main.hs
new file mode 100644
index 0000000..5c1e818
--- /dev/null
+++ b/hsm-dummy-pulser/Main.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main
+  ( main
+  )
+where
+
+import Data.Aeson.TH (defaultOptions, deriveFromJSON, rejectUnknownFields)
+import Data.Function ((&))
+import Data.Text (Text, show)
+import Effectful (Eff, runEff, (:>))
+import Effectful.Concurrent (Concurrent, runConcurrent, threadDelay)
+import Effectful.Log (runLog)
+import Effectful.Reader.Static (Reader, ask, runReader)
+import Effectful.Resource (runResource)
+import Effectful.State.Static.Local (evalState)
+import Hsm.Core.App (launch)
+import Hsm.Core.Fsm qualified as F
+import Hsm.Core.Zmq (runServer, send)
+import Streamly.Data.Fold (drain)
+import Streamly.Data.Stream (fold, mapM, repeatM)
+import Prelude hiding (mapM, show)
+
+data Env = Env
+  { name :: Text
+  , pubEp :: Text
+  , period :: Int
+  , pulses :: Int
+  }
+
+$(deriveFromJSON defaultOptions {rejectUnknownFields = True} ''Env)
+
+tick :: (Concurrent :> es, Reader Env :> es) => Eff es ()
+tick = ask >>= threadDelay . period >> return ()
+
+run :: F.FsmState () Int Env Int
+run = F.FsmState "run" action
+ where
+  action :: () -> Env -> Int -> F.FsmOutput () Int Env Int
+  action _ env state = if state < env.pulses then next else exit
+   where
+    next :: F.FsmOutput () Int Env Int
+    next =
+      "Sending pulse #" <> show state
+        & F.pLogInfo
+        & F.FsmOutput (Just $ F.FsmResult state (succ state) run)
+
+    exit :: F.FsmOutput () Int Env Int
+    exit =
+      "Reached " <> show env.pulses <> " pulses"
+        & F.pLogAttention
+        & F.FsmOutput Nothing
+
+main :: IO ()
+main =
+  launch @Env "dummy-pulser" $ \env logger level ->
+    ( repeatM tick
+        & F.fsmStream @_ @Int @Env @Int
+        & mapM (send @_ @Env)
+        & fold drain
+    )
+      & runServer @Env
+      & runConcurrent
+      & runLog env.name logger level
+      & runReader env
+      & runResource
+      & evalState @Int 1
+      & evalState run
+      & runEff
diff --git a/hsm-dummy-pulser/hsm-dummy-pulser.cabal b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
new file mode 100644
index 0000000..7f89c08
--- /dev/null
+++ b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
@@ -0,0 +1,21 @@
+cabal-version: 3.4
+author:        Paul Oliver
+build-type:    Simple
+maintainer:    contact@pauloliver.dev
+name:          hsm-dummy-pulser
+version:       0.1.0.0
+
+executable dummy-pulser
+  build-depends:
+    , aeson
+    , base
+    , effectful
+    , hsm-core
+    , log-effectful
+    , resourcet-effectful
+    , streamly-core
+    , text
+
+  main-is:          Main.hs
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024
diff --git a/hsm-dummy-receiver/Main.hs b/hsm-dummy-receiver/Main.hs
new file mode 100644
index 0000000..37e99b8
--- /dev/null
+++ b/hsm-dummy-receiver/Main.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main
+  ( main
+  )
+where
+
+import Data.Aeson.TH (defaultOptions, deriveFromJSON, rejectUnknownFields)
+import Data.Function ((&))
+import Data.Text (Text, show)
+import Effectful (Eff, runEff, (:>))
+import Effectful.Log (Log, localDomain, logInfo_, runLog)
+import Effectful.Reader.Static (runReader)
+import Effectful.Resource (runResource)
+import Hsm.Core.App (launch)
+import Hsm.Core.Zmq (receive, runClient)
+import Streamly.Data.Fold (drain)
+import Streamly.Data.Stream (fold, mapM, repeatM)
+import Prelude hiding (mapM, show)
+
+data Env = Env
+  { name :: Text
+  , subEps :: [Text]
+  , topics :: [Text]
+  }
+
+$(deriveFromJSON defaultOptions {rejectUnknownFields = True} ''Env)
+
+receiver :: Log :> es => Int -> Eff es ()
+receiver =
+  localDomain "receiver"
+    . logInfo_
+    . mappend "Received pulse #"
+    . show
+
+main :: IO ()
+main =
+  launch @Env "dummy-receiver" $ \env logger level ->
+    (repeatM receive & mapM receiver & fold drain)
+      & runClient @Env
+      & runLog env.name logger level
+      & runReader env
+      & runResource
+      & runEff
diff --git a/hsm-dummy-receiver/hsm-dummy-receiver.cabal b/hsm-dummy-receiver/hsm-dummy-receiver.cabal
new file mode 100644
index 0000000..ab12089
--- /dev/null
+++ b/hsm-dummy-receiver/hsm-dummy-receiver.cabal
@@ -0,0 +1,21 @@
+cabal-version: 3.4
+author:        Paul Oliver
+build-type:    Simple
+maintainer:    contact@pauloliver.dev
+name:          hsm-dummy-receiver
+version:       0.1.0.0
+
+executable dummy-receiver
+  build-depends:
+    , aeson
+    , base
+    , effectful-core
+    , hsm-core
+    , log-effectful
+    , resourcet-effectful
+    , streamly-core
+    , text
+
+  main-is:          Main.hs
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024