Works
This commit is contained in:
@@ -1,258 +0,0 @@
|
||||
# Concurrent runtime: multiple controllers, channels, supervision, reconnect
|
||||
|
||||
Date: 2026-08-20
|
||||
Status: Approved (pending spec review)
|
||||
|
||||
## Goal
|
||||
|
||||
Make the HASS runtime production-quality:
|
||||
|
||||
- Support multiple controllers.
|
||||
- A single websocket read loop; no per-controller connections.
|
||||
- The read loop broadcasts messages to controllers over channels (`TChan`).
|
||||
- Each controller runs on its own thread (`async`).
|
||||
- Controllers know nothing of the websocket connection: service calls go
|
||||
through an outbound channel; a writer thread does the actual sends.
|
||||
- Crashed worker threads are restarted with backoff (`annotated-exception`
|
||||
for context).
|
||||
- The websocket reconnects on network failure.
|
||||
|
||||
Implemented as two slices, each independently buildable and committed:
|
||||
|
||||
1. **Concurrency architecture**: bus, reader/writer threads, controller
|
||||
threads, channel interpreter, wiring. Any worker crash exits the
|
||||
process (today's behavior).
|
||||
2. **Robustness**: supervisor with backoff, `annotated-exception`, fatal
|
||||
vs retryable failures, reconnect-as-restart.
|
||||
|
||||
## Current state
|
||||
|
||||
`HomeAssistant.Runtime.app` runs everything on one thread inside
|
||||
`WS.runClient`: auth handshake, a `get_states` debug dump, one
|
||||
`subscribe_events`, then a loop that steps a single `lightController`
|
||||
via `dryRunHassEval`. The `get_states` dump is dead debug code and is
|
||||
removed (state pre-seeding is a separate future concern).
|
||||
|
||||
## Architecture
|
||||
|
||||
```
|
||||
HA websocket
|
||||
▲ │
|
||||
sends │ ▼ receives
|
||||
┌─────────────┴──┐ ┌──────────────┐
|
||||
│ writer thread │ │ reader thread │
|
||||
└───────▲────────┘ └───────┬──────┘
|
||||
│ │ decode → Value
|
||||
│ TChan Service │ broadcast (single write)
|
||||
│ ▼
|
||||
┌───────┴───────────────────────────┐
|
||||
│ busInbound (broadcast TChan) │
|
||||
└──┬──────────────┬──────────────┬──┘
|
||||
▼ dupTChan ▼ ▼
|
||||
controller 1 controller 2 controller N (1 thread each)
|
||||
```
|
||||
|
||||
### Bus
|
||||
|
||||
```haskell
|
||||
data Bus = Bus
|
||||
{ busInbound :: TChan Value -- newBroadcastTChanIO; reader writes only
|
||||
, busOutbound :: TChan Service -- controllers → writer; fire-and-forget
|
||||
, busConn :: TVar (Maybe WS.Connection)
|
||||
, busGen :: CallIdGen -- existing IORef-based, thread-safe
|
||||
}
|
||||
```
|
||||
|
||||
- `busInbound` comes from `newBroadcastTChanIO`: a write-only broadcast
|
||||
channel. A plain never-read `TChan` would pin its entire history; the
|
||||
broadcast variant does not. Controllers receive via
|
||||
`dupTChanIO busInbound`; the reader writes each message once.
|
||||
- `busConn` is a plain current-value cell (no `MVar` blocking semantics).
|
||||
`Maybe` + STM `retry` lets the writer block until a connection exists
|
||||
and lets `defaultMain` spawn all workers up front: the initial connect
|
||||
is just the reader's first attempt, so first-connect failures and
|
||||
reconnect failures take the same backoff path.
|
||||
- The controller list is static. Each entry is an existential:
|
||||
|
||||
```haskell
|
||||
data Controller = forall b. Controller T.Text (HASS (Event Value) b)
|
||||
```
|
||||
|
||||
No `Show` constraint: machine outputs are discarded; observability will
|
||||
come from a logging effect later. The name tags restart logs.
|
||||
|
||||
### Send-safety without locks
|
||||
|
||||
No two threads ever send on the same live connection:
|
||||
|
||||
- The reader performs all setup sends (auth, subscribe) **before**
|
||||
swapping the connection into `busConn`; afterwards it only receives.
|
||||
- The writer only sends on connections read from `busConn`.
|
||||
|
||||
On reconnect the reader builds a new connection, handshakes, then
|
||||
atomically swaps `busConn`. A writer mid-send on the dead connection
|
||||
throws, its supervisor restarts it, and it picks up the new connection.
|
||||
|
||||
### Outbound backpressure
|
||||
|
||||
Fire-and-forget: services queue in `busOutbound` during outages and are
|
||||
sent after reconnect. The queue is naturally bounded in practice: no
|
||||
inbound events means controllers produce no calls.
|
||||
|
||||
## Module layout
|
||||
|
||||
| Module | Concern |
|
||||
|---|---|
|
||||
| `HomeAssistant.Runtime.Supervisor` | Generic restart-with-backoff combinator, `Backoff`, `Fatal`; no HA knowledge |
|
||||
| `HomeAssistant.Runtime.Bus` | `Bus`, `newBus`, channel interpreter for `HASSEff` |
|
||||
| `HomeAssistant.Runtime.Connection` | `readerAction`, `writerAction`; connect/auth/subscribe, receive-decode-broadcast loop, send loop |
|
||||
| `HomeAssistant.Runtime` | Glue: `defaultMain`, `controllers`, `Controller`, `runController`, `step`, `dryRunHassEval` |
|
||||
|
||||
Exports removed from `HomeAssistant.Runtime`: `app`, `hassEval`,
|
||||
`wsCallService`, `receiveJSON` (internal or superseded). Kept:
|
||||
`defaultMain`, `step`, `dryRunHassEval`, `CallIdGen`, `mkCallIdGen`.
|
||||
`app/Main.hs` unchanged.
|
||||
|
||||
## Connection lifecycle
|
||||
|
||||
**Reader action** (restartable unit; restart = reconnect):
|
||||
|
||||
```
|
||||
connect → expect auth_required → send token → expect auth_ok
|
||||
→ send subscribe_events state_changed (id from busGen)
|
||||
→ swap busConn
|
||||
→ forever: receive → decode → broadcast to busInbound
|
||||
```
|
||||
|
||||
- `auth_invalid` (and undecodable handshake messages) is **fatal**: a bad
|
||||
token cannot be fixed by retrying. The reader throws `Fatal`; the
|
||||
supervisor rethrows it (with annotations) and the process exits.
|
||||
- Undecodable messages in the receive loop are **not** fatal: log a
|
||||
warning and skip. Reconnecting cannot fix a decode problem, so
|
||||
crash-restarting would just be a hot loop.
|
||||
- Controller Mealy state survives reconnects (explicit decision). State
|
||||
may be stale until each watched entity's next `state_changed` event.
|
||||
Re-seeding via `get_states` is a separate future concern.
|
||||
|
||||
**Writer action**:
|
||||
|
||||
```
|
||||
forever: readTChan busOutbound
|
||||
→ readTVar busConn (retry until Just)
|
||||
→ encode with fresh id from busGen → send
|
||||
```
|
||||
|
||||
Encoding fixes a latent bug: today's `wsCallService` drops
|
||||
`serviceData`; the writer encodes it as `"service_data"` when present.
|
||||
|
||||
## Supervision
|
||||
|
||||
```haskell
|
||||
supervised :: Text -> Backoff -> IO a -> IO Void -- never returns normally
|
||||
```
|
||||
|
||||
- Catches synchronous exceptions; rethrows `SomeAsyncException`
|
||||
(no restarting on cancellation).
|
||||
- On `Fatal`: rethrow with annotations; process exits.
|
||||
- Otherwise: log (component name, attempt, annotated exception), sleep
|
||||
per backoff, restart the action.
|
||||
- Backoff: exponential from base, capped; resets after a quiet period.
|
||||
|
||||
```haskell
|
||||
data Backoff = Backoff
|
||||
{ backoffBase :: NominalDiffTime -- first restart delay, e.g. 100ms
|
||||
, backoffCap :: NominalDiffTime -- max delay, e.g. 30s
|
||||
, backoffQuiet :: NominalDiffTime -- uptime that resets delay, e.g. 30s
|
||||
}
|
||||
```
|
||||
|
||||
Delay after the n-th consecutive crash: `min cap (base * 2^(n-1))`.
|
||||
|
||||
- `annotated-exception` adds context at catch sites (component, phase
|
||||
such as "authenticating" / "receiving") so logs read like
|
||||
`[reader] attempt 3: ConnectionClosed while receiving`.
|
||||
|
||||
### Wiring
|
||||
|
||||
- Slice 1: `defaultMain` = `newBus` → `mapConcurrently_` over reader,
|
||||
writer, and controller actions. First worker crash cancels the rest
|
||||
and exits the process.
|
||||
- Slice 2: each action wrapped in `supervised`; main waits forever.
|
||||
The worker `IO` actions are identical in both slices; only the
|
||||
spawning changes.
|
||||
|
||||
## Controller runner
|
||||
|
||||
```haskell
|
||||
runController :: Bus -> Controller -> IO Void
|
||||
-- dupTChanIO busInbound
|
||||
-- loop: readTChan → step (channelHassEval bus) → discard output
|
||||
```
|
||||
|
||||
On a supervised restart the action re-dups: a fresh port sees only
|
||||
messages written after the dup, consistent with the machine also
|
||||
restarting from its initial state. Messages broadcast during a restart
|
||||
window are lost (accepted, documented).
|
||||
|
||||
## Interpreter
|
||||
|
||||
```haskell
|
||||
channelHassEval :: Bus -> HASSEff a -> IO a
|
||||
channelHassEval bus (CallService svc) = atomically (writeTChan (busOutbound bus) svc)
|
||||
channelHassEval _ (Pure a) = pure a
|
||||
```
|
||||
|
||||
`dryRunHassEval` stays exported for experiments/tests.
|
||||
|
||||
## Logging
|
||||
|
||||
Tagged plain lines (`[reader] …`) via `putStrLn`. No framework.
|
||||
|
||||
## Dependencies
|
||||
|
||||
Added: `stm`, `async` (slice 1); `annotated-exception` (slice 2).
|
||||
After editing the cabal file, regenerate `default.nix` via
|
||||
`nix run nixpkgs#cabal2nix -- ./. > default.nix` (AGENTS.md).
|
||||
|
||||
## Testing
|
||||
|
||||
hspec for unit tests, hedgehog for property tests (AGENTS.md):
|
||||
|
||||
- hspec:
|
||||
- Broadcast semantics: two `dupTChan` ports see all writes, in order.
|
||||
- `channelHassEval` writes `Service` to the outbound chan.
|
||||
- `runController` end-to-end on a real `Bus` with a test controller:
|
||||
feed values into `busInbound`, assert services land in `busOutbound`.
|
||||
- Writer encoding: golden JSON for `call_service` incl. `service_data`.
|
||||
- Supervisor (tiny backoff values): crash-twice-then-succeed restarts;
|
||||
`Fatal` rethrown, not restarted; async exceptions not restarted.
|
||||
- hedgehog:
|
||||
- Backoff property: delays double from base, clamp at cap, reset after
|
||||
quiet period.
|
||||
|
||||
## Slices
|
||||
|
||||
1. **Concurrency architecture**: `Bus` (already reconnect-ready:
|
||||
`TVar (Maybe Connection)`), `channelHassEval`, `readerAction`,
|
||||
`writerAction`, `runController`, module split, cabal deps, wiring via
|
||||
`mapConcurrently_`, tests for bus/runner/encoding. Decode
|
||||
log-and-skip included.
|
||||
2. **Robustness**: `Supervisor` module, `annotated-exception` dep,
|
||||
backoff, `Fatal` auth failures, rewire `defaultMain` to supervised
|
||||
workers, supervisor tests and backoff property.
|
||||
|
||||
In slice 1 an `auth_invalid` response exits the process like any other
|
||||
crash; the fatal/retryable distinction only exists once the supervisor
|
||||
does (slice 2).
|
||||
|
||||
Each slice: builds clean, tests green, committed separately.
|
||||
|
||||
## Non-goals
|
||||
|
||||
- Request/response correlation for service calls (approach B, deferred;
|
||||
outbound message type can grow later).
|
||||
- Dynamic controller registration (static list).
|
||||
- Structured logging / logging effect (future).
|
||||
- Host/port/token configuration via env (beyond current `HA_TOKEN`).
|
||||
- State pre-seeding via `get_states` (user's future concern).
|
||||
- Multiple websocket connections.
|
||||
@@ -1,130 +0,0 @@
|
||||
# Module split & warning cleanup for `MyLib.hs`
|
||||
|
||||
Date: 2026-08-20
|
||||
Status: Approved (pending spec review)
|
||||
|
||||
## Goal
|
||||
|
||||
Split `src/MyLib.hs` (352 lines, monolithic) into vertically-separated modules and fix all compiler warnings, committing between every change.
|
||||
|
||||
Two concerns were named upfront:
|
||||
1. AFRP (Mealy) internals — generic FRP machinery.
|
||||
2. Home Assistant business logic.
|
||||
|
||||
A third concern emerged during exploration:
|
||||
3. IO runtime — websocket client, effect interpreter, `defaultMain`.
|
||||
|
||||
## Module layout
|
||||
|
||||
Three vertical modules with hierarchical naming. `MyLib` is removed; `app/Main.hs` and the cabal `exposed-modules` are updated.
|
||||
|
||||
| Module | Concern | Depends on |
|
||||
|---|---|---|
|
||||
| `AFRP` | Generic Mealy/Event machinery — no HA knowledge | base, time |
|
||||
| `HomeAssistant.Controller` | HA domain: effect type, entity parsers, controllers | `AFRP`, aeson, lens |
|
||||
| `HomeAssistant.Runtime` | IO interpreter, websocket client, `defaultMain` | both, websockets |
|
||||
|
||||
### Naming rationale
|
||||
|
||||
`AFRP` lives at the top level (not `HomeAssistant.AFRP`) because the code is generic FRP machinery with zero HA references; nesting it under `HomeAssistant.*` would misrepresent it. It stays in-project per the user's decision, so a short top-level name is fine.
|
||||
|
||||
### Future direction (deferred)
|
||||
|
||||
When real controllers exist, split `HomeAssistant.Controller` further into sub-modules:
|
||||
- `HomeAssistant.Controller.Effect` — `HASSEff`, `Service`, `HASS`, `callService`
|
||||
- `HomeAssistant.Controller.Entity` — entity parsers
|
||||
- `HomeAssistant.Controller` (or `.Controllers`) — actual controllers (`lightController`, etc.)
|
||||
|
||||
Deferred now because there's only one proof-of-concept controller.
|
||||
|
||||
## Module contents
|
||||
|
||||
### `AFRP` (from MyLib.hs lines 29–91, 99–173)
|
||||
|
||||
Exports:
|
||||
- `Mealy(..)`, `eff`
|
||||
- `Event(..)`, `hold`, `events`, `switch`
|
||||
- accumulators: `preMapAccum`, `preMapAccumUTCTime`, `mapAccum`, `mapAccumUTCTime`
|
||||
- `changes`, `whenA`, `filterA`, `thenA`, `(>>|)`, `toEvent`
|
||||
- instances come along with `Mealy(..)`
|
||||
|
||||
### `HomeAssistant.Controller` (from lines 32–42, 50–53, 175–256)
|
||||
|
||||
Exports:
|
||||
- `Service(..)`, `HASSEff(..)`, `HASS`, `callService`
|
||||
- entity helpers: `entityChangeEvent`, `entityChangeEvent'`, `entityRead`, `entityRead'`, `entityBool`, `entityBool'`
|
||||
- domain types/values: `Ruuvi(..)`, `ruuvi`, `ruuviTemperatures`, `ruuviPressures`, `DoorState(..)`, `door`, `light`, `lightController`
|
||||
|
||||
### `HomeAssistant.Runtime` (from lines 259–268, 270–352)
|
||||
|
||||
Exports:
|
||||
- `defaultMain`, `app`, `step`
|
||||
- `CallIdGen`, `mkCallIdGen`, `hassEval`, `dryRunHassEval`, `receiveJSON`, `wsCallService`
|
||||
|
||||
## Warning fixes
|
||||
|
||||
Per-warning, applied during the split-then-fix commit sequence:
|
||||
|
||||
| Warning (line) | Fix |
|
||||
|---|---|
|
||||
| `numericDirection` (190) + `Direction`/`Increase`/`Decrease`/`Steady` (187) — unused, no sig | **Delete.** True experiment; used nowhere. |
|
||||
| `entityChangeEvent` (224), `entityRead'` (236), `entityRead` (249) — unused top-binds | **Export** from `HomeAssistant.Controller`. Useful Either/Event-returning entity helpers the others build on; the split's export lists make them used. |
|
||||
| `isEntity` (227) — unused local in `entityChangeEvent` | **Delete.** `entityChangeEvent` delegates to `entityChangeEvent' >>> toEvent`; its `isEntity` is a dead duplicate. |
|
||||
| `state` (251) in `entityRead`, `state` (256) in `entityBool` — unused locals | **Delete.** Both functions delegate to their `'`-primed versions; the `where` clauses are dead duplicates. |
|
||||
| `toBool` (244) — non-exhaustive (`"on"`/`"off"` only) | **Add catch-all `_ -> False`.** Conservative: treat unknown HA state as off rather than crashing. |
|
||||
| `wsCallService` (327) + `conn` (346) — unused, paired | See option C below. |
|
||||
|
||||
### `wsCallService` / `conn` — option C (chosen)
|
||||
|
||||
The commented-out `wsCallService conn ...` call on line 350 made `conn` unused. Rather than uncomment (behavior change) or paper over with `_conn` (dishonest), expose both behaviors as named, exported functions:
|
||||
|
||||
```haskell
|
||||
hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a
|
||||
hassEval gen conn = \case
|
||||
CallService x -> do
|
||||
callId <- generateCallId gen
|
||||
wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x)
|
||||
Pure a -> pure a
|
||||
|
||||
dryRunHassEval :: CallIdGen -> HASSEff a -> IO a
|
||||
dryRunHassEval gen = \case
|
||||
CallService x -> do
|
||||
callId <- generateCallId gen
|
||||
print (callId, x)
|
||||
Pure a -> pure a
|
||||
```
|
||||
|
||||
Both `conn` and `wsCallService` become used by the real `hassEval`; the current print-only behavior lives in `dryRunHassEval`. `app` wires up **`dryRunHassEval`** to preserve current runtime behavior — flipping to real `hassEval` later is a one-word change.
|
||||
|
||||
## Commit sequence
|
||||
|
||||
Two commits, each building cleanly:
|
||||
|
||||
1. **`Split MyLib into AFRP, Controller, Runtime`**
|
||||
- Mechanical move of code into `src/AFRP.hs`, `src/HomeAssistant/Controller.hs`, `src/HomeAssistant/Runtime.hs`.
|
||||
- Proper export lists (which naturally exports the "useful but unused" entity helpers, resolving those three unused-binding warnings).
|
||||
- Delete `src/MyLib.hs`.
|
||||
- Update `app/Main.hs` import (`MyLib` -> `HomeAssistant.Runtime`).
|
||||
- Update cabal `exposed-modules`.
|
||||
- Build still warns on remaining items.
|
||||
|
||||
2. **`Fix warnings`**
|
||||
- Delete `numericDirection`/`Direction` and dead `where` clauses (`isEntity` in `entityChangeEvent`, `state` in `entityRead`/`entityBool`).
|
||||
- Add `_ -> False` catch-all to `toBool`.
|
||||
- Implement real `hassEval` (uncommented `wsCallService`) + add `dryRunHassEval`; export both from `HomeAssistant.Runtime`.
|
||||
- Wire `app` to `dryRunHassEval` to preserve current behavior.
|
||||
- Build clean (no warnings).
|
||||
|
||||
## Verification
|
||||
|
||||
After each commit:
|
||||
- `cabal build` succeeds.
|
||||
- After commit 2: `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"` produces zero warnings.
|
||||
- `app/Main.hs` still compiles and imports `defaultMain` from its new home.
|
||||
|
||||
## Non-goals
|
||||
|
||||
- Splitting `HomeAssistant.Controller` into Effect/Entity/Controller sub-modules (deferred until real controllers exist).
|
||||
- Adding tests (test suite is a placeholder; out of scope).
|
||||
- Changing `app` to call real `hassEval` (stays on `dryRunHassEval` to preserve behavior).
|
||||
- Any behavioral changes beyond warning fixes and the dormant `wsCallService` activation (which is itself inert until `app` switches to `hassEval`).
|
||||
@@ -1,278 +0,0 @@
|
||||
# Replace manual printing with katip logging
|
||||
|
||||
Date: 2026-08-21
|
||||
Status: Approved (pending spec review)
|
||||
|
||||
## Goal
|
||||
|
||||
Replace all `print`/`putStrLn` logging under `src/` with [katip], a
|
||||
structured logging framework. The AFRP layer and controller definitions
|
||||
stay logging-free; only the `HASSEff` interpreters and runtime workers
|
||||
log.
|
||||
|
||||
[katip]: https://hackage.haskell.org/package/katip
|
||||
|
||||
## Current state
|
||||
|
||||
Nine logging sites under `src/`, all unstructured stdout:
|
||||
|
||||
| Site | Current code |
|
||||
|------|-------------|
|
||||
| `Runtime.hs:78` | `print (callId, x)` — dry-run `CallService` |
|
||||
| `Runtime.hs:79` | `print x` — `Debug` |
|
||||
| `Runtime.hs:80` | `print (req, x)` — `Trace` |
|
||||
| `Bus.hs:45` | `print x` — `Debug` (channelHassEval) |
|
||||
| `Bus.hs:46` | `print (req, x)` — `Trace` (channelHassEval) |
|
||||
| `Supervisor.hs:76` | `putStrLn ... "crashed: ..."` |
|
||||
| `Supervisor.hs:78` | `putStrLn ... "restarting in ..."` |
|
||||
| `Connection.hs:41` | `putStrLn "[reader] connected"` |
|
||||
| `Connection.hs:77` | `putStrLn "[reader] skipping undecodable message: ..."` |
|
||||
|
||||
`app/Main.hs`'s `putStrLn "Hello, Haskell!"` is outside `src/` and left
|
||||
alone. `AFRP.hs`, `Controller.hs`, and `Controller/Bedroom.hs` contain
|
||||
no logging and remain untouched.
|
||||
|
||||
## Approach
|
||||
|
||||
Approach A: `LogEnv` stored in `Bus`, explicit `runKatipT` per site.
|
||||
|
||||
- `Bus` gains `busLogEnv :: LogEnv`; `defaultMain` builds the env and
|
||||
passes it to `newBus`.
|
||||
- Every existing worker already takes `Bus`, so it reads `busLogEnv`
|
||||
and logs with `runKatipT le $ logMsg ns sev msg` — no worker
|
||||
signature changes.
|
||||
- `dryRunHassEval` and `channelHassEval` gain the controller name
|
||||
(`Text`) so debug/trace logs get a per-controller namespace.
|
||||
- `supervised` is the one function without a `Bus`; it gains a leading
|
||||
`LogEnv` param.
|
||||
- Tests get a silent `LogEnv` (no scribes) via a helper so they don't
|
||||
spew.
|
||||
|
||||
Rejected alternatives: B (`KatipContextT IO` worker monad — large
|
||||
churn, async context loss undermines the main benefit, fights the
|
||||
existing `IO`+`Bus` design); C (a new `App` `ReaderT` monad —
|
||||
over-scoped for a logging swap).
|
||||
|
||||
## Scribe setup
|
||||
|
||||
One scribe in `defaultMain`:
|
||||
|
||||
```haskell
|
||||
scribe <- mkHandleScribe ColorIfTerminal stdout (permitItem DebugS) V2
|
||||
```
|
||||
|
||||
- `ColorIfTerminal`: color codes only when stdout is a TTY.
|
||||
- `permitItem DebugS`: lets all severities through. The dev run shows
|
||||
everything; a production deployment can swap `DebugS` for `InfoS` (or
|
||||
register a second, more restrictive scribe) without code changes
|
||||
elsewhere.
|
||||
- `V2` verbosity: renders structured payload fields (e.g. `traceId`)
|
||||
inline in bracket format, e.g. `[traceId:<uuid>] <message>`.
|
||||
- `bracket ... closeScribes`: the current `waitAny`+`absurd` exits
|
||||
abruptly; wrapping the body in `bracket` ensures scribe queues flush
|
||||
and finalizers run on exit.
|
||||
|
||||
App namespace (set once): `initLogEnv "home-assistant-controller"
|
||||
"production"`. Every log's full namespace is `home-assistant-controller
|
||||
. <component>`.
|
||||
|
||||
## Severity & namespace mapping
|
||||
|
||||
| Site | Namespace | Severity |
|
||||
|------|-----------|----------|
|
||||
| dryRun `CallService` | `<controllerName>` | DebugS |
|
||||
| `Debug` (both interpreters) | `<controllerName>` | DebugS |
|
||||
| `Trace req x` (both interpreters) | `<controllerName>` | DebugS |
|
||||
| Supervisor crash | `runtime.supervisor.<name>` | WarningS |
|
||||
| Supervisor restart | `runtime.supervisor.<name>` | InfoS |
|
||||
| reader connected | `runtime.reader` | InfoS |
|
||||
| reader undecodable | `runtime.reader` | WarningS |
|
||||
|
||||
Rationale: crashes that get restarted are recoverable → WarningS; the
|
||||
restart notice is normal operation → InfoS. "reader connected" is an
|
||||
operational milestone → InfoS; skipping a bad message is
|
||||
abnormal-but-handled → WarningS. All interpreter output
|
||||
(CallService dry-run, Debug, Trace) is developer instrumentation →
|
||||
DebugS, so a production scribe (`permitItem InfoS`) filters it out
|
||||
while a dev scribe keeps it.
|
||||
|
||||
## Structured traceId
|
||||
|
||||
`Trace req x` carries `requestTraceId :: UUID`. Logged via `logF` with
|
||||
a `SimpleLogPayload` so the traceId is a structured field rather than
|
||||
text concatenated into the message. `Data.UUID.toText` renders the UUID
|
||||
as a hyphenated `Text` (which is `ToJSON`, as `sl` requires):
|
||||
|
||||
```haskell
|
||||
Trace req x -> runKatipT le $
|
||||
logF (sl "traceId" (toText (requestTraceId req))) ns DebugS (showLS x)
|
||||
```
|
||||
|
||||
Renders in bracket format as
|
||||
`[home-assistant-controller.<name>][Debug][...][traceId:<uuid>] <x>`.
|
||||
The `toText` import comes from `Data.UUID` (already a dependency).
|
||||
|
||||
## Signature changes
|
||||
|
||||
### `Bus` (Bus.hs)
|
||||
|
||||
```haskell
|
||||
data Bus = Bus
|
||||
{ busInbound :: TChan Value
|
||||
, busOutbound :: TChan Service
|
||||
, busConn :: TVar (Maybe Connection)
|
||||
, busGen :: CallIdGen
|
||||
, busLogEnv :: LogEnv -- new
|
||||
}
|
||||
|
||||
newBus :: LogEnv -> Int -> IO Bus -- LogEnv first
|
||||
```
|
||||
|
||||
`LogEnv` is the more "environmental" arg; `Int` is the call-id seed.
|
||||
|
||||
### `HASSEff` interpreters (Runtime.hs, Bus.hs)
|
||||
|
||||
Both gain the controller name as the 2nd arg and read `LogEnv` from
|
||||
`Bus`/`busLogEnv`:
|
||||
|
||||
```haskell
|
||||
dryRunHassEval :: Bus -> Text -> HASSEff a -> IO a
|
||||
channelHassEval :: Bus -> Text -> HASSEff a -> IO a
|
||||
```
|
||||
|
||||
- `dryRunHassEval` changes from `CallIdGen -> ...` to `Bus -> Text ->
|
||||
...` (it needs both `busGen` for call ids and `busLogEnv` for
|
||||
logging). Matches `channelHassEval`'s shape for symmetry.
|
||||
- `Debug`: `print x` → `runKatipT (busLogEnv bus) $ logMsg ns DebugS
|
||||
(showLS x)`.
|
||||
- `Trace`: `print (req, x)` → the structured `logF` call in
|
||||
[Structured traceId](#structured-traceid).
|
||||
- `CallService`:
|
||||
- `dryRunHassEval`: keeps `generateCallId (busGen bus)` (call id for
|
||||
dry-run output) and replaces `print (callId, x)` with a DebugS log
|
||||
of the `Service`:
|
||||
`runKatipT (busLogEnv bus) $ logMsg ns DebugS (showLS svc)`.
|
||||
- `channelHassEval`: unchanged — writes `Service` to `busOutbound`
|
||||
and emits no log (the writer does the actual send; logging here
|
||||
would be new behavior, not a replacement).
|
||||
|
||||
### `supervised` (Supervisor.hs)
|
||||
|
||||
```haskell
|
||||
supervised :: LogEnv -> Text -> Backoff -> IO Void -> IO Void
|
||||
```
|
||||
|
||||
Logs via `runKatipT le $ logMsg ("runtime.supervisor." <> name) sev
|
||||
msg`. `defaultMain` passes `busLogEnv bus`.
|
||||
|
||||
### `defaultMain` (Runtime.hs)
|
||||
|
||||
Builds `LogEnv` at the top, passes to `newBus`, wraps body in
|
||||
`bracket ... closeScribes`:
|
||||
|
||||
```haskell
|
||||
defaultMain = withSocketsDo $ do
|
||||
scribe <- mkHandleScribe ColorIfTerminal stdout (permitItem DebugS) V2
|
||||
le <- registerScribe "stdout" scribe defaultScribeSettings
|
||||
=<< initLogEnv "home-assistant-controller" "production"
|
||||
bracket (pure le) closeScribes $ \le' -> do
|
||||
token <- getEnv "HA_TOKEN"
|
||||
bus <- newBus le' 0
|
||||
let workers = ...
|
||||
as <- mapM (\(name, act) -> async (supervised le' name defaultBackoff act)) workers
|
||||
(_, v) <- waitAny as
|
||||
absurd v
|
||||
```
|
||||
|
||||
### `runController` (Runtime.hs)
|
||||
|
||||
`Controller _name` becomes `Controller name`; the name threads into the
|
||||
interpreter:
|
||||
|
||||
```haskell
|
||||
runController :: Bus -> Controller -> IO Void
|
||||
runController bus (Controller name machine) = do
|
||||
inbound <- atomically (dupTChan (busInbound bus))
|
||||
go inbound machine
|
||||
where
|
||||
go inbound f = do
|
||||
msg <- atomically (readTChan inbound)
|
||||
uuid <- UUID.V4.nextRandom
|
||||
(_, f') <- step (dryRunHassEval bus name) uuid f (Event msg)
|
||||
go inbound f'
|
||||
```
|
||||
|
||||
### `Connection.hs` workers
|
||||
|
||||
`readerAction`/`writerAction` signatures unchanged — they already take
|
||||
`Bus`. The two `putStrLn` sites read `busLogEnv bus` and log via
|
||||
`runKatipT (busLogEnv bus) $ logMsg "runtime.reader" sev msg`.
|
||||
|
||||
### No changes to
|
||||
|
||||
`AFRP.hs`, `Controller.hs`, `Controller/Bedroom.hs`,
|
||||
`Connection.hs`'s pure `encodeService`, or any controller definition —
|
||||
they remain logging-free.
|
||||
|
||||
## Tests
|
||||
|
||||
A silent `LogEnv` helper (in `test/Main.hs` or a new `test/Support.hs`)
|
||||
lets tests construct a `Bus`/call `supervised` without spewing:
|
||||
|
||||
```haskell
|
||||
silentLogEnv :: IO LogEnv
|
||||
silentLogEnv = initLogEnv "home-assistant-controller" "test"
|
||||
```
|
||||
|
||||
No scribe registered → all `logMsg` calls are no-ops (katip drops
|
||||
silently).
|
||||
|
||||
Mechanical call-site updates:
|
||||
|
||||
- `BusSpec`: `newBus 0` → `silentLogEnv >>= \le -> newBus le 0`;
|
||||
`channelHassEval bus (CallService svc)` →
|
||||
`channelHassEval bus "test" (CallService svc)`.
|
||||
- `RuntimeSpec`: `newBus 0` → with `silentLogEnv`; `runController bus
|
||||
(Controller "test" lightController)` unchanged.
|
||||
- `SupervisorSpec`: `supervised "test" tinyBackoff action` →
|
||||
`silentLogEnv >>= \le -> supervised le "test" tinyBackoff action`
|
||||
(3 call sites).
|
||||
- `ConnectionSpec`/`BackoffProp`: no change (test pure code).
|
||||
|
||||
No new tests required — the logging swap is behavior-preserving for
|
||||
existing assertions. A capturing-scribe test asserting debug logs
|
||||
*would* fire is out of scope (noted as a future option).
|
||||
|
||||
## Cabal & nix
|
||||
|
||||
- Add `katip` to library `build-depends` and to test-suite
|
||||
`build-depends` (the test helper imports `Katip`).
|
||||
- After editing the `.cabal`, regenerate the derivation per AGENTS.md:
|
||||
|
||||
```
|
||||
nix run nixpkgs#cabal2nix -- ./. > default.nix
|
||||
```
|
||||
|
||||
- `flake.nix`: no change. nixpkgs has `katip` 0.8.8.4 (verified), and
|
||||
`callPackage ./.` picks up new deps from `default.nix` automatically.
|
||||
- `default.nix`: regenerated by the cabal2nix command — never hand-edit.
|
||||
|
||||
## Imports added
|
||||
|
||||
| Module | Import |
|
||||
|--------|--------|
|
||||
| `Bus.hs` | `import Katip` |
|
||||
| `Runtime.hs` | `import Katip` |
|
||||
| `Supervisor.hs` | `import Katip` (+ `qualified Data.Text as T` if not present) |
|
||||
| `Connection.hs` | `import Katip` |
|
||||
| test helper | `import Katip` |
|
||||
|
||||
## Non-goals
|
||||
|
||||
- Logging inside the AFRP layer or controller definitions.
|
||||
- A custom capturing-scribe test.
|
||||
- Log-level configuration via env or CLI (the scribe `permitItem` is a
|
||||
code constant for now).
|
||||
- JSON output / file scribe / multiple scribes (deferred; the single
|
||||
stdout text scribe is the drop-in replacement for current `print`).
|
||||
- Changing `app/Main.hs` (outside `src/`).
|
||||
Reference in New Issue
Block a user