From 70d3e37b1a088209fe84abf07a39d14dec116c6b Mon Sep 17 00:00:00 2001
From: Paul Oliver <contact@pauloliver.dev>
Date: Sat, 24 Aug 2024 11:57:18 -0700
Subject: Initial commit

---
 .gitignore                                  |  1 +
 README                                      |  6 ++
 cabal.project                               |  1 +
 config.yaml                                 |  8 +++
 fourmolu.yaml                               | 53 ++++++++++++++++++
 hsm-core/Hsm/Core/App.hs                    | 75 +++++++++++++++++++++++++
 hsm-core/Hsm/Core/Fsm.hs                    | 43 +++++++++++++++
 hsm-core/Hsm/Core/LogIO.hs                  | 25 +++++++++
 hsm-core/Hsm/Core/Message.hs                | 29 ++++++++++
 hsm-core/Hsm/Core/Pipes.hs                  | 72 ++++++++++++++++++++++++
 hsm-core/Hsm/Core/Zmq.hs                    | 80 +++++++++++++++++++++++++++
 hsm-core/hsm-core.cabal                     | 39 +++++++++++++
 hsm-dummy-pulser/Main.hs                    | 85 +++++++++++++++++++++++++++++
 hsm-dummy-pulser/hsm-dummy-pulser.cabal     | 23 ++++++++
 hsm-dummy-receiver/Main.hs                  | 51 +++++++++++++++++
 hsm-dummy-receiver/hsm-dummy-receiver.cabal | 20 +++++++
 16 files changed, 611 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 README
 create mode 100644 cabal.project
 create mode 100644 config.yaml
 create mode 100644 fourmolu.yaml
 create mode 100644 hsm-core/Hsm/Core/App.hs
 create mode 100644 hsm-core/Hsm/Core/Fsm.hs
 create mode 100644 hsm-core/Hsm/Core/LogIO.hs
 create mode 100644 hsm-core/Hsm/Core/Message.hs
 create mode 100644 hsm-core/Hsm/Core/Pipes.hs
 create mode 100644 hsm-core/Hsm/Core/Zmq.hs
 create mode 100644 hsm-core/hsm-core.cabal
 create mode 100644 hsm-dummy-pulser/Main.hs
 create mode 100644 hsm-dummy-pulser/hsm-dummy-pulser.cabal
 create mode 100644 hsm-dummy-receiver/Main.hs
 create mode 100644 hsm-dummy-receiver/hsm-dummy-receiver.cabal

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..5fb7861
--- /dev/null
+++ b/README
@@ -0,0 +1,6 @@
+HS-MOUSE
+========
+
+Repo containing experimental control code for robotics. Services are
+implemented as finite state machines that communicate using the ZMQ pub/sub
+protocol.
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000..f44a24c
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1 @@
+packages: */*.cabal
diff --git a/config.yaml b/config.yaml
new file mode 100644
index 0000000..764f92d
--- /dev/null
+++ b/config.yaml
@@ -0,0 +1,8 @@
+dummy-pulser:
+  name: pulser
+  pubEp: tcp://127.0.0.1:10001
+  pulses: 10
+dummy-receiver:
+  name: receiver
+  subEps: [tcp://127.0.0.1:10001]
+  topics: [pulser]
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..51ac3fd
--- /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: 180
+
+# 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-core/Hsm/Core/App.hs b/hsm-core/Hsm/Core/App.hs
new file mode 100644
index 0000000..51f6d94
--- /dev/null
+++ b/hsm-core/Hsm/Core/App.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+-- Module     : Hsm.Core.App
+-- Maintainer : contact@pauloliver.dev
+module Hsm.Core.App
+  ( launch
+  )
+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.Maybe (fromMaybe)
+import Data.Text (pack, unpack)
+import Data.Yaml (decodeFileThrow)
+import Effectful.Log (LogLevel (LogInfo), Logger, readLogLevelEither, showLogLevel)
+import Log.Backend.StandardOutput (withStdOutLogger)
+import Options.Applicative qualified as P
+import System.IO.Echo (withoutInputEcho)
+
+data Options = Options String LogLevel
+
+parser :: P.Parser Options
+parser =
+  Options
+    <$> P.strOption
+      ( P.help "Path to services config file"
+          <> P.short 'c'
+          <> P.long "config"
+          <> P.metavar "PATH"
+          <> P.value "config.yaml"
+          <> P.showDefault
+      )
+    <*> P.option
+      (P.eitherReader $ readLogLevelEither . pack)
+      ( P.help "Log level"
+          <> P.short 'l'
+          <> P.long "log-level"
+          <> P.metavar "LEVEL"
+          <> P.value LogInfo
+          <> P.showDefaultWith (unpack . showLogLevel)
+      )
+
+-- Bootstraps an application by reading its settings from a provided
+-- configuration file. A configuration must exist in the config file for the name
+-- provided. A logger object, log level and read-only configuration are passed
+-- down to the provided application.
+launch :: FromJSON e => String -> (Logger -> LogLevel -> e -> IO a) -> IO a
+launch name app =
+  P.execParser info >>= \(Options path level) ->
+    returnEnv path >>= \env ->
+      withoutInputEcho $ withStdOutLogger $ \logger -> app logger level env
+ 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 :: FromJSON e => String -> IO e
+  returnEnv = fmap (check . fromJSON . load) . decodeFileThrow
diff --git a/hsm-core/Hsm/Core/Fsm.hs b/hsm-core/Hsm/Core/Fsm.hs
new file mode 100644
index 0000000..caa2e7e
--- /dev/null
+++ b/hsm-core/Hsm/Core/Fsm.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- Module     : Hsm.Core.Fsm
+-- Maintainer : contact@pauloliver.dev
+module Hsm.Core.Fsm
+  ( Method (Method)
+  , FsmC
+  , fsm
+  )
+where
+
+import Control.Exception.Safe (Exception, catch, displayException)
+import Data.Text (Text, pack)
+import Effectful ((:>))
+import Effectful.Log (Log, localDomain, logAttention_, logTrace_)
+import Effectful.Reader.Static (Reader)
+import Effectful.State.Static.Local (State)
+import GHC.Records (HasField)
+import Hsm.Core.Pipes (Pipe)
+
+data Method a b e s x es = Method Text (Pipe a b e s es (Method a b e s x es))
+
+type FsmC e s x es = (HasField "name" e Text, Exception x, Log :> es, Reader e :> es, State s :> es)
+
+-- Builds an FSM with an initial and a default method. Because both @Proxy@
+-- and @Eff@ are instances of @MonadCatch@ and @MonadThrow@, exceptions may be
+-- thrown from within state methods. The FSM transitions to its default state
+-- if an exception is thrown.
+fsm :: forall a b e s x es. FsmC e s x es => Method a b e s x es -> Method a b e s x es -> Pipe a b e s es ()
+fsm actionInit actionDefault = localDomain "fsm" $ run actionInit
+ where
+  run :: Method a b e s x es -> Pipe a b e s es ()
+  run (Method name action) = do
+    logTrace_ $ "Entering state " <> name
+    next <- localDomain name action `catch` handle
+    logTrace_ $ "Exiting state " <> name
+    run next
+   where
+    handle :: x -> Pipe a b e s es (Method a b e s x es)
+    handle exception = do
+      logAttention_ $ "Exception caught while on state " <> name
+      logAttention_ $ pack $ displayException exception
+      return actionDefault
diff --git a/hsm-core/Hsm/Core/LogIO.hs b/hsm-core/Hsm/Core/LogIO.hs
new file mode 100644
index 0000000..fb187e9
--- /dev/null
+++ b/hsm-core/Hsm/Core/LogIO.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+-- Module     : Hsm.Core.LogIO
+-- Maintainer : contact@pauloliver.dev
+module Hsm.Core.LogIO
+  ( LoggerIO
+  , getLoggerIO
+  )
+where
+
+import Data.Aeson.Types (emptyObject)
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime)
+import Effectful.Log (LogLevel, MonadLog)
+import Effectful.Log qualified as L (getLoggerIO)
+
+-- Wraps logger returned by @getLoggerIO@ into simpler type.
+type LoggerIO = LogLevel -> Text -> IO ()
+
+getLoggerIO :: MonadLog m => m LoggerIO
+getLoggerIO =
+  L.getLoggerIO >>= \logIO ->
+    return $ \level msg ->
+      getCurrentTime >>= \now ->
+        logIO now level msg emptyObject
diff --git a/hsm-core/Hsm/Core/Message.hs b/hsm-core/Hsm/Core/Message.hs
new file mode 100644
index 0000000..069ab99
--- /dev/null
+++ b/hsm-core/Hsm/Core/Message.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- Module     : Hsm.Core.Message
+-- Maintainer : contact@pauloliver.dev
+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 (encodeUtf8)
+
+sep :: ByteString
+sep = "//"
+
+message :: Binary a => Text -> a -> ByteString
+message t b = encodeUtf8 t <> sep <> toStrict (encode b)
+
+topic :: ByteString -> ByteString
+topic = 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/Pipes.hs b/hsm-core/Hsm/Core/Pipes.hs
new file mode 100644
index 0000000..2c63c59
--- /dev/null
+++ b/hsm-core/Hsm/Core/Pipes.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+-- Module     : Hsm.Core.Pipes
+-- Maintainer : contact@pauloliver.dev
+module Hsm.Core.Pipes
+  ( Proxy
+  , (>->)
+  , await
+  , yield
+  , runEffect
+  , Producer
+  , Pipe
+  , Consumer
+  )
+where
+
+import Control.Exception.Safe (MonadCatch, MonadThrow)
+import Control.Monad.Reader (MonadReader, ask, local)
+import Control.Monad.State (MonadState, get, put)
+import Control.Monad.Trans.Resource (MonadResource, liftResourceT)
+import Data.Composition ((.:.))
+import Effectful (Eff, IOE, (:>))
+import Effectful.Log (Log, MonadLog, getLoggerEnv, localData, localDomain, localMaxLogLevel, logMessage)
+import Effectful.Reader.Static qualified as E (Reader, ask, local)
+import Effectful.Resource (Resource)
+import Effectful.State.Static.Local qualified as E (State, get, put)
+import Pipes (MonadIO, X, hoist, lift, liftIO)
+import Pipes qualified as P (Proxy, await, runEffect, yield, (>->))
+
+-- Wraps @Pipes.Proxy@ with @Eff@ as its internal monad. This provides
+-- composable streaming plus @Eff@ as a means to constrain effects within
+-- individual pipeline components.
+newtype Proxy a' a b' b e s es r = Proxy (P.Proxy a' a b' b (Eff es) r) deriving (Applicative, Functor, Monad, MonadCatch, MonadThrow)
+
+(>->) :: Proxy a' a () b e s es r -> Proxy () b c' c e s es r -> Proxy a' a c' c e s es r
+Proxy a >-> Proxy b = Proxy $ a P.>-> b
+
+await :: Proxy () a y' y e s es a
+await = Proxy P.await
+
+yield :: a -> Proxy x' x () a e s es ()
+yield = Proxy . P.yield
+
+runEffect :: Proxy X () () X e s es r -> Eff es r
+runEffect (Proxy effect) = P.runEffect effect
+
+instance Log :> es => MonadLog (Proxy a' a b' b e s es) where
+  getLoggerEnv = Proxy $ lift getLoggerEnv
+  localData env (Proxy action) = Proxy $ hoist (localData env) action
+  localDomain domain (Proxy action) = Proxy $ hoist (localDomain domain) action
+  localMaxLogLevel level (Proxy action) = Proxy $ hoist (localMaxLogLevel level) action
+  logMessage = Proxy . lift .:. logMessage
+
+instance E.Reader e :> es => MonadReader e (Proxy a' a b' b e s es) where
+  ask = Proxy $ lift E.ask
+  local f (Proxy action) = Proxy $ hoist (E.local f) action
+
+instance (IOE :> es, Resource :> es) => MonadResource (Proxy a' a b' b e s es) where
+  liftResourceT = Proxy . lift . liftResourceT
+
+instance E.State s :> es => MonadState s (Proxy a' a b' b e s es) where
+  get = Proxy $ lift E.get
+  put = Proxy . lift . E.put
+
+instance IOE :> es => MonadIO (Proxy a' a b' b e s es) where
+  liftIO = Proxy . lift . liftIO
+
+type Producer b e s es = Proxy X () () b e s es
+
+type Pipe a b e s es = Proxy () a () b e s es
+
+type Consumer a e s es = Proxy () a () X e s es
diff --git a/hsm-core/Hsm/Core/Zmq.hs b/hsm-core/Hsm/Core/Zmq.hs
new file mode 100644
index 0000000..69ff59a
--- /dev/null
+++ b/hsm-core/Hsm/Core/Zmq.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- Module     : Hsm.Core.Zmq
+-- Maintainer : contact@pauloliver.dev
+module Hsm.Core.Zmq
+  ( client
+  , server
+  )
+where
+
+import Control.Monad (forM_, forever)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ask)
+import Data.Binary (Binary)
+import Data.Text (Text, pack, unpack)
+import Data.Text.Encoding (encodeUtf8)
+import Effectful (IOE, (:>))
+import Effectful.Log (Log, LogLevel (LogTrace), localDomain, logInfo_, logTrace_)
+import Effectful.Reader.Static (Reader)
+import Effectful.Resource (Resource, allocate)
+import GHC.Records (HasField)
+import Hsm.Core.LogIO (LoggerIO, getLoggerIO)
+import Hsm.Core.Message (body, message)
+import Hsm.Core.Pipes (Consumer, Producer, Proxy, await, yield)
+import System.ZMQ4 qualified as Z
+
+data ZmqResource t = ZmqResource Z.Context (Z.Socket t)
+
+type ZmqC e es = (IOE :> es, Log :> es, Reader e :> es, Resource :> es)
+
+type UsingC t e es = (Z.SocketType t, ZmqC e es)
+
+type ClientC a e es = (Binary a, HasField "name" e Text, HasField "subEps" e [Text], HasField "topics" e [Text], ZmqC e es)
+
+type ServerC a e es = (Binary a, HasField "name" e Text, HasField "pubEp" e Text, ZmqC e es)
+
+type Action t a' a b' b e s es = Z.Socket t -> e -> Proxy a' a b' b e s es ()
+
+using :: forall t a' a b' b e s es. UsingC t e es => t -> Action t a' a b' b e s es -> Proxy a' a b' b e s es ()
+using stype action = getLoggerIO >>= safely
+ where
+  safely :: LoggerIO -> Proxy a' a b' b e s es ()
+  safely logger =
+    allocate acquire release >>= \(_, ZmqResource _ socket) ->
+      ask >>= action socket
+   where
+    acquire :: IO (ZmqResource t)
+    acquire = do
+      logger LogTrace "Acquiring ZMQ context"
+      context <- Z.context
+      socket <- Z.socket context stype
+      return $ ZmqResource context socket
+
+    release :: ZmqResource t -> IO ()
+    release (ZmqResource context socket) = do
+      logger LogTrace "Releasing ZMQ context"
+      Z.close socket
+      Z.shutdown context
+
+client :: ClientC a e es => Producer a e s es ()
+client =
+  using Z.Sub $ \socket e ->
+    localDomain "client" $ do
+      logInfo_ "Initializing ZMQ client"
+      liftIO $ forM_ e.subEps $ Z.connect socket . unpack
+      liftIO $ forM_ e.topics $ Z.subscribe socket . encodeUtf8
+      logTrace_ $ "Listening to " <> pack (show e.subEps)
+      logTrace_ $ "Subscribed to " <> pack (show e.topics)
+      forever $ liftIO (Z.receive socket) >>= yield . body
+
+server :: ServerC a e es => Consumer a e s es ()
+server =
+  using Z.Pub $ \socket e ->
+    localDomain "server" $ do
+      logInfo_ "Initializing ZMQ server"
+      liftIO $ Z.bind socket $ unpack e.pubEp
+      logTrace_ $ "Publishing to " <> e.pubEp
+      forever $ await >>= liftIO . Z.send socket [] . message e.name
diff --git a/hsm-core/hsm-core.cabal b/hsm-core/hsm-core.cabal
new file mode 100644
index 0000000..334f144
--- /dev/null
+++ b/hsm-core/hsm-core.cabal
@@ -0,0 +1,39 @@
+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
+    , echo
+    , effectful-core
+    , log-base
+    , log-effectful
+    , mtl
+    , optparse-applicative
+    , pipes
+    , resourcet
+    , resourcet-effectful
+    , safe-exceptions
+    , text
+    , time
+    , yaml
+    , zeromq4-haskell
+
+  exposed-modules:
+    Hsm.Core.App
+    Hsm.Core.Fsm
+    Hsm.Core.LogIO
+    Hsm.Core.Message
+    Hsm.Core.Pipes
+    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..a432301
--- /dev/null
+++ b/hsm-dummy-pulser/Main.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- Proof of concept application, defines custom @Producer@ and FSM @Pipe@
+-- components. Publishes a new number (in sequence) through ZMQ every second.
+-- Throws an exception after a set number of pulses is reached.
+module Main
+  ( main
+  )
+where
+
+import Control.Concurrent (threadDelay)
+import Control.Exception.Safe (StringException, throwString)
+import Control.Monad (forever)
+import Control.Monad.Extra (whenM)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (asks)
+import Control.Monad.State (get, gets, modify)
+import Data.Aeson (FromJSON)
+import Data.Function ((&))
+import Data.Text (Text, pack)
+import Effectful (IOE, runEff)
+import Effectful.Log (Log, localDomain, logInfo_, logTrace_, runLog)
+import Effectful.Reader.Static (Reader, runReader)
+import Effectful.Resource (Resource, runResource)
+import Effectful.State.Static.Local (State, evalState)
+import GHC.Generics (Generic)
+import Hsm.Core.App (launch)
+import Hsm.Core.Fsm (FsmC, Method (Method), fsm)
+import Hsm.Core.Pipes (Pipe, Producer, await, runEffect, yield, (>->))
+import Hsm.Core.Zmq (server)
+
+data Env = Env
+  { name :: Text
+  , pubEp :: Text
+  , pulses :: Int
+  }
+  deriving (FromJSON, Generic)
+
+type Effs = [Log, Reader Env, Resource, State Int, IOE]
+
+type Pulser = Producer () Env Int Effs
+
+type FsmMethodC es = (FsmC Env Int StringException es)
+
+type FsmMethod es = Method () Int Env Int StringException es
+
+type FsmPipe es = Pipe () Int Env Int es
+
+pulser :: Pulser ()
+pulser =
+  localDomain "pulser" $
+    forever $
+      liftIO (threadDelay 1000000) >> logTrace_ "Tick" >> yield ()
+
+stateRun :: FsmMethodC es => FsmMethod es
+stateRun =
+  Method "run" $ do
+    check >> await >> modify succ >> report >> get >>= yield
+    return stateRun
+ where
+  check :: FsmMethodC es => FsmPipe es ()
+  check =
+    asks pulses >>= \top ->
+      whenM (gets (== top)) $
+        throwString $
+          "Reached " <> show top <> " pulses"
+
+  report :: FsmMethodC es => FsmPipe es ()
+  report = get >>= logInfo_ . mappend "Sending pulse #" . pack . show
+
+stateError :: FsmMethodC es => FsmMethod es
+stateError = Method "error" $ logInfo_ "Doing nothing" >> forever await
+
+main :: IO ()
+main =
+  launch "dummy-pulser" $ \logger level e ->
+    (pulser >-> fsm stateRun stateError >-> server)
+      & runEffect
+      & runLog e.name logger level
+      & runReader e
+      & runResource
+      & evalState 0
+      & 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..46db00b
--- /dev/null
+++ b/hsm-dummy-pulser/hsm-dummy-pulser.cabal
@@ -0,0 +1,23 @@
+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-core
+    , extra
+    , hsm-core
+    , log-effectful
+    , mtl
+    , resourcet-effectful
+    , safe-exceptions
+    , 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..47b483b
--- /dev/null
+++ b/hsm-dummy-receiver/Main.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- Proof of concept application, defines a custom @Consumer@. ZMQ client
+-- listens for incoming messages from @dummy-pulser@.
+module Main
+  ( main
+  )
+where
+
+import Control.Monad (forever)
+import Data.Aeson (FromJSON)
+import Data.Function ((&))
+import Data.Text (Text, pack)
+import Data.Void (Void)
+import Effectful (IOE, runEff)
+import Effectful.Log (Log, localDomain, logInfo_, runLog)
+import Effectful.Reader.Static (Reader, runReader)
+import Effectful.Resource (Resource, runResource)
+import GHC.Generics (Generic)
+import Hsm.Core.App (launch)
+import Hsm.Core.Pipes (Consumer, await, runEffect, (>->))
+import Hsm.Core.Zmq (client)
+
+data Env = Env
+  { name :: Text
+  , subEps :: [Text]
+  , topics :: [Text]
+  }
+  deriving (FromJSON, Generic)
+
+type Effs = [Log, Reader Env, Resource, IOE]
+
+type Receiver = Consumer Int Env Void Effs
+
+receiver :: Receiver ()
+receiver =
+  localDomain "receiver" $
+    forever $
+      await >>= logInfo_ . mappend "Received pulse #" . pack . show
+
+main :: IO ()
+main =
+  launch "dummy-receiver" $ \logger level e ->
+    (client >-> receiver)
+      & runEffect
+      & runLog e.name logger level
+      & runReader e
+      & 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..20d985a
--- /dev/null
+++ b/hsm-dummy-receiver/hsm-dummy-receiver.cabal
@@ -0,0 +1,20 @@
+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
+    , text
+
+  main-is:          Main.hs
+  ghc-options:      -Wall -Wunused-packages
+  default-language: GHC2024
-- 
cgit v1.2.1