diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for salmon-ops + +## 0.1.0.0 -- unreleased + +* First release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2022-2026, Lucas DiCioccio +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/fixtures/DotFixture.hs b/fixtures/DotFixture.hs new file mode 100644 --- /dev/null +++ b/fixtures/DotFixture.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} + +{- | A fixture graph exercising every edge-color branch of +'Salmon.Actions.Dot' (plain\/OV, red\/CL, orange\/CR+Connect, gray\/CR+Overlay), +an Actionless node (dot-render skip-through), and a dependency shared by two +parents (to exercise 'Salmon.Actions.UpDown''s dedup-by-Ref path). + +This repo has no automated test suite (see CLAUDE.md) — this binary isn't +one either. It's a fixture to run and eyeball\/diff by hand, e.g. before and +after touching graph-traversal or dot-rendering code: + +> salmon-ops-dot-fixture dot > before.dot # on a known-good commit +> salmon-ops-dot-fixture dot > after.dot # after your change +> diff before.dot after.dot # expect no diff + +> salmon-ops-dot-fixture up # eyeball the Eval\/Skip\/Done report +-} +module Main (main) where + +import Control.Monad (void) +import Control.Monad.Identity (runIdentity) +import qualified Data.Text as Text +import System.Environment (getArgs) +import System.Exit (die) + +import Salmon.Actions.Dot (printDigraph) +import Salmon.Actions.UpDown (upTree) +import Salmon.Builtin.Extension +import Salmon.Op.Graph +import Salmon.Op.OpGraph (OpGraph (..), inject, overlaid) +import Salmon.Op.Ref (mkRef) +import Salmon.Reporter (reportPrint) + +leaf :: Text.Text -> Op +leaf name = + op name nodeps $ \x -> + x{ref = mkRef "leaf" name, up = putStrLn ("up " <> Text.unpack name)} + +-- | Depended on by both 'childV' and 'childO', to exercise upTree's +-- dedup-by-Ref path (one Eval, however many paths reach it). +commonLeaf :: Op +commonLeaf = leaf "common-leaf" + +leafCL :: Op +leafCL = leaf "leaf-cl" + +-- | Own predecessors are 'Vertices' (shape V): the edge into this node from +-- 'root' is tagged (CR,V) -> plain. +childV :: Op +childV = + op "child-v" (deps [commonLeaf]) $ \x -> + x{ref = mkRef "child" ("child-v" :: Text.Text), up = putStrLn "up child-v"} + +-- | Own predecessors are 'Overlay' (shape O): the edge into this node from +-- 'root' is tagged (CR,O) -> gray. Also overlays an 'Actionless' node +-- ('realNoop'), to exercise dot's skip-through-Actionless path. +childO :: Op +childO = + ( op "child-o" nodeps $ \x -> + x{ref = mkRef "child" ("child-o" :: Text.Text), up = putStrLn "up child-o"} + ) + `overlaid` commonLeaf + `overlaid` realNoop + +-- | Own predecessors are 'Connect' (shape C, via 'inject'): the edge into +-- this node from 'root' is tagged (CR,C) -> orange. Its own inject produces +-- a further CL\/red edge one level down. +childC :: Op +childC = + ( op "child-c" nodeps $ \x -> + x{ref = mkRef "child" ("child-c" :: Text.Text), up = putStrLn "up child-c"} + ) + `inject` leaf "leaf-c-inner" + +-- | 'root''s predecessors are hand-built as @Connect (Vertices ..) (Vertices +-- ..)@ so that 'leafCL' is reached via the Connect's left arm (CL -> red), +-- while 'childV'\/'childO'\/'childC' are reached via the right arm (CR), +-- each then getting a different edge color from its own predecessor shape. +root :: Op +root = + (op "root" nodeps $ \x -> x{ref = mkRef "root" (), up = putStrLn "up root"}) + { predecessors = pure (Connect (Vertices [leafCL]) (Vertices [childV, childO, childC])) + } + +main :: IO () +main = do + args <- getArgs + case args of + ["dot"] -> printDigraph (pure . runIdentity) root + ["up"] -> void $ upTree reportPrint (pure . runIdentity) root + _ -> die "usage: salmon-ops-dot-fixture (dot|up)" diff --git a/fixtures/PostgresReplicationFixture.hs b/fixtures/PostgresReplicationFixture.hs new file mode 100644 --- /dev/null +++ b/fixtures/PostgresReplicationFixture.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} + +{- | A fixture demonstrating "Salmon.Builtin.Nodes.Postgres"'s WAL streaming +replication primitives end to end: one node running the (Debian-default, +\"main\") cluster as a primary, another cloning it and running as a +streaming standby. + +This repo has no automated test suite (see CLAUDE.md) — like +'salmon-ops-dot-fixture', this binary is meant to be run and eyeballed by +hand, against two real machines (or, easiest, two podman containers on +podman's default network, which resolves containers by name via embedded +DNS). For example: + +> podman run -dt --name pg-primary --hostname pg-primary debian:bookworm sleep infinity +> podman run -dt --name pg-standby --hostname pg-standby debian:bookworm sleep infinity +> podman exec pg-primary bash -c "apt-get update -qq && DEBIAN_FRONTEND=noninteractive apt-get install -y -qq sudo" +> podman exec pg-standby bash -c "apt-get update -qq && DEBIAN_FRONTEND=noninteractive apt-get install -y -qq sudo" +> +> cabal build salmon-postgres-replication-fixture +> BIN=dist-newstyle/build/*/*/salmon-ops-0.1.0.0/x/salmon-postgres-replication-fixture/build/salmon-postgres-replication-fixture/salmon-postgres-replication-fixture +> podman cp "$BIN" pg-primary:/usr/local/bin/fixture +> podman cp "$BIN" pg-standby:/usr/local/bin/fixture +> +> # allow the standby's container subnet to authenticate as the replication role +> podman exec pg-primary fixture primary 0.0.0.0/0 +> podman exec pg-standby fixture standby pg-primary +> +> # eyeball it: the standby should now be streaming from the primary +> podman exec pg-standby sudo -u postgres psql -c "SELECT status FROM pg_stat_wal_receiver;" +> podman exec pg-primary sudo -u postgres psql -c "SELECT client_addr, state FROM pg_stat_replication;" + +The @0.0.0.0\/0@ above is a fixture-only shortcut (no need to look up the +standby's actual container IP by hand) — a real deployment should pass the +standby's actual address\/CIDR instead, per "Postgres.primaryReplicationSetup"'s +own doc. + +> salmon-postgres-replication-fixture dot primary 10.0.0.2/32 # print the primary-side graph +> salmon-postgres-replication-fixture dot standby pg-primary # print the standby-side graph +-} +module Main (main) where + +import Control.Monad (unless) +import Control.Monad.Identity (runIdentity) +import qualified Data.Text as Text +import System.Environment (getArgs) +import System.Exit (die, exitFailure) + +import Salmon.Actions.Dot (printDigraph) +import Salmon.Actions.UpDown (upTree) +import Salmon.Builtin.Extension +import Salmon.Builtin.Nodes.Binary (justInstall) +import qualified Salmon.Builtin.Nodes.Debian.OS as Debian +import qualified Salmon.Builtin.Nodes.Filesystem as FS +import qualified Salmon.Builtin.Nodes.Postgres as Postgres +import Salmon.Op.OpGraph (inject) +import Salmon.Op.Track +import Salmon.Reporter (reportPrint) + +------------------------------------------------------------------------------- +-- fixture-only constants: a real deployment would generate/store these per-pair, not hardcode them + +replRole :: Postgres.RoleName +replRole = "replicator" + +replPassword :: Postgres.Password +replPassword = Postgres.Password "fixture-replication-password" + +replSlot :: Postgres.ReplicationSlotName +replSlot = "standby_slot" + +{- | Where the standby keeps the replication password; see 'standbyOp'. + +@.pgpass@ format, which is what @primary_conninfo@'s @passfile=@ reads and +what 'Postgres.standby_repl_passfile' therefore expects: one file for the +clone and for the streaming that follows it. +-} +replPassfile :: FilePath +replPassfile = "/etc/postgresql/salmon-replication.pgpass" + +primaryPort :: Postgres.Port +primaryPort = 5432 + +------------------------------------------------------------------------------- + +-- | Ensures the (Debian-default) "main" cluster is installed and started, dependend on by both roles. +serverUp :: Op +serverUp = Postgres.pgLocalCluster reportPrint Debian.postgres Debian.pg_ctlcluster Postgres.localServer + +serverTrack :: Track' Postgres.Server +serverTrack = Track $ const serverUp + +-- | Primary role: creates the replication user, then turns "main" into a replication-capable primary. +primaryOp :: Text.Text -> Op +primaryOp standbyCidr = + Postgres.primaryReplicationSetup + reportPrint + Debian.psql + Debian.pg_ctlcluster + primaryPort + Postgres.mainCluster + Postgres.defaultReplicationTuning + replRole + standbyCidr + replSlot + `inject` replUser + `inject` serverUp + where + replUser = Postgres.replicationUser reportPrint serverTrack Debian.psql primaryPort (Postgres.User replRole) replPassword + +{- | Standby role: installs postgres (for pg_basebackup), writes the +replication password where the clone can read it, and clones "main" off the +given primary host. + +The password file is the fixture standing in for whatever a real deployment +uses to get a secret onto a machine -- that is deliberately not this node's +business (see the @salmon-ops-recipes@ convention). What matters is that +'Postgres.StandbySetup' takes a /path/: the clone is a shell script, and a +script ends up in @ps@ and in every report salmon prints. +-} +standbyOp :: Text.Text -> Op +standbyOp primaryHost = + Postgres.standbyReplicationSetup reportPrint Debian.pg_ctlcluster standbySetup + `inject` passfileOp + `inject` justInstall Debian.postgres + where + passfileOp :: Op + passfileOp = + FS.ownedFile (FS.FileOwnership replPassfile (Just "postgres") (Just "postgres") 0o600) + `inject` FS.filecontents (FS.FileContents replPassfile ("*:*:*:" <> replRole <> ":" <> replPassword.revealPassword <> "\n")) + + standbySetup = + Postgres.StandbySetup + { Postgres.standby_cluster = Postgres.mainCluster + , Postgres.standby_primary_host = primaryHost + , Postgres.standby_primary_port = primaryPort + , Postgres.standby_repl_user = Postgres.User replRole + , Postgres.standby_repl_passfile = replPassfile + , Postgres.standby_slot = Just replSlot + } + +------------------------------------------------------------------------------- + +-- | Runs the graph and, unlike blindly ignoring 'upTree''s result, actually +-- exits non-zero if a command failed (and everything downstream of it got +-- 'Blocked') instead of reporting false success. +runUpOrDie :: Op -> IO () +runUpOrDie o = do + ok <- upTree reportPrint (pure . runIdentity) o + unless ok exitFailure + +main :: IO () +main = do + args <- getArgs + case args of + ["primary", standbyCidr] -> runUpOrDie (primaryOp (Text.pack standbyCidr)) + ["standby", primaryHost] -> runUpOrDie (standbyOp (Text.pack primaryHost)) + ["dot", "primary", standbyCidr] -> printDigraph (pure . runIdentity) (primaryOp (Text.pack standbyCidr)) + ["dot", "standby", primaryHost] -> printDigraph (pure . runIdentity) (standbyOp (Text.pack primaryHost)) + _ -> die "usage: salmon-postgres-replication-fixture ((dot (primary|standby))|primary |standby )" diff --git a/fixtures/QemuHostSetupFixture.hs b/fixtures/QemuHostSetupFixture.hs new file mode 100644 --- /dev/null +++ b/fixtures/QemuHostSetupFixture.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedRecordDot #-} + +{- | One-time, privileged host setup for the Layer 3 qemu test tier (see +@specs/qemu-test-vms.md@\/@specs/qemu-test-vms-progress.md@): grants +"Salmon.Builtin.Nodes.Capabilities" to @capsh@\/@qemu-system-x86_64@ and +hands ownership of each rootfs's @etc\/ssh@ subtree to an unprivileged +user, so that routine test runs (@cabal test salmon-ops-recipes@, +"Test.Harness".'Test.Harness.hasVmPrivileges') no longer need to run as +root at all — only this one-off setup does. Grants @capsh@, not @ip@ +itself: see "Salmon.Builtin.Nodes.LinuxBridge".'Salmon.Builtin.Nodes.LinuxBridge.ipLinkCommand's +haddock for why a direct grant on @ip@ doesn't work (iproute2 +unconditionally drops its own capability set at startup and only trusts +the ambient set, which only @capsh@-mediated exec can populate). + +Meant to be run once per machine, as root (or under @sudo@), and again +after any @apt upgrade@ of @libcap2-bin@\/@qemu-system-x86@ (package +upgrades replace the binary, wiping its capabilities — see +"Salmon.Builtin.Nodes.Capabilities".'Salmon.Builtin.Nodes.Capabilities.grantCapabilities' +haddock) or after debootstrapping a new rootfs: + +> cabal build salmon-qemu-host-setup-fixture +> sudo dist-newstyle/build/*/*/salmon-ops-0.1.0.0/x/salmon-qemu-host-setup-fixture/build/salmon-qemu-host-setup-fixture/salmon-qemu-host-setup-fixture \ +> lucas /var/lib/salmon-test-vms/smoke/root /var/lib/salmon-test-vms/pg-primary/root /var/lib/salmon-test-vms/pg-standby/root + +Idempotent (same conventions as every other node in this codebase): safe to +rerun, and every step it didn't need to redo is reported 'Skip'/no-op. +-} +module Main (main) where + +import Control.Monad (unless) +import Control.Monad.Identity (runIdentity) +import Data.List (foldl') +import qualified Data.Text as Text +import System.Directory (canonicalizePath, findExecutable) +import System.Environment (getArgs) +import System.Exit (die, exitFailure) +import System.FilePath (()) + +import Salmon.Actions.UpDown (upTree) +import Salmon.Builtin.Extension +import qualified Salmon.Builtin.Nodes.Capabilities as Capabilities +import qualified Salmon.Builtin.Nodes.Debian.OS as Debian +import qualified Salmon.Builtin.Nodes.User as User +import Salmon.Op.OpGraph (overlaid) +import Salmon.Reporter (reportPrint) + +-- | The capabilities each binary needs — see 'Salmon.Builtin.Nodes.Capabilities.grantCapabilities'. +capshCapabilities, qemuCapabilities :: [Capabilities.Capability] +capshCapabilities = ["cap_net_admin"] +qemuCapabilities = ["cap_dac_override", "cap_chown", "cap_fowner"] + +-- | Grants a resolved binary path its needed capabilities, or dies loudly +-- if the binary isn't found — same "fail loudly, don't hang" spirit as +-- "Test.Harness".'Test.Harness.requireExecutable'. Canonicalizes past any +-- symlink first (e.g. Debian's usrmerge makes @\/usr\/sbin\/ip@ a symlink to +-- @\/bin\/ip@) — @setcap@ refuses to operate on a symlink at all +-- ("Invalid file for capability operation"), it needs the real inode. +capabilityOp :: String -> [Capabilities.Capability] -> IO Op +capabilityOp exe caps = do + mPath <- findExecutable exe + case mPath of + Nothing -> die (exe <> " not found on PATH") + Just linkedPath -> do + path <- canonicalizePath linkedPath + pure (Capabilities.grantCapabilities reportPrint Debian.setcap path caps) + +-- | Hands ownership of one rootfs's @etc\/ssh@ subtree to the unprivileged +-- test user — see "Test.Harness".'Test.Harness.ensureVmSshAccess', which +-- writes a fresh per-boot SSH CA there directly on the host filesystem. +sshDirOwnershipOp :: User.Owner -> FilePath -> Op +sshDirOwnershipOp owner rootfs = + User.chown reportPrint Debian.chown True owner (rootfs "etc/ssh") + +main :: IO () +main = do + args <- getArgs + case args of + (user : rootfsPaths) -> do + capshOp <- capabilityOp "capsh" capshCapabilities + qemuOp <- capabilityOp "qemu-system-x86_64" qemuCapabilities + let owner = User.Owner (User.User (Text.pack user)) (User.Group (Text.pack user)) + sshOps = map (sshDirOwnershipOp owner) rootfsPaths + allOps = foldl' overlaid capshOp (qemuOp : sshOps) + ok <- upTree reportPrint (pure . runIdentity) allOps + unless ok exitFailure + _ -> die "usage: salmon-qemu-host-setup-fixture ..." diff --git a/fixtures/ServeFixture.hs b/fixtures/ServeFixture.hs new file mode 100644 --- /dev/null +++ b/fixtures/ServeFixture.hs @@ -0,0 +1,329 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +{- | A tiny end-to-end binary for playing with @run serve@ +('Salmon.Actions.Serve') by hand, against nothing more dangerous than files +in a directory you name. + +A seed is "a named bundle of files under a base directory". The 'Track'' +turns it into real 'Salmon.Builtin.Nodes.Filesystem' nodes (a directory plus +one file per name, each with deterministic content), so declaring a seed up +actually creates those files and retiring it actually deletes them — you can +watch the convergence happen in another terminal with @ls@/@watch@. + +Because it goes through 'CLI.execCommandOrSeed' it is a full salmon binary, +so the same seed works one-shot too: + +> salmon-ops-serve-fixture config --dir /tmp/play --name web --file index.html | salmon-ops-serve-fixture run up + +But the point is the loop. Try (typing, or piping in, one line per command): + +> salmon-ops-serve-fixture run serve +> up --dir /tmp/play --name web --file index.html --file style.css +> up --dir /tmp/play --name api --file openapi.json +> status +> down --dir /tmp/play --name web --file index.html --file style.css +> only --dir /tmp/play --name api --file openapi.json --file CHANGELOG +> history +> quit + +Notes to notice while playing: + + * the base directory itself is one node shared by every seed (they unify by + 'Salmon.Op.Ref.Ref'), so it survives until the last seed under it is gone; + * re-declaring an unchanged seed converges to a no-op (nothing is re-run); + * a seed is identified by the /files it asks for/, so @only@ with a + different --file set supersedes rather than adds; + * @status@ shows each node's wanted direction and whether it has converged. + += The @--daemon@ half + +Everything above is one-shot nodes: @up@ runs, and what it leaves behind +stays put on its own. @--daemon@ adds the two things that are not that — a +node that /owns a running process/ +('Salmon.Builtin.Extension.managed'), and a node whose going away +/bounces what stands on it/ ('Salmon.Op.Supervision.RestForOne') — which +otherwise exist only inside the test suite. + +It adds two nodes to the bundle: a @daemon.conf@ under the bundle directory +(the only node here with a @check@ of its own, and the one declaring +@RestForOne@), and a process that reads that file __once at startup__ and +then appends a line to @\\/\.log@ every second. The log is +deliberately outside the bundle directory: nothing declares it, so nothing +removes it, and you can read it across as many up\/down cycles as you like. + +Supervision only runs while the loop is __idle__, so none of this shows up +under @serve \< script@ — every line of a piped script is already queued +before the first pass ends. Type at it, or drive it from a fifo. + +> salmon-ops-serve-fixture run serve +> up --dir /tmp/play --name web --daemon --greeting hello + +then, in another terminal, @tail -f \/tmp\/play\/web.log@ to watch it. + +__Bouncing on drift.__ Edit @\/tmp\/play\/web\/daemon.conf@ yourself. The +config node's own machine notices (its @check@ compares the content), rewrites +it, and because it declared @RestForOne@ the process reading it is sent back: + +> Signalling "web" 15 +> Reaped "web" +> serve: daemon sent back to wait: ... stopped being up +> Spawned "web" (Just ...) + +Note the teardown happens /before/ the node is sent back — the process is +stopped through its own bracket first, and only then does the node go looking +for its dependency again. + +__Bouncing on a re-declaration.__ + +> only --dir /tmp/play --name web --daemon --greeting goodbye + +The log's next line has both a new pid and the new greeting. Worth watching +the reports for /where/ that happens, because it is not where one would +guess: the convergence pass says @converging (0 down, 0 up)@ and does +nothing, since the node is already 'Salmon.Actions.Serve.Converged' under a +'Salmon.Op.Ref.Ref' that did not change. What applies the new content is the +config node's own machine, on its next look. A node with no @check@ — every +other node in this fixture — would simply keep the old content. + +__What a node's own check is and is not allowed to say.__ Add +@--stale-check@ and the daemon node gains a plausible-looking health check: +"my log file exists". It is wrong in the way health checks are wrong — it +answers "this ran at some point", not "it is running now" — and doing either +of the above shows it being __deliberately ignored__: the node is torn down +and put straight back, because the machine that cancelled the action knows +better than any check can. + +That is a fix rather than the original behaviour. Until (I1) in +@specs\/per-node-state-machines-remaining.md@ was settled, this flag lost the +process outright: the check was consulted, it said the effect was in place, +and the node settled into 'Salmon.Actions.Upkeep.Up' holding nothing at all. +The flag stays because the rule it demonstrates is worth being able to see. +-} +module Main (main) where + +import Control.Exception (throwIO) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import GHC.Generics (Generic) +import Options.Applicative (execParser, fullDesc, header, info, long, many, metavar, progDesc, strOption, switch, value) +import qualified Options.Applicative as Opt +import Options.Generic (ParseRecord (..)) +import System.Directory (doesFileExist, removeFile) +import System.FilePath (takeDirectory, (<.>), ()) +import System.Process (proc) + +import Salmon.Actions.UpDown (CheckResult (..)) +import qualified Salmon.Builtin.CommandLine as CLI +import Salmon.Builtin.Extension (Op, Track', check, deps, down, dynamics, help, managed, notes, op, ref, up) +import qualified Salmon.Builtin.Nodes.Daemon as Daemon +import qualified Salmon.Builtin.Nodes.Filesystem as FS +import Salmon.Op.Configure (Configure (..)) +import Salmon.Op.Ref (mkRef) +import Salmon.Op.Supervision (Strategy (..), Supervision (..), defaultSupervision, supervised) +import Salmon.Op.Track (Track (..)) +import Salmon.Reporter (reportIf, reportPrint) + +------------------------------------------------------------------------------- + +-- | What a human types after @config@ / @up@ / @down@ / @only@. +data Seed = Seed + { seedDir :: FilePath + , seedName :: Text + , seedFiles :: [String] + , seedDaemon :: Bool + , seedGreeting :: Text + , seedStaleCheck :: Bool + } + deriving (Generic, Show) + +instance ParseRecord Seed where + parseRecord = + Seed + <$> strOption + (long "dir" <> metavar "DIR" <> value "/tmp/salmon-serve-fixture" <> Opt.help "base directory to converge files under") + <*> fmap Text.pack (strOption (long "name" <> metavar "NAME" <> Opt.help "name of this bundle (its own subdirectory)")) + <*> many (strOption (long "file" <> metavar "FILE" <> Opt.help "a file to keep in the bundle (repeatable)")) + <*> switch (long "daemon" <> Opt.help "also run a process that reads this bundle's config and logs it once a second") + <*> fmap + Text.pack + ( strOption + (long "greeting" <> metavar "TEXT" <> value "hello" <> Opt.help "what the daemon's config file says (--daemon only)") + ) + <*> switch + ( long "stale-check" + <> Opt.help "give the daemon a plausible-but-stale check (\"my log exists\"), which a bounce then ignores. See (I1)." + ) + +-- | The hermetic directive: same shape as the seed here, but that's a +-- coincidence of how trivial this fixture is — the point of the type is that +-- it is 'FromJSON'\/'ToJSON', so it is what identifies a seed in the loop. +data Spec = Spec + { specRoot :: FilePath + , specFiles :: [FilePath] + , specDaemon :: Maybe DaemonSpec + } + deriving (Eq, Show, Generic) + +-- | Everything the @--daemon@ half needs, absent when it was not asked for. +data DaemonSpec = DaemonSpec + { daemonName :: Text + , daemonConf :: FilePath + , daemonLog :: FilePath + , daemonGreeting :: Text + , daemonStaleCheck :: Bool + } + deriving (Eq, Show, Generic) + +instance FromJSON Spec +instance ToJSON Spec +instance FromJSON DaemonSpec +instance ToJSON DaemonSpec + +configure :: Configure IO Seed Spec +configure = Configure $ \seed -> + let root = seed.seedDir Text.unpack seed.seedName + in pure $ + Spec + root + [root f | f <- seed.seedFiles] + ( if not seed.seedDaemon + then Nothing + else + Just $ + DaemonSpec + { daemonName = seed.seedName + , daemonConf = root "daemon.conf" + , -- deliberately /outside/ the bundle directory, and + -- so not a node: nothing declares it, nothing + -- removes it, and `dir`'s non-recursive `down` + -- does not trip over it on the way out. + daemonLog = seed.seedDir Text.unpack seed.seedName <.> "log" + , daemonGreeting = seed.seedGreeting + , daemonStaleCheck = seed.seedStaleCheck + } + ) + +program :: Track' Spec +program = Track $ \spec -> + op "serve-fixture-bundle" (deps (fmap fileOp spec.specFiles <> foldMap (pure . daemonOp) spec.specDaemon)) $ \actions -> + actions{ref = mkRef "serve-fixture-bundle" (spec.specRoot, spec.specFiles, fmap daemonConf spec.specDaemon)} + where + fileOp :: FilePath -> Op + fileOp path = + FS.filecontents (FS.FileContents path (Text.pack ("managed by salmon-ops-serve-fixture: " <> path <> "\n"))) + +------------------------------------------------------------------------------- +-- the --daemon half: a process salmon owns, and the config it stands on + +{- | The daemon's configuration file. + +It is written out rather than reusing +'Salmon.Builtin.Nodes.Filesystem.filecontents' for one reason now, where it +used to be two. The remaining one is the __policy__: this node declares +'RestForOne', and @filecontents@ takes no modifier through which a caller +could attach one. The reason that has gone away is the __check__ — +@filecontents@ had none when this fixture was written, so it answered +@Immaterial@ and was parked the moment it was up, which made it unable to +notice its own file changing and therefore unable to demote anything. It has +'Salmon.Builtin.Nodes.Filesystem.checkFileContents' now, and this node's +@check@ is that same function rather than a hand-rolled copy of it. + +'RestForOne' is authored here, on the file, rather than on the daemon that +reads it. Only the file's author knows its content is load-bearing. +-} +configOp :: DaemonSpec -> Op +configOp d = + op "daemon-config" (deps [FS.dir (FS.Directory (takeDirectory d.daemonConf))]) $ \actions -> + actions + { help = Text.pack ("keeps " <> d.daemonConf <> " saying " <> Text.unpack d.daemonGreeting) + , notes = + [ "checks its own contents, so a supervisor can notice it changing" + , "declares RestForOne, so whatever reads it is bounced when it does" + ] + , -- keyed on the path alone, so re-declaring the bundle with a + -- different --greeting is the /same node/ with different + -- content rather than a second node. + ref = mkRef "daemon-config" d.daemonConf + , check = FS.checkFileContents (FS.FileContents d.daemonConf body) + , up = Text.IO.writeFile d.daemonConf body + , down = removeFile d.daemonConf + , dynamics = [supervised defaultSupervision{supStrategy = RestForOne}] + } + where + body :: Text + body = "greeting = " <> d.daemonGreeting <> "\n" + +{- | A process salmon owns, which reads the config __once at startup__ and +then logs what it read every second. + +Reading once is what makes the demonstration honest: the running process +holds content that can go stale, and nothing but restarting it can make it +notice. Written out rather than going through +'Salmon.Builtin.Nodes.Daemon.daemon' because this node wants two things that +function does not offer — a dependency, and (with @--stale-check@) a @check@ +of its own — which is exactly the case @runDaemon@ is exposed for. +-} +daemonOp :: DaemonSpec -> Op +daemonOp d = + op "daemon" (deps [configOp d]) $ \actions -> + actions + { help = Text.pack ("keeps a process logging to " <> d.daemonLog) + , ref = Daemon.daemonRef spawn + , managed = Just (Daemon.runDaemon chatter spawn) + , check = + if not d.daemonStaleCheck + then -- nothing to ask: this machine holds the process, + -- and the process exiting is raced in the same + -- transaction as the mailbox. So the node parks and the + -- delay ladder never runs at all. + pure Immaterial + else do + -- A health check somebody might plausibly write, and + -- which is wrong in the way health checks are wrong: + -- it answers "something ran once", not "it is running + -- now". A bounce ignores it, because the machine that + -- cancelled the action knows better; see (I1) in + -- specs/per-node-state-machines-remaining.md for what + -- it used to do instead. + there <- doesFileExist d.daemonLog + pure (if there then Success else Failure "no log yet") + , -- `run up` has nowhere to put an action that never returns. + up = throwIO (Daemon.NeedsSupervisor d.daemonName) + , -- under `serve` the process died when its machine was + -- cancelled; under `run down` it never held one. + down = pure () + } + where + spawn :: Daemon.Daemon + spawn = + Daemon.defaultDaemon + d.daemonName + (proc "/bin/sh" ["-c", script]) + + script :: String + script = + mconcat + [ "cfg=$(cat " + , d.daemonConf + , "); while true; do echo \"[pid $$] $cfg\" | tee -a " + , d.daemonLog + , "; sleep 1; done" + ] + + -- everything the daemon does /except/ repeat its own output back: the + -- process writes a line a second (to its log and, through @tee@, to its + -- stdout, which is what the node's ring and a live tail follow). + chatter = reportIf notWrote reportPrint + notWrote Daemon.Wrote{} = False + notWrote _ = True + +------------------------------------------------------------------------------- + +main :: IO () +main = do + let desc = fullDesc <> progDesc "play with `run serve` against files in a directory" <> header "salmon-ops-serve-fixture" + cmd <- execParser (info parseRecord desc) + CLI.execCommandOrSeed reportPrint configure program cmd diff --git a/openapi/serve-api.openapi.json b/openapi/serve-api.openapi.json new file mode 100644 --- /dev/null +++ b/openapi/serve-api.openapi.json @@ -0,0 +1,3869 @@ +{ + "openapi": "3.1.0", + "info": { + "title": "salmon run serve", + "version": "1", + "summary": "The HTTP surface of `run serve --http PATH` and `--http-tcp HOST:PORT`", + "description": "Served on a unix socket (owner-only, no token) by `--http PATH`, and over TLS on a network by `--http-tcp` (every route needs `Authorization: Bearer ` or a session cookie from `/auth`). Both serve this same application on the same loop.\n\nReads (`/dag`, `/status`, `/history`, `/help/seed`) never enter the loop's input. Writes are `POST /command`. Motion between commands is visible only on `/events`.\n\nThe seed words in a command are binary-specific: their grammar is `GET /help/seed`, not something this document can enumerate.\n\nA client that wants to refuse a server it does not understand can read `info.version` here; the responses themselves carry no version yet." + }, + "servers": [ + { + "url": "http://localhost", + "description": "unix socket (`curl --unix-socket PATH http://x/dag`)" + }, + { + "url": "https://{host}:{port}", + "variables": { + "host": { + "default": "localhost" + }, + "port": { + "default": "8443" + } + }, + "description": "`--http-tcp`" + } + ], + "security": [ + { + "bearerAuth": [] + }, + { + "sessionCookie": [] + } + ], + "paths": { + "/dag": { + "get": { + "operationId": "getDag", + "summary": "The computed DAG with each node's state", + "description": "Bypasses the loop's input: a read never stands a machine down and answers while a node's `up` is running. At most one command old.", + "responses": { + "200": { + "description": "the DAG", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/DagResponse" + } + } + } + }, + "503": { + "description": "the loop has not started", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + } + } + } + }, + "/status": { + "get": { + "operationId": "getStatus", + "summary": "Per-node state, as `status --json`", + "responses": { + "200": { + "description": "the status", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/StatusResponse" + } + } + } + }, + "503": { + "description": "the loop has not started", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + } + } + } + }, + "/history": { + "get": { + "operationId": "getHistory", + "summary": "The seed and graph history, as `history --json`", + "responses": { + "200": { + "description": "the history", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/HistoryResponse" + } + } + } + }, + "503": { + "description": "the loop has not started", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + } + } + } + }, + "/help/seed": { + "get": { + "operationId": "getHelpSeed", + "summary": "The seed grammar and the command reference", + "responses": { + "200": { + "description": "the help", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/HelpResponse" + } + } + } + } + } + } + }, + "/command": { + "post": { + "operationId": "postCommand", + "summary": "One line of the input language", + "description": "The line joins the loop's inbox with an origin minted per request (`PATH#n` on the unix socket, `ADDR:PORT#n` over TCP). Synchronous by default: answers, when the loop has handled the line, with every report stamped with that origin. `?async` answers at once with the number of the `enqueued` event. A synchronous `up` holds the request for the whole pass, so a UI should use `?async` and read the outcome off `/events`.", + "parameters": [ + { + "name": "async", + "in": "query", + "required": false, + "allowEmptyValue": true, + "schema": { + "type": "string" + }, + "description": "Presence selects the asynchronous form." + } + ], + "requestBody": { + "required": true, + "content": { + "text/plain": { + "schema": { + "type": "string" + }, + "description": "the line, one trailing newline tolerated" + }, + "application/json": { + "schema": { + "$ref": "#/components/schemas/CommandBody" + } + } + } + }, + "responses": { + "200": { + "description": "synchronous: the reports the line produced, in order", + "content": { + "application/json": { + "schema": { + "type": "array", + "items": { + "$ref": "#/components/schemas/Report" + } + } + } + } + }, + "202": { + "description": "asynchronous: queued", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/AsyncAnswer" + } + } + } + }, + "400": { + "description": "the body is not one line, not UTF-8, or not a command object", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + }, + "503": { + "description": "the loop is not taking commands", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + } + } + } + }, + "/events": { + "get": { + "operationId": "getEvents", + "summary": "Every report, numbered and replayable, as server-sent events", + "description": "Each event is `id: N` and `data: `. `?since=N` replays what the ring still holds above N and continues live; if N+1 has fallen off, the first event is a GapEvent with no `id`. A comment line `: keep-alive` every 15s of silence. The stream ends when the loop does. Description of the four `stream`s and of `server` is on EventData.", + "parameters": [ + { + "name": "since", + "in": "query", + "required": false, + "schema": { + "type": "integer" + } + }, + { + "name": "stream", + "in": "query", + "required": false, + "style": "form", + "explode": true, + "schema": { + "type": "array", + "items": { + "type": "string", + "enum": [ + "serve", + "updown", + "upkeep", + "output", + "follow", + "server" + ] + } + }, + "description": "repeatable or comma-separated" + }, + { + "name": "origin", + "in": "query", + "required": false, + "style": "form", + "explode": true, + "schema": { + "type": "array", + "items": { + "type": "string" + } + }, + "description": "repeatable; only events of commands typed under this origin" + } + ], + "responses": { + "200": { + "description": "the stream", + "content": { + "text/event-stream": { + "schema": { + "type": "string" + } + } + } + }, + "400": { + "description": "a malformed `since`, `stream` or `origin`", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + } + } + } + }, + "/": { + "get": { + "operationId": "getUi", + "summary": "The web UI", + "responses": { + "200": { + "description": "the page", + "content": { + "text/html": { + "schema": { + "type": "string" + } + } + } + }, + "303": { + "description": "over TCP without a credential: to /auth" + } + } + } + }, + "/ui/{file}": { + "get": { + "operationId": "getUiFile", + "summary": "A file of the web UI", + "parameters": [ + { + "name": "file", + "in": "path", + "required": true, + "schema": { + "type": "string" + } + } + ], + "responses": { + "200": { + "description": "the file (`text/html`, `text/javascript` or `text/css`)" + }, + "404": { + "description": "not in the embedded set", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/Error" + } + } + } + } + } + } + }, + "/openapi.json": { + "get": { + "operationId": "getOpenApi", + "summary": "This document", + "description": "Embedded in the binary, so it is the description of the server answering.", + "responses": { + "200": { + "description": "this document", + "content": { + "application/json": { + "schema": { + "type": "object" + } + } + } + } + } + } + }, + "/auth": { + "get": { + "operationId": "getAuth", + "summary": "The sign-in form (TCP listener); a redirect to / on the unix socket", + "security": [], + "responses": { + "200": { + "description": "the form", + "content": { + "text/html": { + "schema": { + "type": "string" + } + } + } + }, + "303": { + "description": "to /" + } + } + }, + "post": { + "operationId": "postAuth", + "x-tcp-only": true, + "summary": "Sign in with the token", + "description": "TCP listener only. A form post of the token; answers 303 with a `__Host-salmon-session` cookie (HttpOnly; Secure; SameSite=Strict) that is then accepted wherever the bearer token is.", + "security": [], + "requestBody": { + "content": { + "application/x-www-form-urlencoded": { + "schema": { + "type": "object", + "properties": { + "token": { + "type": "string" + } + }, + "required": [ + "token" + ] + } + } + } + }, + "responses": { + "303": { + "description": "signed in (cookie set), or back to the form" + } + } + } + }, + "/auth/logout": { + "post": { + "operationId": "postLogout", + "summary": "Revoke the session", + "description": "Expires the cookie and cuts any `/events` stream opened with it.", + "responses": { + "303": { + "description": "to /auth" + } + } + } + }, + "/auth/session": { + "get": { + "operationId": "getSession", + "summary": "Whether this request carries a session", + "responses": { + "200": { + "description": "the answer", + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/SessionAnswer" + } + } + } + } + } + } + } + }, + "components": { + "securitySchemes": { + "bearerAuth": { + "type": "http", + "scheme": "bearer", + "description": "TCP listener only; none on the unix socket." + }, + "sessionCookie": { + "type": "apiKey", + "in": "cookie", + "name": "__Host-salmon-session", + "description": "From POST /auth; TCP listener only." + } + }, + "schemas": { + "Error": { + "type": "object", + "properties": { + "error": { + "type": "string" + } + }, + "required": [ + "error" + ], + "description": "Every error status answers this: 400 (a body or query the route refuses), 401 (TCP only: no or wrong credential), 404, 405 (with an Allow header), 503 (the loop has not started)." + }, + "Ref": { + "type": "object", + "properties": { + "short": { + "type": "string" + }, + "full": { + "type": "string" + } + }, + "required": [ + "short", + "full" + ], + "description": "A node's identity: the short tag a selector can use as `#`, and the full text." + }, + "Mode": { + "type": "string", + "enum": [ + "interactive", + "following", + "replay" + ], + "description": "What the world is: typed at a keyboard, following a registry, or replaying the last applied document after a failed start." + }, + "Direction": { + "type": "string", + "enum": [ + "up", + "down" + ] + }, + "Convergence": { + "type": "string", + "enum": [ + "pending", + "stale", + "converged", + "errored", + "blocked" + ] + }, + "CheckResult": { + "type": "object", + "properties": { + "verdict": { + "type": "string", + "enum": [ + "success", + "skipped", + "completed", + "failure", + "unknown", + "immaterial" + ] + }, + "reason": { + "type": "string" + } + }, + "required": [ + "verdict" + ], + "description": "`reason` is present for `failure` only." + }, + "MachineStatus": { + "type": "object", + "properties": { + "check": { + "$ref": "#/components/schemas/CheckResult" + }, + "direction": { + "$ref": "#/components/schemas/Direction" + }, + "stability": { + "type": "string", + "enum": [ + "stable", + "transient" + ] + }, + "epoch": { + "type": "integer" + }, + "output": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "check", + "direction", + "stability", + "epoch", + "output" + ], + "description": "The last snapshot of a node's machine (its last check, its output ring). `null` on a node no machine has looked at." + }, + "NodeState": { + "type": "object", + "properties": { + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "shorthand": { + "type": "string" + }, + "help": { + "type": "string" + }, + "direction": { + "$ref": "#/components/schemas/Direction" + }, + "convergence": { + "$ref": "#/components/schemas/Convergence" + }, + "status": { + "oneOf": [ + { + "$ref": "#/components/schemas/MachineStatus" + }, + { + "type": "null" + } + ] + }, + "paths": { + "type": "array", + "items": { + "type": "string" + } + }, + "selected": { + "type": "boolean" + }, + "excluded": { + "type": "boolean" + } + }, + "required": [ + "ref", + "shorthand", + "help", + "direction", + "convergence", + "status", + "paths" + ], + "description": "A node as `status` lists it. `selected` and `excluded` are present in a `query` report only." + }, + "Representative": { + "type": "object", + "properties": { + "shorthand": { + "type": "string" + }, + "help": { + "type": "string" + }, + "notes": { + "type": "array", + "items": { + "type": "string" + } + }, + "dynamics": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "shorthand", + "help", + "notes", + "dynamics" + ], + "description": "The fields the loop compares to decide two declarations of one ref are the same node." + }, + "DagNode": { + "type": "object", + "properties": { + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "shorthand": { + "type": "string" + }, + "help": { + "type": "string" + }, + "direction": { + "$ref": "#/components/schemas/Direction" + }, + "convergence": { + "$ref": "#/components/schemas/Convergence" + }, + "status": { + "oneOf": [ + { + "$ref": "#/components/schemas/MachineStatus" + }, + { + "type": "null" + } + ] + }, + "paths": { + "type": "array", + "items": { + "type": "string" + } + }, + "notes": { + "type": "array", + "items": { + "type": "string" + } + }, + "dynamics": { + "type": "array", + "items": { + "type": "string" + } + }, + "dependencies": { + "type": "array", + "items": { + "$ref": "#/components/schemas/Ref" + } + }, + "dependants": { + "type": "array", + "items": { + "$ref": "#/components/schemas/Ref" + } + }, + "conflict": { + "type": "object", + "properties": { + "kept": { + "$ref": "#/components/schemas/Representative" + }, + "replaced": { + "$ref": "#/components/schemas/Representative" + } + }, + "required": [ + "kept", + "replaced" + ] + } + }, + "required": [ + "ref", + "shorthand", + "help", + "direction", + "convergence", + "status", + "paths", + "notes", + "dynamics", + "dependencies", + "dependants" + ], + "description": "One node of the computed DAG. `conflict` is present while two live declarations disagree about the node." + }, + "NodeDescription": { + "type": "object", + "properties": { + "shorthand": { + "type": "string" + }, + "help": { + "type": "string" + }, + "notes": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "shorthand", + "help", + "notes" + ] + }, + "Supervision": { + "type": "object", + "properties": { + "restart": { + "type": "string", + "enum": [ + "always", + "on-failure", + "never" + ] + }, + "strategy": { + "type": "string", + "enum": [ + "one-for-one", + "rest-for-one" + ] + }, + "reapply": { + "type": "boolean" + }, + "watchdog_us": { + "oneOf": [ + { + "type": "integer" + }, + { + "type": "null" + } + ] + }, + "stable_after_us": { + "type": "integer" + }, + "demote_every_us": { + "type": "integer" + }, + "give_up_after": { + "oneOf": [ + { + "type": "integer" + }, + { + "type": "null" + } + ] + } + }, + "required": [ + "restart", + "strategy", + "reapply", + "watchdog_us", + "stable_after_us", + "demote_every_us", + "give_up_after" + ] + }, + "Instruction": { + "type": "string", + "enum": [ + "force", + "satisfy", + "recheck", + "pause", + "resume" + ] + }, + "Origin": { + "oneOf": [ + { + "type": "object", + "properties": { + "kind": { + "const": "stdin" + } + }, + "required": [ + "kind" + ] + }, + { + "type": "object", + "properties": { + "kind": { + "const": "other" + }, + "name": { + "type": "string" + } + }, + "required": [ + "kind", + "name" + ] + }, + { + "type": "object", + "properties": { + "kind": { + "const": "loaded" + }, + "path": { + "type": "string" + } + }, + "required": [ + "kind", + "path" + ] + }, + { + "type": "object", + "properties": { + "kind": { + "const": "fetched" + }, + "registry": { + "type": "string" + }, + "label": { + "type": "string" + }, + "document": { + "type": "string" + }, + "sha256": { + "type": "string" + } + }, + "required": [ + "kind", + "registry", + "label", + "document", + "sha256" + ] + } + ], + "description": "Who typed a line or made a declaration." + }, + "UpDown_skip": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "skip" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpDownUntagged_skip": { + "type": "object", + "properties": { + "kind": { + "const": "skip" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "UpDown_eval": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "eval" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpDownUntagged_eval": { + "type": "object", + "properties": { + "kind": { + "const": "eval" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "UpDown_done": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "done" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpDownUntagged_done": { + "type": "object", + "properties": { + "kind": { + "const": "done" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "UpDown_blocked": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "blocked" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpDownUntagged_blocked": { + "type": "object", + "properties": { + "kind": { + "const": "blocked" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "UpDown_failed": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "failed" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "error" + ] + }, + "UpDownUntagged_failed": { + "type": "object", + "properties": { + "kind": { + "const": "failed" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "error": { + "type": "string" + } + }, + "required": [ + "kind", + "ref", + "node", + "error" + ] + }, + "UpDown_conflicting": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "conflicting" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "kept": { + "$ref": "#/components/schemas/NodeDescription" + }, + "replaced": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "kept", + "replaced" + ] + }, + "UpDownUntagged_conflicting": { + "type": "object", + "properties": { + "kind": { + "const": "conflicting" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "kept": { + "$ref": "#/components/schemas/NodeDescription" + }, + "replaced": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "kept", + "replaced" + ] + }, + "UpDown_instructed": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "instructed" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "instruction": { + "$ref": "#/components/schemas/Instruction" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "instruction" + ] + }, + "UpDownUntagged_instructed": { + "type": "object", + "properties": { + "kind": { + "const": "instructed" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "instruction": { + "$ref": "#/components/schemas/Instruction" + } + }, + "required": [ + "kind", + "ref", + "node", + "instruction" + ] + }, + "UpDown_dropped-instructions": { + "type": "object", + "properties": { + "stream": { + "const": "updown" + }, + "kind": { + "const": "dropped-instructions" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "dropped": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "dropped" + ] + }, + "UpDownUntagged_dropped-instructions": { + "type": "object", + "properties": { + "kind": { + "const": "dropped-instructions" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "dropped": { + "type": "integer" + } + }, + "required": [ + "kind", + "ref", + "node", + "dropped" + ] + }, + "Upkeep_acted": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "acted" + }, + "report": { + "$ref": "#/components/schemas/UpDownReportUntagged" + } + }, + "required": [ + "stream", + "kind", + "report" + ] + }, + "UpkeepUntagged_acted": { + "type": "object", + "properties": { + "kind": { + "const": "acted" + }, + "report": { + "$ref": "#/components/schemas/UpDownReportUntagged" + } + }, + "required": [ + "kind", + "report" + ] + }, + "Upkeep_upkeep": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "upkeep" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "state": { + "type": "string", + "enum": [ + "wait-up", + "upping", + "up" + ] + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "state" + ] + }, + "UpkeepUntagged_upkeep": { + "type": "object", + "properties": { + "kind": { + "const": "upkeep" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "state": { + "type": "string", + "enum": [ + "wait-up", + "upping", + "up" + ] + } + }, + "required": [ + "kind", + "ref", + "node", + "state" + ] + }, + "Upkeep_downkeep": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "downkeep" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "state": { + "type": "string", + "enum": [ + "wait-down", + "downing", + "down" + ] + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "state" + ] + }, + "UpkeepUntagged_downkeep": { + "type": "object", + "properties": { + "kind": { + "const": "downkeep" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "state": { + "type": "string", + "enum": [ + "wait-down", + "downing", + "down" + ] + } + }, + "required": [ + "kind", + "ref", + "node", + "state" + ] + }, + "Upkeep_next-look": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "next-look" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "check": { + "$ref": "#/components/schemas/CheckResult" + }, + "delay_us": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "check", + "delay_us" + ] + }, + "UpkeepUntagged_next-look": { + "type": "object", + "properties": { + "kind": { + "const": "next-look" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "check": { + "$ref": "#/components/schemas/CheckResult" + }, + "delay_us": { + "type": "integer" + } + }, + "required": [ + "kind", + "ref", + "node", + "check", + "delay_us" + ] + }, + "Upkeep_wedged": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "wedged" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "silent_us": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "silent_us" + ] + }, + "UpkeepUntagged_wedged": { + "type": "object", + "properties": { + "kind": { + "const": "wedged" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "silent_us": { + "type": "integer" + } + }, + "required": [ + "kind", + "ref", + "node", + "silent_us" + ] + }, + "Upkeep_unwedged": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "unwedged" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_unwedged": { + "type": "object", + "properties": { + "kind": { + "const": "unwedged" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_output": { + "type": "object", + "properties": { + "stream": { + "const": "output" + }, + "kind": { + "const": "output" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "line": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "line" + ], + "description": "One line a held (`managed`) action wrote; filed on its own `output` stream so `?stream=output` is a live tail." + }, + "UpkeepUntagged_output": { + "type": "object", + "properties": { + "kind": { + "const": "output" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "line": { + "type": "string" + } + }, + "required": [ + "kind", + "ref", + "node", + "line" + ] + }, + "Upkeep_demoted": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "demoted" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "dependency": { + "$ref": "#/components/schemas/Ref" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "dependency" + ] + }, + "UpkeepUntagged_demoted": { + "type": "object", + "properties": { + "kind": { + "const": "demoted" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "dependency": { + "$ref": "#/components/schemas/Ref" + } + }, + "required": [ + "kind", + "ref", + "node", + "dependency" + ] + }, + "Upkeep_parked": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "parked" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_parked": { + "type": "object", + "properties": { + "kind": { + "const": "parked" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_reapplying": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "reapplying" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "delay_us": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "delay_us" + ] + }, + "UpkeepUntagged_reapplying": { + "type": "object", + "properties": { + "kind": { + "const": "reapplying" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "delay_us": { + "type": "integer" + } + }, + "required": [ + "kind", + "ref", + "node", + "delay_us" + ] + }, + "Upkeep_paused": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "paused" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_paused": { + "type": "object", + "properties": { + "kind": { + "const": "paused" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_resumed": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "resumed" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_resumed": { + "type": "object", + "properties": { + "kind": { + "const": "resumed" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_gave-up": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "gave-up" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "failures": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "failures" + ] + }, + "UpkeepUntagged_gave-up": { + "type": "object", + "properties": { + "kind": { + "const": "gave-up" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "failures": { + "type": "integer" + } + }, + "required": [ + "kind", + "ref", + "node", + "failures" + ] + }, + "Upkeep_adopted": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "adopted" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_adopted": { + "type": "object", + "properties": { + "kind": { + "const": "adopted" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_released": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "released" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_released": { + "type": "object", + "properties": { + "kind": { + "const": "released" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_policy": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "policy" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "supervision": { + "$ref": "#/components/schemas/Supervision" + }, + "ignored": { + "type": "array", + "items": { + "$ref": "#/components/schemas/Supervision" + } + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "supervision", + "ignored" + ] + }, + "UpkeepUntagged_policy": { + "type": "object", + "properties": { + "kind": { + "const": "policy" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "supervision": { + "$ref": "#/components/schemas/Supervision" + }, + "ignored": { + "type": "array", + "items": { + "$ref": "#/components/schemas/Supervision" + } + } + }, + "required": [ + "kind", + "ref", + "node", + "supervision", + "ignored" + ] + }, + "Upkeep_untended": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "untended" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node" + ] + }, + "UpkeepUntagged_untended": { + "type": "object", + "properties": { + "kind": { + "const": "untended" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + } + }, + "required": [ + "kind", + "ref", + "node" + ] + }, + "Upkeep_escaped": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "escaped" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "ref", + "node", + "error" + ] + }, + "UpkeepUntagged_escaped": { + "type": "object", + "properties": { + "kind": { + "const": "escaped" + }, + "ref": { + "$ref": "#/components/schemas/Ref" + }, + "node": { + "$ref": "#/components/schemas/NodeDescription" + }, + "error": { + "type": "string" + } + }, + "required": [ + "kind", + "ref", + "node", + "error" + ] + }, + "Upkeep_supervising": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "supervising" + }, + "up": { + "type": "integer" + }, + "down": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "up", + "down" + ] + }, + "UpkeepUntagged_supervising": { + "type": "object", + "properties": { + "kind": { + "const": "supervising" + }, + "up": { + "type": "integer" + }, + "down": { + "type": "integer" + } + }, + "required": [ + "kind", + "up", + "down" + ] + }, + "Upkeep_retired": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "retired" + }, + "machines": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "machines" + ] + }, + "UpkeepUntagged_retired": { + "type": "object", + "properties": { + "kind": { + "const": "retired" + }, + "machines": { + "type": "integer" + } + }, + "required": [ + "kind", + "machines" + ] + }, + "Upkeep_holding": { + "type": "object", + "properties": { + "stream": { + "const": "upkeep" + }, + "kind": { + "const": "holding" + }, + "machines": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "machines" + ] + }, + "UpkeepUntagged_holding": { + "type": "object", + "properties": { + "kind": { + "const": "holding" + }, + "machines": { + "type": "integer" + } + }, + "required": [ + "kind", + "machines" + ] + }, + "Serve_started": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "started" + } + }, + "required": [ + "stream", + "kind" + ] + }, + "Serve_stopped": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "stopped" + } + }, + "required": [ + "stream", + "kind" + ] + }, + "Serve_hung-up": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "hung-up" + }, + "from": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "from" + ] + }, + "Serve_bad-command": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "bad-command" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "error" + ] + }, + "Serve_bad-seed": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "bad-seed" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "error" + ] + }, + "Serve_bad-directive": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "bad-directive" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "error" + ] + }, + "Serve_bad-load": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "bad-load" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "error" + ] + }, + "Serve_loading": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "loading" + }, + "path": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "path" + ] + }, + "Serve_load-done": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "load-done" + }, + "path": { + "type": "string" + }, + "lines": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "path", + "lines" + ] + }, + "Serve_declared": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "declared" + }, + "epoch": { + "type": "integer" + }, + "direction": { + "$ref": "#/components/schemas/Direction" + }, + "nodes": { + "type": "integer" + }, + "active_seeds": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "epoch", + "direction", + "nodes", + "active_seeds" + ] + }, + "Serve_cleared": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "cleared" + }, + "retired": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "retired" + ] + }, + "Serve_supervised": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "supervised" + }, + "on": { + "type": "boolean" + } + }, + "required": [ + "stream", + "kind", + "on" + ] + }, + "Serve_auto-converged": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "auto-converged" + }, + "on": { + "type": "boolean" + } + }, + "required": [ + "stream", + "kind", + "on" + ] + }, + "Serve_instructed": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "instructed" + }, + "instruction": { + "$ref": "#/components/schemas/Instruction" + }, + "nodes": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "instruction", + "nodes" + ] + }, + "Serve_fetch-requested": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "fetch-requested" + }, + "following": { + "type": "boolean" + } + }, + "required": [ + "stream", + "kind", + "following" + ] + }, + "Serve_tended": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "tended" + }, + "report": { + "$ref": "#/components/schemas/UpkeepReportUntagged" + } + }, + "required": [ + "stream", + "kind", + "report" + ] + }, + "Serve_converge-start": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "converge-start" + }, + "down": { + "type": "integer" + }, + "up": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "down", + "up" + ] + }, + "Serve_converge-stop": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "converge-stop" + }, + "ok": { + "type": "boolean" + }, + "remaining": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "ok", + "remaining" + ] + }, + "Serve_status": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "status" + }, + "mode": { + "$ref": "#/components/schemas/Mode" + }, + "nodes": { + "type": "array", + "items": { + "$ref": "#/components/schemas/NodeState" + } + } + }, + "required": [ + "stream", + "kind", + "mode", + "nodes" + ] + }, + "Serve_history": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "history" + }, + "seeds": { + "type": "array", + "items": { + "$ref": "#/components/schemas/HistoryEntry" + } + } + }, + "required": [ + "stream", + "kind", + "seeds" + ] + }, + "Serve_history-elided": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "history-elided" + }, + "elided": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "elided" + ] + }, + "Serve_query": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "query" + }, + "nodes": { + "type": "array", + "items": { + "$ref": "#/components/schemas/NodeState" + } + } + }, + "required": [ + "stream", + "kind", + "nodes" + ] + }, + "Serve_help": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "help" + }, + "topic": { + "oneOf": [ + { + "type": "string" + }, + { + "type": "null" + } + ] + }, + "lines": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "stream", + "kind", + "topic", + "lines" + ] + }, + "Serve_sink-failed": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "sink-failed" + }, + "path": { + "type": "string" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "path", + "error" + ] + }, + "Follow_following": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "following" + }, + "registry": { + "type": "string" + }, + "labels": { + "type": "array", + "items": { + "type": "string" + } + }, + "schedule": { + "type": "object", + "properties": { + "base_us": { + "type": "integer" + }, + "factor": { + "type": "number" + }, + "cap_us": { + "type": "integer" + }, + "jitter": { + "type": "number" + }, + "debounce_us": { + "type": "integer" + }, + "max_wait_us": { + "type": "integer" + } + }, + "required": [ + "base_us", + "factor", + "cap_us", + "jitter", + "debounce_us", + "max_wait_us" + ] + } + }, + "required": [ + "stream", + "kind", + "registry", + "labels", + "schedule" + ] + }, + "Follow_injected": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "injected" + }, + "label": { + "type": "string" + }, + "document": { + "type": "string" + }, + "sha256": { + "type": "string" + }, + "up": { + "type": "integer" + }, + "down": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "label", + "document", + "sha256", + "up", + "down" + ] + }, + "Follow_no-diff": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "no-diff" + }, + "label": { + "type": "string" + }, + "document": { + "type": "string" + }, + "sha256": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "document", + "sha256" + ] + }, + "Follow_deferred": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "deferred" + }, + "label": { + "type": "string" + }, + "document": { + "type": "string" + }, + "sha256": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "document", + "sha256" + ] + }, + "Follow_replayed": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "replayed" + }, + "label": { + "type": "string" + }, + "document": { + "type": "string" + }, + "sha256": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "document", + "sha256" + ] + }, + "Follow_backoff": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "backoff" + }, + "failures": { + "type": "integer" + }, + "next_us": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "failures", + "next_us" + ] + }, + "Follow_missing": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "missing" + }, + "label": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label" + ] + }, + "Follow_vanished": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "vanished" + }, + "label": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label" + ] + }, + "Follow_malformed": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "malformed" + }, + "label": { + "type": "string" + }, + "sha256": { + "type": "string" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "sha256", + "error" + ] + }, + "Follow_fetch-failed": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "fetch-failed" + }, + "label": { + "type": "string" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "error" + ] + }, + "Follow_stale": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "stale" + }, + "label": { + "type": "string" + }, + "document": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "document" + ] + }, + "Follow_bad-cache": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "bad-cache" + }, + "label": { + "type": "string" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "error" + ] + }, + "Follow_rejected": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "rejected" + }, + "label": { + "type": "string" + }, + "sha256": { + "type": "string" + }, + "reason": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "sha256", + "reason" + ] + }, + "Follow_cache-failed": { + "type": "object", + "properties": { + "stream": { + "const": "follow" + }, + "kind": { + "const": "cache-failed" + }, + "label": { + "type": "string" + }, + "error": { + "type": "string" + } + }, + "required": [ + "stream", + "kind", + "label", + "error" + ] + }, + "UpDownReport": { + "oneOf": [ + { + "$ref": "#/components/schemas/UpDown_skip" + }, + { + "$ref": "#/components/schemas/UpDown_eval" + }, + { + "$ref": "#/components/schemas/UpDown_done" + }, + { + "$ref": "#/components/schemas/UpDown_blocked" + }, + { + "$ref": "#/components/schemas/UpDown_failed" + }, + { + "$ref": "#/components/schemas/UpDown_conflicting" + }, + { + "$ref": "#/components/schemas/UpDown_instructed" + }, + { + "$ref": "#/components/schemas/UpDown_dropped-instructions" + } + ], + "description": "`stream` is added when the report travels tagged; nested inside `acted` it is absent." + }, + "UpkeepReport": { + "oneOf": [ + { + "$ref": "#/components/schemas/Upkeep_acted" + }, + { + "$ref": "#/components/schemas/Upkeep_upkeep" + }, + { + "$ref": "#/components/schemas/Upkeep_downkeep" + }, + { + "$ref": "#/components/schemas/Upkeep_next-look" + }, + { + "$ref": "#/components/schemas/Upkeep_wedged" + }, + { + "$ref": "#/components/schemas/Upkeep_unwedged" + }, + { + "$ref": "#/components/schemas/Upkeep_output" + }, + { + "$ref": "#/components/schemas/Upkeep_demoted" + }, + { + "$ref": "#/components/schemas/Upkeep_parked" + }, + { + "$ref": "#/components/schemas/Upkeep_reapplying" + }, + { + "$ref": "#/components/schemas/Upkeep_paused" + }, + { + "$ref": "#/components/schemas/Upkeep_resumed" + }, + { + "$ref": "#/components/schemas/Upkeep_gave-up" + }, + { + "$ref": "#/components/schemas/Upkeep_adopted" + }, + { + "$ref": "#/components/schemas/Upkeep_released" + }, + { + "$ref": "#/components/schemas/Upkeep_policy" + }, + { + "$ref": "#/components/schemas/Upkeep_untended" + }, + { + "$ref": "#/components/schemas/Upkeep_escaped" + }, + { + "$ref": "#/components/schemas/Upkeep_supervising" + }, + { + "$ref": "#/components/schemas/Upkeep_retired" + }, + { + "$ref": "#/components/schemas/Upkeep_holding" + } + ], + "description": "" + }, + "UpDownReportUntagged": { + "oneOf": [ + { + "$ref": "#/components/schemas/UpDownUntagged_skip" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_eval" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_done" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_blocked" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_failed" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_conflicting" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_instructed" + }, + { + "$ref": "#/components/schemas/UpDownUntagged_dropped-instructions" + } + ], + "description": "An UpDown report nested inside another (no `stream`: only the outermost object is tagged)." + }, + "UpkeepReportUntagged": { + "oneOf": [ + { + "$ref": "#/components/schemas/UpkeepUntagged_acted" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_upkeep" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_downkeep" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_next-look" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_wedged" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_unwedged" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_output" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_demoted" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_parked" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_reapplying" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_paused" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_resumed" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_gave-up" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_adopted" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_released" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_policy" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_untended" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_escaped" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_supervising" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_retired" + }, + { + "$ref": "#/components/schemas/UpkeepUntagged_holding" + } + ], + "description": "An Upkeep report nested inside `tended` (no `stream`)." + }, + "ServeReport": { + "oneOf": [ + { + "$ref": "#/components/schemas/Serve_started" + }, + { + "$ref": "#/components/schemas/Serve_stopped" + }, + { + "$ref": "#/components/schemas/Serve_hung-up" + }, + { + "$ref": "#/components/schemas/Serve_bad-command" + }, + { + "$ref": "#/components/schemas/Serve_bad-seed" + }, + { + "$ref": "#/components/schemas/Serve_bad-directive" + }, + { + "$ref": "#/components/schemas/Serve_bad-load" + }, + { + "$ref": "#/components/schemas/Serve_loading" + }, + { + "$ref": "#/components/schemas/Serve_load-done" + }, + { + "$ref": "#/components/schemas/Serve_declared" + }, + { + "$ref": "#/components/schemas/Serve_cleared" + }, + { + "$ref": "#/components/schemas/Serve_supervised" + }, + { + "$ref": "#/components/schemas/Serve_auto-converged" + }, + { + "$ref": "#/components/schemas/Serve_instructed" + }, + { + "$ref": "#/components/schemas/Serve_fetch-requested" + }, + { + "$ref": "#/components/schemas/Serve_tended" + }, + { + "$ref": "#/components/schemas/Serve_converge-start" + }, + { + "$ref": "#/components/schemas/Serve_converge-stop" + }, + { + "$ref": "#/components/schemas/Serve_status" + }, + { + "$ref": "#/components/schemas/Serve_history" + }, + { + "$ref": "#/components/schemas/Serve_history-elided" + }, + { + "$ref": "#/components/schemas/Serve_query" + }, + { + "$ref": "#/components/schemas/Serve_help" + }, + { + "$ref": "#/components/schemas/Serve_sink-failed" + } + ], + "description": "" + }, + "FollowReport": { + "oneOf": [ + { + "$ref": "#/components/schemas/Follow_following" + }, + { + "$ref": "#/components/schemas/Follow_injected" + }, + { + "$ref": "#/components/schemas/Follow_no-diff" + }, + { + "$ref": "#/components/schemas/Follow_deferred" + }, + { + "$ref": "#/components/schemas/Follow_replayed" + }, + { + "$ref": "#/components/schemas/Follow_backoff" + }, + { + "$ref": "#/components/schemas/Follow_missing" + }, + { + "$ref": "#/components/schemas/Follow_vanished" + }, + { + "$ref": "#/components/schemas/Follow_malformed" + }, + { + "$ref": "#/components/schemas/Follow_fetch-failed" + }, + { + "$ref": "#/components/schemas/Follow_stale" + }, + { + "$ref": "#/components/schemas/Follow_bad-cache" + }, + { + "$ref": "#/components/schemas/Follow_rejected" + }, + { + "$ref": "#/components/schemas/Follow_cache-failed" + } + ], + "description": "" + }, + "Report": { + "oneOf": [ + { + "$ref": "#/components/schemas/ServeReport" + }, + { + "$ref": "#/components/schemas/UpDownReport" + }, + { + "$ref": "#/components/schemas/UpkeepReport" + }, + { + "$ref": "#/components/schemas/FollowReport" + } + ], + "description": "One report, tagged by `stream` (who reported: `serve` the loop, `updown` a convergence pass, `upkeep` a tending machine, `follow` the pull-mode fetcher) and `kind` (the constructor, kebab-cased). Exactly what `--json` prints, one object per line. Report text is public and carried verbatim.", + "discriminator": { + "propertyName": "stream" + } + }, + "HistoryEntry": { + "type": "object", + "properties": { + "epoch": { + "type": "integer" + }, + "declaration": { + "type": "string", + "enum": [ + "up", + "only", + "down" + ] + }, + "active": { + "type": "boolean" + }, + "origin": { + "$ref": "#/components/schemas/Origin" + }, + "args": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "epoch", + "declaration", + "active", + "origin", + "args" + ] + }, + "DagResponse": { + "type": "object", + "properties": { + "mode": { + "$ref": "#/components/schemas/Mode" + }, + "nodes": { + "type": "array", + "items": { + "$ref": "#/components/schemas/DagNode" + } + }, + "seq": { + "type": "integer" + } + }, + "required": [ + "mode", + "nodes", + "seq" + ], + "description": "The computed DAG (the structure a pass walks, before any registered rewrite): one object per ref, dependencies first. `seq` is the last event number handed out, read before the world, so `GET /events?since=` replays anything that landed in between." + }, + "StatusResponse": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "status" + }, + "mode": { + "$ref": "#/components/schemas/Mode" + }, + "nodes": { + "type": "array", + "items": { + "$ref": "#/components/schemas/NodeState" + } + }, + "seq": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "mode", + "nodes", + "seq" + ], + "description": "What `status --json` prints, plus `seq` (see DagResponse)." + }, + "HistoryResponse": { + "type": "object", + "properties": { + "stream": { + "const": "serve" + }, + "kind": { + "const": "history" + }, + "seeds": { + "type": "array", + "items": { + "$ref": "#/components/schemas/HistoryEntry" + } + }, + "elided": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "seeds", + "elided" + ], + "description": "What `history --json` prints, with the elided count folded in as a field." + }, + "HelpResponse": { + "type": "object", + "properties": { + "seed": { + "type": "string" + }, + "commands": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "seed", + "commands" + ], + "description": "`seed` is the seed parser's own `--help` text: the grammar of the words after `up`/`only`/`down`, which is binary-specific. `commands` is the input language's reference." + }, + "CommandBody": { + "oneOf": [ + { + "type": "object", + "properties": { + "line": { + "type": "string" + } + }, + "required": [ + "line" + ] + }, + { + "type": "object", + "properties": { + "verb": { + "type": "string" + }, + "seed": { + "type": "array", + "items": { + "type": "string" + } + } + }, + "required": [ + "verb" + ] + } + ], + "description": "One line of the input language, or a verb and its seed words rendered to the very line the first form would have carried. A newline anywhere is refused: one command per request." + }, + "AsyncAnswer": { + "type": "object", + "properties": { + "seq": { + "type": "integer" + }, + "origin": { + "type": "string" + } + }, + "required": [ + "seq", + "origin" + ], + "description": "`seq` is the number of the `enqueued` event for the command; its reports are the events numbered above it whose `origin.name` is `origin`." + }, + "EnqueuedEvent": { + "type": "object", + "properties": { + "stream": { + "const": "server" + }, + "kind": { + "const": "enqueued" + }, + "line": { + "type": "string" + }, + "seq": { + "type": "integer" + }, + "origin": { + "$ref": "#/components/schemas/Origin" + } + }, + "required": [ + "stream", + "kind", + "line", + "seq", + "origin" + ] + }, + "GapEvent": { + "type": "object", + "properties": { + "stream": { + "const": "server" + }, + "kind": { + "const": "gap" + }, + "from": { + "type": "integer" + } + }, + "required": [ + "stream", + "kind", + "from" + ], + "description": "Sent first, with no `id:`, to a client whose `?since` fell off the ring: `from` is the oldest number the replay starts at." + }, + "EventData": { + "type": "object", + "properties": { + "stream": { + "type": "string", + "enum": [ + "serve", + "updown", + "upkeep", + "output", + "follow", + "server" + ] + }, + "kind": { + "type": "string" + }, + "seq": { + "type": "integer" + }, + "origin": { + "$ref": "#/components/schemas/Origin" + } + }, + "required": [ + "stream", + "kind", + "seq" + ], + "description": "The `data:` of one server-sent event: the Report object of that stream and kind (or EnqueuedEvent) with `seq` added, and `origin` when the event belongs to a command. `seq` is also the SSE `id:`. See Report, EnqueuedEvent and GapEvent for the fields by kind.", + "additionalProperties": true + }, + "SessionAnswer": { + "type": "object", + "properties": { + "session": { + "type": "boolean" + } + }, + "required": [ + "session" + ] + }, + "StatusObject": { + "type": "object", + "properties": { + "kind": { + "const": "status" + }, + "mode": { + "$ref": "#/components/schemas/Mode" + }, + "nodes": { + "type": "array", + "items": { + "$ref": "#/components/schemas/NodeState" + } + } + }, + "required": [ + "kind", + "mode", + "nodes" + ], + "description": "`status --json` as the sink embeds it: the same object without the `stream` tag." + }, + "StatusDocument": { + "type": "object", + "properties": { + "salmon-status": { + "const": 1 + }, + "host": { + "type": "string" + }, + "written": { + "type": "string", + "format": "date-time" + }, + "mode": { + "$ref": "#/components/schemas/Mode" + }, + "labels": { + "type": "array", + "items": { + "type": "object", + "properties": { + "label": { + "type": "string" + }, + "id": { + "type": "string" + }, + "sha256": { + "type": "string" + }, + "applied": { + "type": "string", + "format": "date-time" + } + }, + "required": [ + "label", + "id", + "sha256", + "applied" + ] + } + }, + "status": { + "$ref": "#/components/schemas/StatusObject" + }, + "last": { + "type": "object", + "properties": { + "converge": { + "oneOf": [ + { + "$ref": "#/components/schemas/Report" + }, + { + "type": "null" + } + ] + }, + "follow": { + "oneOf": [ + { + "$ref": "#/components/schemas/Report" + }, + { + "type": "null" + } + ] + } + }, + "required": [ + "converge", + "follow" + ] + } + }, + "required": [ + "salmon-status", + "host", + "written", + "mode", + "labels", + "status", + "last" + ], + "description": "The document `run serve --status-sink` writes (to a file, or POSTed to a URL). Not served over HTTP by the loop; described here because it embeds `status` and two Reports and is read by other tools (`salmon-fleet status`)." + } + } + } +} diff --git a/salmon-ops.cabal b/salmon-ops.cabal new file mode 100644 --- /dev/null +++ b/salmon-ops.cabal @@ -0,0 +1,235 @@ +cabal-version: 2.4 +name: salmon-ops +version: 0.1.0.0 +synopsis: IO builtins and command line plumbing for Salmon operations. +description: Builtin operations (files, systemd, debian packages, podman, postgres, wireguard, certificates, ssh, ...) built on salmon-core, plus the shared command line, the long-running serve loop with its HTTP API and web UI. +homepage: https://lucasdicioccio.github.io/salmon/ +bug-reports: https://github.com/lucasdicioccio/salmon/issues +license: BSD-3-Clause +license-file: LICENSE +author: Lucas DiCioccio +maintainer: lucas@dicioccio.fr +copyright: 2022-2026 Lucas DiCioccio +category: Development +build-type: Simple +tested-with: GHC == 9.10.3 +extra-doc-files: CHANGELOG.md +extra-source-files: + ui/index.html + ui/ui.js + ui/ui.css + ui/auth.html + openapi/serve-api.openapi.json + +source-repository head + type: git + location: https://github.com/lucasdicioccio/salmon + subdir: salmon-ops + +library + exposed-modules: Salmon.Actions.Concurrent + , Salmon.Actions.Follow + , Salmon.Actions.Follow.Registry + , Salmon.Actions.Follow.Registry.Dns + , Salmon.Actions.Follow.Registry.Git + , Salmon.Actions.Follow.Registry.Http + , Salmon.Actions.Follow.Scheduler + , Salmon.Actions.Follow.Signature + , Salmon.Actions.Help + , Salmon.Actions.Serve + , Salmon.Actions.Serve.Events + , Salmon.Actions.Serve.Http + , Salmon.Actions.Serve.Socket + , Salmon.Actions.Serve.StatusSink + , Salmon.Actions.Fleet + , Salmon.Actions.UpDown + , Salmon.Actions.Upkeep + , Salmon.Actions.Dot + , Salmon.Actions.Query + , Salmon.Client.Http + , Salmon.Client.Model + , Salmon.Builtin.Extension + , Salmon.Builtin.CommandLine + , Salmon.Builtin.Helpers + , Salmon.Builtin.Migrations + , Salmon.Builtin.Nodes.Bash + , Salmon.Builtin.Nodes.Binary + , Salmon.Builtin.Nodes.Cabal + , Salmon.Builtin.Nodes.Daemon + , Salmon.Builtin.Nodes.Capabilities + , Salmon.Builtin.Nodes.Certificates + , Salmon.Builtin.Nodes.Continuation + , Salmon.Builtin.Nodes.CronTask + , Salmon.Builtin.Nodes.Debian.Debootstrap + , Salmon.Builtin.Nodes.Debian.AptRepository + , Salmon.Builtin.Nodes.Debian.Package + , Salmon.Builtin.Nodes.Debian.OS + , Salmon.Builtin.Nodes.Demo + , Salmon.Builtin.Nodes.Gcp.ArtifactRegistry + , Salmon.Builtin.Nodes.Gcp.Billing + , Salmon.Builtin.Nodes.Gcp.CloudRun + , Salmon.Builtin.Nodes.Gcp.Compute + , Salmon.Builtin.Nodes.Gcp.Core + , Salmon.Builtin.Nodes.Gcp.Iam + , Salmon.Builtin.Nodes.Gcp.LoadBalancing + , Salmon.Builtin.Nodes.Gcp.Monitoring + , Salmon.Builtin.Nodes.Gcp.ResourceManager + , Salmon.Builtin.Nodes.Gcp.SecretManager + , Salmon.Builtin.Nodes.Gcp.ServiceUsage + , Salmon.Builtin.Nodes.Gcp.SshAccess + , Salmon.Builtin.Nodes.Gcp.Storage + , Salmon.Builtin.Nodes.Filesystem + , Salmon.Builtin.Nodes.Git + , Salmon.Builtin.Nodes.User + , Salmon.Builtin.Nodes.Keys + , Salmon.Builtin.Nodes.LinuxBridge + , Salmon.Builtin.Nodes.Netfilter + , Salmon.Builtin.Nodes.Nginx + , Salmon.Builtin.Nodes.Npm + , Salmon.Builtin.Nodes.PgBouncer + , Salmon.Builtin.Nodes.Etcd + , Salmon.Builtin.Nodes.Postgres + , Salmon.Builtin.Nodes.LlamaServer + , Salmon.Builtin.Nodes.PgVector + , Salmon.Builtin.Nodes.Plakar + , Salmon.Builtin.Nodes.Podman + , Salmon.Builtin.Nodes.Qemu + , Salmon.Builtin.Nodes.Rsync + , Salmon.Builtin.Nodes.Routes + , Salmon.Builtin.Nodes.Self + , Salmon.Builtin.Nodes.Secrets + , Salmon.Builtin.Nodes.Spago + , Salmon.Builtin.Nodes.Ssh + , Salmon.Builtin.Nodes.Sysctl + , Salmon.Builtin.Nodes.Systemd + , Salmon.Builtin.Nodes.Tar + , Salmon.Builtin.Nodes.Upx + , Salmon.Builtin.Nodes.Web + , Salmon.Builtin.Nodes.WireGuard + , Salmon.Op.Concurrency + , Salmon.Op.Dag + , Salmon.Op.Ledger + , Salmon.Op.Mailbox + , Salmon.Op.Rewrite + , Salmon.Op.Status + , Salmon.Op.Supervision + , Salmon.Op.Window + , Salmon.Op.Configure + , Salmon.Op.Ref + , Salmon.Reporter + , Salmon.Reporter.Tagged + build-depends: base >=4.16.3.0 && <4.22 + , async + , aeson + , base64-bytestring + , bytestring + , containers + , contravariant + , crypton + , crypton-connection + , crypton-x509-store + , cryptohash-sha256 + , directory + , file-embed + , filepath + , free + , hashable + , http-client + , http-client-tls + , http-types + , jose + , mtl + , network + , optparse-applicative + , optparse-generic + , process + , process-extras + , salmon-core ^>=0.1.0.0 + , stm + , text + , time + , unix + , wai + , warp + , tls + , warp-tls + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: KindSignatures + , DataKinds + , OverloadedStrings + , DeriveFunctor + , OverloadedRecordDot + , TypeApplications + , ScopedTypeVariables + +executable salmon-ops-dot-fixture + main-is: DotFixture.hs + hs-source-dirs: fixtures + build-depends: base >=4.16.3.0 && <4.22 + , mtl + , salmon-core ^>=0.1.0.0 + , salmon-ops ^>=0.1.0.0 + , text + -- every salmon binary can end up running the concurrent driver (`run + -- serve` does), and a node's own thread must not block the whole runtime. + ghc-options: -threaded + default-language: Haskell2010 + default-extensions: OverloadedStrings + , OverloadedRecordDot + , ScopedTypeVariables + +executable salmon-postgres-replication-fixture + main-is: PostgresReplicationFixture.hs + hs-source-dirs: fixtures + build-depends: base >=4.16.3.0 && <4.22 + , mtl + , salmon-core ^>=0.1.0.0 + , salmon-ops ^>=0.1.0.0 + , text + -- every salmon binary can end up running the concurrent driver (`run + -- serve` does), and a node's own thread must not block the whole runtime. + ghc-options: -threaded + default-language: Haskell2010 + default-extensions: OverloadedStrings + , OverloadedRecordDot + , ScopedTypeVariables + +executable salmon-qemu-host-setup-fixture + main-is: QemuHostSetupFixture.hs + hs-source-dirs: fixtures + build-depends: base >=4.16.3.0 && <4.22 + , directory + , mtl + , filepath + , salmon-core ^>=0.1.0.0 + , salmon-ops ^>=0.1.0.0 + , text + -- every salmon binary can end up running the concurrent driver (`run + -- serve` does), and a node's own thread must not block the whole runtime. + ghc-options: -threaded + default-language: Haskell2010 + default-extensions: OverloadedStrings + , OverloadedRecordDot + , ScopedTypeVariables + +executable salmon-ops-serve-fixture + main-is: ServeFixture.hs + hs-source-dirs: fixtures + build-depends: base >=4.16.3.0 && <4.22 + , aeson + , directory + , filepath + , optparse-applicative + , optparse-generic + , process + , salmon-core ^>=0.1.0.0 + , salmon-ops ^>=0.1.0.0 + , text + -- every salmon binary can end up running the concurrent driver (`run + -- serve` does), and a node's own thread must not block the whole runtime. + ghc-options: -threaded + default-language: Haskell2010 + default-extensions: OverloadedStrings + , OverloadedRecordDot + , ScopedTypeVariables diff --git a/src/Salmon/Actions/Concurrent.hs b/src/Salmon/Actions/Concurrent.hs new file mode 100644 --- /dev/null +++ b/src/Salmon/Actions/Concurrent.hs @@ -0,0 +1,317 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | The concurrent driver: one thread per node, ordering by STM rather than +by counters on a traversal's stack. + +Same contract as "Salmon.Actions.UpDown"'s synchronous drivers — same +'UpDown.Report' stream, same @'IO' 'Bool'@, same failure containment — and +the same one pass, one attempt per node. What differs is that independent +subtrees no longer wait for each other, and that each node has state of its +own while it runs, which is what everything after this is built on. + += How ordering works here + +Each node gets a @'TVar' 'Status'@ and a thread. The thread blocks on +'waitStability' over its neighbours in the direction it waits — dependencies +going up, dependants coming down — and 'retry' does the scheduling. No +counters, no ready-queue, no wakeup channel: a node wakes exactly when a +neighbour's state changes and not otherwise. The teardown ordering that +'UpDown.walk' spends a countdown map on is the same code with the two +adjacency directions swapped. + += Failure is still a property of the pass + +'waitStability' reads direction and stability only, so a node that settled +having failed looks exactly like one that settled having succeeded. That is +deliberate — whether to proceed past a failure is the /driver's/ policy, not +the neighbour's property — and this driver answers it the way the synchronous +one does: a node whose neighbour did not succeed reports 'UpDown.Blocked', +settles, and contains the failure to that sub-DAG. A supervisor would answer +it differently (wait, because the neighbour may yet be repaired), which is +why it is not baked into 'Status'. + += Two things concurrency forces that the sequential drivers never had to face + +* __Reports are serialised.__ Every 'runReporter' call goes through one + 'MVar', so a multi-line report cannot interleave with another node's. The + reporter belongs to the caller and cannot be assumed thread-safe. +* __A cycle has to be found before the walk, not after.__ The sequential + drivers discover unreachable nodes by finishing and noticing what they + never touched. A thread waiting on a node in a cycle simply never wakes, so + 'Dag.stuck' is consulted up front and those nodes are reported 'Blocked' + without being spawned. + += Instructions + +A node consults its mailbox once, immediately before deciding what to do — +which is all a single-pass driver can honour. 'Force' makes it act regardless +of what 'check' or the 'UpDown.Gate' says; 'Satisfy' makes it treat the node +as already done. The last of those two in the mailbox wins, since a later +instruction supersedes an earlier statement of intent. 'Recheck', 'Pause' and +'Resume' are meaningful only to a driver that tends a node continuously; here +they are read, reported and otherwise ignored. + += Bounding width + +Ordering is unbounded by design (an edge or a collection is the only thing +that ever serialises two nodes here — see "Salmon.Op.Concurrency"'s header +for why that is deliberate and what it does not cover). Both drivers below +take an optional 'ConcurrencyLimit' that bounds something orthogonal to +ordering: how many nodes may be inside their own 'check'\/'up'\/'down' at +once, across the whole pass. 'Nothing' reproduces this module's behaviour +before the limit existed. +-} +module Salmon.Actions.Concurrent ( + upDagConcurrent, + downDagConcurrent, + noMailboxes, +) where + +import Control.Concurrent.Async (forConcurrently_) +import Control.Concurrent.MVar (newMVar, withMVar) +import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVar, readTVarIO) +import Control.Exception (SomeException, try) +import Control.Monad (forM_, unless) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Set (Set) +import qualified Data.Set as Set +import qualified Data.Text as Text +import GHC.Records (HasField) + +import Salmon.Actions.UpDown (CheckResult (..), Gate, Report (..), Requirement (..), requirement, runCheck) +import Salmon.Op.Actions (Act (..)) +import Salmon.Op.Concurrency (ConcurrencyLimit, withConcurrencyLimit) +import Salmon.Op.Dag (Dag) +import qualified Salmon.Op.Dag as Dag +import Salmon.Op.Mailbox (Instruction (..), Mailbox) +import qualified Salmon.Op.Mailbox as Mailbox +import Salmon.Op.Ref (Ref) +import Salmon.Op.Status (Direction (..), Stability (..), Status (..), newStatus, note, waitStability) +import Salmon.Reporter + +-- | No node can be instructed: what a driver with no control plane in front +-- of it passes. +noMailboxes :: Map Ref Mailbox +noMailboxes = Map.empty + +{- | 'Salmon.Actions.UpDown.upDag', concurrently. Every node runs as soon as +the nodes it depends on have settled, rather than as soon as the traversal +gets to it. +-} +upDagConcurrent :: + forall ext. + ( HasField "up" ext (IO ()) + , HasField "check" ext (IO CheckResult) + , HasField "ref" ext Ref + ) => + Gate ext -> + Reporter (Report ext) -> + Map Ref Mailbox -> + -- | caps how many nodes are inside 'check'\/'up' at once across this + -- pass; 'Nothing' is unbounded. See "Salmon.Op.Concurrency". + Maybe ConcurrencyLimit -> + Dag ext -> + IO Bool +upDagConcurrent gate r boxes limit dag = + walkConcurrent TurnUp r boxes limit dag Dag.dependenciesOf apply + where + apply :: Say ext -> TVar Status -> Act ext -> [Instruction] -> IO CheckResult + apply say status act instructions = do + wanted <- decide + case wanted of + Skippable -> do + say (Skip act) + pure Skipped + Required -> do + say (Eval act) + note status "eval" + result <- try @SomeException act.extension.up + case result of + Left e -> do + say (Failed act e) + note status (Text.pack (show e)) + pure (Failure (Text.pack (show e))) + Right () -> do + say (Done act) + note status "done" + pure Success + where + decide = + case override instructions of + Just Force -> pure Required + Just Satisfy -> pure Skippable + _ -> do + asked <- gate act + case asked of + Skippable -> pure Skippable + Required -> requirement <$> runCheck act + +{- | 'Salmon.Actions.UpDown.downDag', concurrently. A node comes down as soon +as everything standing on it has, which is the same STM wait with the two +adjacency directions swapped. + +A node's own 'Salmon.Builtin.Extension.check' is not consulted, as in the +sequential teardown: it answers "does my effect still need creating", which +is not the question. 'Force' and 'Satisfy' still apply, since they are +statements about whether to act at all. +-} +downDagConcurrent :: + forall ext. + ( HasField "down" ext (IO ()) + , HasField "ref" ext Ref + ) => + Gate ext -> + Reporter (Report ext) -> + Map Ref Mailbox -> + -- | caps how many nodes are inside 'down' at once across this pass; + -- 'Nothing' is unbounded. See "Salmon.Op.Concurrency". + Maybe ConcurrencyLimit -> + Dag ext -> + IO Bool +downDagConcurrent gate r boxes limit dag = + walkConcurrent TurnDown r boxes limit dag Dag.dependantsOf apply + where + apply :: Say ext -> TVar Status -> Act ext -> [Instruction] -> IO CheckResult + apply say status act instructions = do + wanted <- decide + case wanted of + Skippable -> do + say (Skip act) + pure Skipped + Required -> do + say (Eval act) + note status "eval" + result <- try @SomeException act.extension.down + case result of + Left e -> do + say (Failed act e) + note status (Text.pack (show e)) + pure (Failure (Text.pack (show e))) + Right () -> do + say (Done act) + note status "done" + pure Success + where + decide = + case override instructions of + Just Force -> pure Required + Just Satisfy -> pure Skippable + _ -> gate act + +------------------------------------------------------------------------------- + +-- | A serialised 'runReporter': see the module header on why. +type Say ext = Report ext -> IO () + +-- | The last 'Force' or 'Satisfy' in the mailbox, if either is there. Later +-- supersedes earlier: these are statements of current intent. +override :: [Instruction] -> Maybe Instruction +override = go Nothing + where + go acc [] = acc + go acc (i : is) + | i `elem` [Force, Satisfy] = go (Just i) is + | otherwise = go acc is + +{- | The ordering, containment and completeness machinery both concurrent +drivers share, parameterised by which adjacency direction a node waits on. + +@apply@ returns what the node has to say about itself afterwards, in the +vocabulary of the direction it is going: 'Success' means the node reached the +state this pass wanted (the effect is up, or the effect is gone), 'Failure' +that it did not, 'Skipped' that nobody asked it to try. +-} +walkConcurrent :: + forall ext. + (HasField "ref" ext Ref) => + Direction -> + Reporter (Report ext) -> + Map Ref Mailbox -> + Maybe ConcurrencyLimit -> + Dag ext -> + (Dag ext -> Ref -> [Ref]) -> + (Say ext -> TVar Status -> Act ext -> [Instruction] -> IO CheckResult) -> + IO Bool +walkConcurrent dir r boxes limit dag waitsOn apply = do + let order = Dag.dagOrder dag + let stuckRefs = Dag.stuck waitsOn dag + + statuses <- Map.fromList <$> traverse (\aref -> (,) aref <$> newStatus dir) order + -- nodes that did not reach what this pass wanted. Read by a node's + -- neighbours once they have settled, which is why it is a TVar and not + -- an IORef. + failedVar <- newTVarIO (Set.empty :: Set Ref) + + reportLock <- newMVar () + let say :: Say ext + say rep = withMVar reportLock (\() -> runReporter r rep) + + -- A node on a cycle never becomes ready, so it is never spawned; nothing + -- live waits on it, since everything that does is on or behind the same + -- cycle and therefore also here. + forM_ [aref | aref <- order, Set.member aref stuckRefs] $ \aref -> do + forM_ (Dag.representativeOf dag aref) $ \act -> say (Blocked act) + atomically (modifyTVar' failedVar (Set.insert aref)) + + forConcurrently_ [aref | aref <- order, Set.notMember aref stuckRefs] $ \aref -> + forM_ (Dag.representativeOf dag aref) $ \act -> do + let status = statuses Map.! aref + let neighbours = waitsOn dag aref + atomically (waitStability dir Stable [statuses Map.! n | n <- neighbours]) + blocked <- anyFailed failedVar neighbours + outcome <- + if blocked + then do + say (Blocked act) + note status "blocked" + pure (Failure "a neighbour did not settle as wanted") + else do + instructions <- takeInstructions say act aref + -- a node's own thread throwing would leave its + -- neighbours waiting forever, so nothing is allowed + -- to escape here even though `apply` catches already. + -- the slot is held only around this call: every + -- neighbour this node waited on above has already + -- released its own by the time `waitStability` + -- returns, so this can never wait on a slot held by + -- something in turn waiting on this node. + escaped <- try @SomeException (withConcurrencyLimit limit (apply say status act instructions)) + case escaped of + Right result -> pure result + Left e -> do + say (Failed act e) + pure (Failure (Text.pack (show e))) + -- recording the outcome and settling has to be one transaction: + -- a neighbour that saw `Stable` before the failure was recorded + -- would proceed against a node that had in fact failed. + atomically $ do + unless (succeeded outcome) $ modifyTVar' failedVar (Set.insert aref) + modifyTVar' status $ \st -> + st{statusStability = Stable, statusCheck = outcome} + + failed <- readTVarIO failedVar + pure (Set.null failed) + where + succeeded :: CheckResult -> Bool + succeeded (Failure _) = False + succeeded Unknown = False + succeeded _ = True + + anyFailed :: TVar (Set Ref) -> [Ref] -> IO Bool + anyFailed var neighbours = atomically $ do + f <- readTVar var + pure (any (`Set.member` f) neighbours) + + takeInstructions :: Say ext -> Act ext -> Ref -> IO [Instruction] + takeInstructions say act aref = + case Map.lookup aref boxes of + Nothing -> pure [] + Just box -> do + before <- Mailbox.dropped box + instructions <- atomically (Mailbox.takeAll box) + unless (before == 0) $ say (DroppedInstructions act before) + forM_ instructions $ \i -> say (Instructed act i) + pure instructions diff --git a/src/Salmon/Actions/Dot.hs b/src/Salmon/Actions/Dot.hs new file mode 100644 --- /dev/null +++ b/src/Salmon/Actions/Dot.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Salmon.Actions.Dot ( + printDigraph, + printCograph, + printDagCograph, + PlaceHolder (..), + OpaqueNode (..), + DotGraphExt, +) where + +import Control.Comonad.Cofree (Cofree (..)) +import Data.Foldable (toList, traverse_) +import GHC.Records + +import Data.Dynamic (Dynamic, fromDynamic) +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.IO as Text + +import Salmon.FoldBranch +import Salmon.Op.Actions +import Salmon.Op.Dag (Dag) +import qualified Salmon.Op.Dag as Dag +import Salmon.Op.Eval +import Salmon.Op.Graph +import Salmon.Op.GraphFold (Branch (..), Shape (..), foldWithContext) +import Salmon.Op.OpGraph +import Salmon.Op.Ref + +type Node ext = Maybe (Ref, ShortHand, ext) + +type RawEdge = (Ref, Ref) + +data Edge = Edge {connection :: ConnectType, rawEdge :: RawEdge} +data PrevConnectType = CL | CR | OV +data CurConnectType = V | O | C +type ConnectType = (PrevConnectType, CurConnectType) + +-- | Slightly over-constrained constraint for graph extentions we want to represent. +type DotGraphExt ext = (HasField "dynamics" ext [Dynamic], HasField "ref" ext Ref) + +data PlaceHolder = PlaceHolder Text + +data OpaqueNode = OpaqueNode Text + +hasPlaceholder :: + (DotGraphExt ext) => + ext -> + Bool +hasPlaceholder e = + not $ null $ Maybe.catMaybes $ map (fromDynamic @PlaceHolder) e.dynamics + +hasOpaqueNode :: + (DotGraphExt ext) => + ext -> + Bool +hasOpaqueNode e = + not $ null $ Maybe.catMaybes $ map (fromDynamic @OpaqueNode) e.dynamics + +dotNode :: (DotGraphExt ext) => Node ext -> Text +dotNode Nothing = "" +dotNode (Just (ref, name, ext)) + | hasOpaqueNode ext = mconcat [unRef ref, "[color=darkgreen;shape=egg;label=\"", dotEscape name, "\"];"] + | hasPlaceholder ext = mconcat [unRef ref, "[color=grey;label=\"", dotEscape name, "\"];"] + | otherwise = mconcat [unRef ref, "[label=\"", dotEscape name, "\"];"] + +dotEdge :: Edge -> Text +dotEdge e = + let (ref1, ref2) = e.rawEdge + in case e.connection of + (OV, _) -> mconcat [unRef ref1, "->", unRef ref2] + (CL, _) -> mconcat [unRef ref1, "->", unRef ref2, "[color=red]"] + (CR, C) -> mconcat [unRef ref1, "->", unRef ref2, "[color=orange]"] + (CR, O) -> mconcat [unRef ref1, "->", unRef ref2, "[color=gray]"] + (CR, V) -> mconcat [unRef ref1, "->", unRef ref2] + +dotEscape :: Text -> Text +dotEscape = id + +sameNode :: Node a -> Node a -> Bool +sameNode n1 n2 = Maybe.fromMaybe False $ do + (l, _, _) <- n1 + (r, _, _) <- n2 + pure $ l == r + +sameEdge :: Edge -> Edge -> Bool +sameEdge e1 e2 = e1.rawEdge == e2.rawEdge + +------------------------------------------------------------------------------- + +evalEdges :: + forall m ext. + (DotGraphExt ext) => + Cofree Graph (OpGraph m (Actions ext)) -> + [Edge] +evalEdges = foldWithContext Nothing onNode nextCtx . fmap node + where + onNode :: Maybe (PrevConnectType, ext) -> Shape -> Actions ext -> [Edge] + onNode prev shape a = + [Edge (ct, curOf shape) (l.ref, r.ref) | r <- toList a, (ct, l) <- toList prev] + + curOf :: Shape -> CurConnectType + curOf SVertices = V + curOf SOverlay = O + curOf SConnect = C + + nextCtx :: Maybe (PrevConnectType, ext) -> Branch -> Actions ext -> Maybe (PrevConnectType, ext) + nextCtx prev branch a = case a of + Actionless -> prev + Actions (Act _ ext) -> Just (branchToPrevCT branch, ext) + + branchToPrevCT :: Branch -> PrevConnectType + branchToPrevCT FromVertices = OV + branchToPrevCT FromOverlayL = OV + branchToPrevCT FromOverlayR = OV + branchToPrevCT FromConnectL = CL + branchToPrevCT FromConnectR = CR + +------------------------------------------------------------------------------- + +evalNodes :: + (DotGraphExt ext) => + Cofree Graph (OpGraph m (Actions ext)) -> + Cofree Graph (Node ext) +evalNodes = fmap (\x -> mkNode x.node) + +mkNode :: + (DotGraphExt ext) => + Actions ext -> + Node ext +mkNode x = + case x of + Actionless -> + Nothing + (Actions act) -> + Just (act.extension.ref, act.shorthand, act.extension) + +------------------------------------------------------------------------------- + +printDigraph :: + forall m ext. + ( Monad m + , DotGraphExt ext + ) => + (forall a. m a -> IO a) -> + OpGraph m (Actions ext) -> + IO () +printDigraph nat graph = do + printCograph =<< nat (expand graph) + +printCograph :: + forall m ext. + ( Monad m + , DotGraphExt ext + ) => + Cofree Graph (OpGraph m (Actions ext)) -> + IO () +printCograph gr1 = do + let nodes = fmap dotNode $ List.nubBy sameNode $ toList $ evalNodes gr1 + let edges = fmap dotEdge $ List.nubBy sameEdge $ evalEdges gr1 + putStrLn "digraph {" + putStrLn "rankdir=LR;" + traverse_ Text.putStrLn $ nodes + traverse_ Text.putStrLn $ edges + putStrLn "}" + +{- | (R4) 'printCograph' for a folded, and possibly rewritten, 'Dag' rather +than the declared @Cofree Graph@ — what @run dag@ prints once any +"Salmon.Op.Rewrite" phases are registered, so a batch is one node in the +picture rather than however many nodes it replaced. + +A 'Dag' has already collapsed 'Connect'\/'Overlay' into plain dependency +edges, so the red\/orange\/gray distinction 'printCograph' draws from +'Salmon.Op.GraphFold.Shape' has nothing left to key off — every edge here is +"depends on", drawn the same way 'OV' edges always were. +-} +printDagCograph :: + forall ext. + (DotGraphExt ext) => + Dag ext -> + IO () +printDagCograph dag = do + let nodes = fmap dotNode [mkDagNode aref act | (aref, act) <- Map.toList (Dag.dagNodes dag)] + let edges = + [ dotEdge (Edge (OV, V) (dref, aref)) + | aref <- Dag.dagOrder dag + , dref <- Dag.dependenciesOf dag aref + ] + putStrLn "digraph {" + putStrLn "rankdir=LR;" + traverse_ Text.putStrLn $ nodes + traverse_ Text.putStrLn $ edges + putStrLn "}" + where + mkDagNode :: Ref -> Act ext -> Node ext + mkDagNode aref act = Just (aref, act.shorthand, act.extension) diff --git a/src/Salmon/Actions/Fleet.hs b/src/Salmon/Actions/Fleet.hs new file mode 100644 --- /dev/null +++ b/src/Salmon/Actions/Fleet.hs @@ -0,0 +1,191 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | The fleet fold (milestone 5 of @specs/pull-mode.md@): what +@salmon-fleet status DIR@ computes over a directory of status sink +documents ("Salmon.Actions.Serve.StatusSink"), one per host. + +Fleet status is a fold over the documents the hosts wrote, computed by +whoever reads the directory — this module, a script, a web page — and not +by a running service: the directory is the only shared thing, and it is a +dumb one. The fold is pure ('fold') over what 'readStatusDir' found, so +that it is testable without a host, and the binary in @salmon-apps@ is a +thin command line over the two. + +What a row says about a host: its name and mode, the document each of its +labels last applied (id and digest), how many of its nodes have converged +and how many are errored out of how many, and how long ago it wrote — +flagged 'rowStale' past a threshold. A stale host is a /visible fact/, not +a decision: nothing here decides a host is dead (see the spec's "what this +does not solve"), it only says nobody has heard from it lately. +-} +module Salmon.Actions.Fleet ( + -- * Reading a directory + readStatusDir, + + -- * The fold + Options (..), + defaultOptions, + Row (..), + fold, + rowOf, + nodeCounts, + + -- * Rendering + renderRow, + renderHeader, + rowValue, +) where + +import Control.Exception (SomeException, try) +import Data.Aeson (ToJSON (..), Value (..), eitherDecode, object, (.=)) +import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.ByteString.Lazy as LByteString +import Data.List (isSuffixOf, sortOn) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime) +import System.Directory (listDirectory) +import System.FilePath (()) + +import Salmon.Actions.Serve (AppliedDocument (..)) +import Salmon.Actions.Serve.StatusSink (Document (..)) + +------------------------------------------------------------------------------- + +{- | Every @*.json@ in the directory, read and parsed: the documents that +are status sink documents, and, by file, why the others are not. A file +that cannot be read at all is in the second list too; nothing is ever +written. -} +readStatusDir :: FilePath -> IO ([(FilePath, Document)], [(FilePath, String)]) +readStatusDir dir = do + names <- filter (".json" `isSuffixOf`) <$> listDirectory dir + outcomes <- mapM readOne (sortOn id names) + pure ([(f, d) | (f, Right d) <- outcomes], [(f, e) | (f, Left e) <- outcomes]) + where + readOne name = do + let path = dir name + attempt <- try (LByteString.readFile path >>= \b -> LByteString.length b `seq` pure b) + pure . (,) path $ case attempt of + Left (ex :: SomeException) -> Left (show ex) + Right bytes -> eitherDecode bytes + +------------------------------------------------------------------------------- + +data Options = Options + { optLabel :: Maybe Text + -- ^ only hosts carrying this label + , optStale :: NominalDiffTime + -- ^ a document written longer ago than this flags its host + } + deriving (Show, Eq) + +-- | No label filter; stale after a minute. +defaultOptions :: Options +defaultOptions = Options Nothing 60 + +-- | One host, as the fold reports it. +data Row = Row + { rowHost :: !Text + , rowMode :: !Text + , rowLabels :: [AppliedDocument] + , rowConverged :: !Int + , rowErrored :: !Int + , rowNodes :: !Int + , rowWritten :: !UTCTime + , rowAge :: !NominalDiffTime + -- ^ how long before @now@ the document was written; negative for a + -- clock ahead of the reader's + , rowStale :: !Bool + , rowFile :: !FilePath + } + deriving (Show, Eq) + +{- | The fold: one row per document, hosts in name order, filtered to the +label asked for, each flagged stale against @now@. Two documents naming +one host (two files, one machine) are two rows: the fold reports what is +there and does not pick. -} +fold :: Options -> UTCTime -> [(FilePath, Document)] -> [Row] +fold opts now docs = + sortOn (\r -> (r.rowHost, r.rowFile)) + [ row + | (path, doc) <- docs + , maybe True (\l -> l `elem` fmap (.appliedDocLabel) doc.docLabels) opts.optLabel + , let row = rowOf opts now path doc + ] + +rowOf :: Options -> UTCTime -> FilePath -> Document -> Row +rowOf opts now path doc = + Row + { rowHost = doc.docHost + , rowMode = doc.docMode + , rowLabels = doc.docLabels + , rowConverged = converged + , rowErrored = errored + , rowNodes = total + , rowWritten = doc.docWritten + , rowAge = age + , rowStale = age > opts.optStale + , rowFile = path + } + where + age = now `diffUTCTime` doc.docWritten + (converged, errored, total) = nodeCounts doc.docStatus + +{- | Converged, errored, total, read off the @status@ object's @nodes@ — +the same objects @status --json@ prints. Anything that is not that shape +counts as no nodes. -} +nodeCounts :: Value -> (Int, Int, Int) +nodeCounts status = + case status of + Object o | Just (Array nodes) <- KeyMap.lookup "nodes" o -> + let convergences = [c | Object n <- foldr (:) [] nodes, Just (String c) <- [KeyMap.lookup "convergence" n]] + in ( length (filter (== "converged") convergences) + , length (filter (== "errored") convergences) + , length convergences + ) + _ -> (0, 0, 0) + +------------------------------------------------------------------------------- + +-- | The column names, for the line above 'renderRow's. +renderHeader :: Text +renderHeader = "host\tmode\tlabels\tconverged\terrored\tage\tflags" + +{- | One line per host, tab-separated: host, mode, @label=id@sha256[:12]@ +per label (comma-separated, @-@ for none), @converged/total@, errored, +the document's age in seconds, and @stale@ or nothing. -} +renderRow :: Row -> Text +renderRow r = + Text.intercalate + "\t" + [ r.rowHost + , r.rowMode + , if null r.rowLabels then "-" else Text.intercalate "," (fmap labelText r.rowLabels) + , Text.pack (show r.rowConverged) <> "/" <> Text.pack (show r.rowNodes) + , Text.pack (show r.rowErrored) + , Text.pack (show (round r.rowAge :: Integer)) <> "s" + , if r.rowStale then "stale" else "" + ] + where + labelText :: AppliedDocument -> Text + labelText a = a.appliedDocLabel <> "=" <> a.appliedDocId <> "@" <> Text.take 12 a.appliedDocDigest + +-- | The row as @--json@ prints it. +rowValue :: Row -> Value +rowValue r = + object + [ "host" .= r.rowHost + , "mode" .= r.rowMode + , "labels" .= r.rowLabels + , "converged" .= r.rowConverged + , "errored" .= r.rowErrored + , "nodes" .= r.rowNodes + , "written" .= r.rowWritten + , "age_s" .= (realToFrac r.rowAge :: Double) + , "stale" .= r.rowStale + , "file" .= r.rowFile + ] + +instance ToJSON Row where + toJSON = rowValue diff --git a/src/Salmon/Actions/Follow.hs b/src/Salmon/Actions/Follow.hs new file mode 100644 --- /dev/null +++ b/src/Salmon/Actions/Follow.hs @@ -0,0 +1,870 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | Pull mode for @run serve@: a 'Producer' that fetches the loop's +declarations from a registry instead of waiting to be typed at. + +The unit fetched is a 'Document' — the /desired set/ of seeds for one +'Label', not a log of commands — and a host follows a list of labels, its +desired set being the union of their documents. A 'Registry' is anything that +answers "the latest document for this label"; 'directoryRegistry' is the +first one (and the test harness: write a file, watch the world change). + +Three rules are load-bearing, and each is what a naive poller gets wrong. + +__Change is detected before anything is injected.__ Every line that reaches +the loop's inbox stands the supervisor's machines down ("Salmon.Actions.Serve" +calls @stopTending@ before any command, by design). A poller that injected on +every round would therefore starve supervision: at a five-second interval no +machine would ever reach its check ceiling and a 'Salmon.Builtin.Extension.managed' +node's watch would be cut every tick. So a round first asks the registry +whether the document /might/ have changed (its 'Stamp': an mtime and size for +a file, an ETag or a commit id later), then compares the bytes' 'Digest' +against the one last applied, and only a document whose digest differs +produces anything at all. An unchanged round is invisible to the loop. + +__What is injected is a diff, as one batch.__ Against the document last +applied for that label, not against the world: one @up@ per seed newly +present, one @down@ per seed no longer present /and not in any other +followed label's document/ — the union across labels is computed here, +because the ledger identifies a declaration by its directive and could not +tell one label's copy of a seed from another's. The batch is a single +'Serve.Batch' inbox entry: the loop runs it with @autoconverge@ held off, +restores whatever the operator had set, and converges once. Seeds an +operator typed interactively are never in a document's diff and so are left +alone — unless the operator typed the very same seed a document then drops, +which the ledger cannot tell apart (see the spec's "two operators"). + +__The fetcher is a named actor in @history@.__ Every declaration it makes +carries a 'Serve.Fetched' origin — registry, label, document id, digest — so +that an operator can tell "I typed this" from "the document said so", which +is the only way to find out why a host did something surprising. + +__When__ a round runs, and when what it found is injected, is the +scheduler's ("Salmon.Actions.Follow.Scheduler"): a ladder with jitter toward +the registry (a failed round backs off, a successful one — changed or not — +polls at the base), and a quiet window toward the loop (a change waits for +the registry to stop changing, or for @max_wait@, and three documents seen +inside one window are one diff and one convergence pass). The first round +at startup is the exception: synchronous, injected at once, so that the +first convergence is as deterministic as a piped script's. The loop's +@fetch@ command pokes the scheduler through a 'Scheduler.Poke': a round now, +the ladder forgotten, whatever is pending injected the moment the round is +over. + +__The last applied document survives a restart__ (milestone 4 of +@specs/pull-mode.md@), if a 'followCache' directory is given: after every +injection the document each label just applied is written there, bytes, +digest and id, atomically (a temp file and a rename, so a crash mid-write +leaves the previous one). At startup, a label whose registry cannot be +reached — the fetch threw, or the bytes it returned do not parse — is +applied from its cached document instead, reported 'Replayed', and the loop +is in 'Serve.Replay' mode: the world is the last thing this host knew, not +necessarily what the registry says now. The mode turns to +'Serve.Following' at the first later round in which every label answers, +changed or not. The cached document is compared by digest exactly as a +previously applied one is, so a registry that comes back with the same +document injects nothing — the starvation rule holds across restarts. +'Serve.Replay' is only ever /entered/ at startup, and the reason is what the +cache stands in for: a world, not a round. Before the first round there is +no world at all, and coming up empty would tear nothing down, look converged +and be wrong; the cache is the better answer to that. After a successful +round the world already is what the registry last said, and a round failing +later changes nothing about it — the last good document stays in force +(the spec's rule for a document that fails verification, applied here too), +and the scheduler's 'Backoff' is what says the registry is unreachable. A +cache that cannot be read is reported ('BadCache') and ignored, one that +cannot be written likewise ('CacheFailed'): the cache never takes the loop +down. Without a cache directory nothing is cached and a host that starts +against an unreachable registry declares nothing, as it did before. + +__Ordered ids__, the spec's open question, are settled the way it leaned: a +document may carry a @published@ RFC 3339 timestamp at its top level, and +with 'followRefuseOlder' a fetched document published /before/ the one this +label already applied (or has pending) is reported 'Stale' and not injected +— what a registry serving from a lagging replica would otherwise do to a +host. Off by default, and without a @published@ on both sides the latest +document is whatever the registry says. + +__A document is verified before it is parsed__, by 'followVerify': a +function of the raw bytes and their digest, run on everything that would +otherwise reach the loop — a fetched document from any registry, and a +cached one on replay, since a cache file is as writable as a registry file. +A 'Left' is reported 'Rejected' with its reason, is a failed round, and the +bytes are neither injected nor cached; the last good document stays in +force. A 'Right' is /the bytes to parse/: 'noVerifier', the default and +what runs without a @--follow-key@, hands back what it was given, and +"Salmon.Actions.Follow.Signature"'s @signedVerifier@ hands back the document +it unwrapped from a signed envelope. The digest kept everywhere here — the +one compared for change, reported, recorded in @history@ and written beside +the cache entry — is that of the bytes /as fetched/, envelope included: the +cache keeps those same bytes so that a replay goes through the verifier +exactly as a fetch did. + +The status sink ("Salmon.Actions.Serve.StatusSink") reads this module's +reports and the per-label 'Applied' cell ('appliedDocuments') and writes +nothing here. The registries beyond the directory are in +"Salmon.Actions.Follow.Registry", the signature scheme in +"Salmon.Actions.Follow.Signature". +-} +module Salmon.Actions.Follow ( + -- * Documents + Document (..), + Entry (..), + formatVersion, + entryCommand, + + -- * Labels and registries + Label, + mkLabel, + labelText, + Stamp (..), + Digest (..), + Fetch (..), + Registry (..), + directoryRegistry, + documentPath, + digestOf, + + -- * The cache + Cached (..), + cachePath, + readCache, + readCacheEntry, + writeCache, + + -- * Following + Follow (..), + Verifier, + noVerifier, + follower, + followerWith, + gated, + newMode, + newApplied, + followed, + appliedDocuments, + Applied (..), + diffBatch, + + -- * Reporting + Report (..), + reportText, + renderReport, +) where + +import Control.Concurrent.MVar (MVar, readMVar) +import Control.Concurrent.STM (TChan, atomically, writeTChan) +import Control.Exception (SomeException, try) +import Control.Monad (forM, forM_, unless, when) +import Data.Aeson (FromJSON (..), ToJSON (..), Value, eitherDecode, encode, object, withObject, (.:), (.:?), (.=)) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as LByteString +import Data.Char (isAlphaNum) +import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, maybeToList) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.Text.IO as Text +import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.Time.Clock.POSIX (getPOSIXTime) +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getFileSize, getModificationTime, renameFile) +import System.FilePath ((<.>), ()) +import System.IO (hFlush, stdout) + +import qualified Salmon.Actions.Follow.Scheduler as Scheduler +import qualified Salmon.Actions.Query as Query +import qualified Salmon.Actions.Serve as Serve +import Salmon.Actions.Serve (Declaration (..), Line (..), Origin (..), Producer (..), Provenance (..), ServeCommand (..)) +import Salmon.Reporter + +------------------------------------------------------------------------------- +-- documents + +{- | One seed of a document: either the words that would follow @config@ on +the command line (what @up@ takes), or a directive's JSON (what +@up-directive@ takes from a file). Two entries are the same seed iff they are +equal here, spelling included — the ledger's finer notion (equal directives) +is applied once the loop configures them. +-} +data Entry + = -- | @{"seed": ["app", "--version", "42"]}@ + SeedWords [String] + | -- | @{"directive": {...}}@ + SeedDirective Value + deriving (Show, Eq) + +instance FromJSON Entry where + parseJSON = withObject "seed entry" $ \o -> do + ws <- o .:? "seed" + dv <- o .:? "directive" + case (ws, dv) of + (Just w, Nothing) -> pure (SeedWords w) + (Nothing, Just d) -> pure (SeedDirective d) + (Nothing, Nothing) -> fail "a seed entry needs a `seed` (words) or a `directive` (JSON)" + (Just _, Just _) -> fail "a seed entry has either a `seed` or a `directive`, not both" + +instance ToJSON Entry where + toJSON (SeedWords ws) = object ["seed" .= ws] + toJSON (SeedDirective d) = object ["directive" .= d] + +{- | The fetched thing. @salmon@ is 'formatVersion' and must be exactly that; +@id@ is opaque, the publisher's own name for this revision, and is what +@history@ records; @published@ is optional, an RFC 3339 timestamp, and is +only ever compared under 'followRefuseOlder'; anything else at the top level +is ignored so a publisher can annotate. +-} +data Document = Document + { docId :: Text + , docSeeds :: [Entry] + , docPublished :: Maybe UTCTime + } + deriving (Show, Eq) + +-- | The one value of @salmon@ this reader understands. +formatVersion :: Int +formatVersion = 1 + +instance FromJSON Document where + parseJSON = withObject "salmon document" $ \o -> do + v <- o .: "salmon" + unless (v == formatVersion) $ + fail ("unsupported document format: salmon=" <> show v <> " (this reader understands " <> show formatVersion <> ")") + Document <$> o .: "id" <*> o .: "seeds" <*> o .:? "published" + +instance ToJSON Document where + toJSON d = + object $ + ["salmon" .= formatVersion, "id" .= d.docId, "seeds" .= d.docSeeds] + ++ ["published" .= p | p <- maybeToList d.docPublished] + +-- | The loop command that declares an entry in the given direction. +entryCommand :: Declaration -> Label -> Entry -> ServeCommand +entryCommand decl _ (SeedWords ws) = Declare decl ws +entryCommand decl lbl (SeedDirective v) = DeclareInline decl (labelText lbl) v + +------------------------------------------------------------------------------- +-- labels and registries + +{- | An address into a registry: "the latest document for @web-api@". A +label is spliced into a path, a URL or a DNS name by the registry backend, so +its alphabet is restricted to what every backend can carry safely — letters, +digits, @.@, @_@, @-@, @\@@ — and it may not start with a dot, which for the +directory backend is what keeps @..@ from escaping the directory. +-} +newtype Label = Label Text + deriving (Show, Eq, Ord) + +mkLabel :: Text -> Either Text Label +mkLabel t + | Text.null t = Left "a label cannot be empty" + | Text.isPrefixOf "." t = Left ("a label cannot start with a dot: " <> t) + | Text.all allowed t = Right (Label t) + | otherwise = Left ("a label may only contain letters, digits, `.`, `_`, `-` and `@`: " <> t) + where + allowed c = isAlphaNum c || c `elem` ("._-@" :: String) + +labelText :: Label -> Text +labelText (Label t) = t + +{- | The registry's own cheap "has it moved?" token for a document: an +mtime and size for a file, later an ETag, a commit id or an object +generation. Opaque to the fetcher, which only ever hands the last one back +and compares digests when the registry says it may have changed. A stamp is +a shortcut, not the decision: two writes inside one timestamp tick are why +the digest is compared as well. +-} +newtype Stamp = Stamp Text + deriving (Show, Eq) + +-- | Hex-encoded SHA-256 of a document's bytes, exactly as fetched. +newtype Digest = Digest {unDigest :: Text} + deriving (Show, Eq) + +digestOf :: ByteString -> Digest +digestOf = Digest . Query.digestBytes + +-- | What a registry answers when asked for a label, given the stamp of what +-- the fetcher last saw for it. +data Fetch + = -- | no document for this label + Absent + | -- | the stamp still matches: nothing read, nothing to compare + Unchanged + | -- | the bytes, their digest, and the stamp to hand back next time + Found !Stamp !Digest !ByteString + deriving (Show, Eq) + +{- | Anything that answers "latest document for @label@". The backend owns +the template that turns a label into an address, and the meaning of its +'Stamp'. +-} +data Registry = Registry + { registryName :: Text + -- ^ how @history@ and reports name it: a directory path, a URL, a repo + , registryFetch :: Label -> Maybe Stamp -> IO Fetch + -- ^ may throw; the fetcher contains that and reports it + } + +-- | Where 'directoryRegistry' looks for a label: @\/\.json@. +documentPath :: FilePath -> Label -> FilePath +documentPath dir (Label t) = dir Text.unpack t <.> "json" + +{- | A directory with one file per label, named by 'documentPath'. Its stamp +is the file's modification time and size; a file whose stamp matches the one +handed back is not even read. The directory itself missing is the registry +being unreachable — a throw, the same as a host a URL points at not +answering — and not a label with no document: the difference is what +decides whether a cached document is replayed at startup. +-} +directoryRegistry :: FilePath -> Registry +directoryRegistry dir = Registry (Text.pack dir) fetch + where + fetch lbl previous = do + there <- doesDirectoryExist dir + unless there $ + ioError (userError ("registry directory does not exist: " <> dir)) + let path = documentPath dir lbl + present <- doesFileExist path + if not present + then pure Absent + else do + mtime <- getModificationTime path + size <- getFileSize path + let stamp = Stamp (Text.pack (show mtime <> " " <> show size)) + if Just stamp == previous + then pure Unchanged + else do + bytes <- LByteString.readFile path + -- forced now: a lazy read holds the handle open, and a + -- rewrite under it is precisely the case this is for. + let digest = digestOf bytes + LByteString.length bytes `seq` pure (Found stamp digest bytes) + +------------------------------------------------------------------------------- +-- the cache + +{- | What the cache keeps per label: the applied document's bytes exactly as +fetched (so that the digest, kept beside them, is the one a later fetch is +compared against), and its id for the report that replays it. On disk as +@{"salmon-cache": 1, "id": ..., "sha256": ..., "document": ...}@, the bytes +as one JSON string. +-} +data Cached = Cached + { cachedId :: !Text + , cachedDigest :: !Digest + , cachedBytes :: !ByteString + } + deriving (Show, Eq) + +cacheFormatVersion :: Int +cacheFormatVersion = 1 + +instance FromJSON Cached where + parseJSON = withObject "salmon cache entry" $ \o -> do + v <- o .: "salmon-cache" + unless (v == cacheFormatVersion) $ + fail ("unsupported cache format: salmon-cache=" <> show v) + Cached + <$> o .: "id" + <*> (Digest <$> o .: "sha256") + <*> (LByteString.fromStrict . Text.encodeUtf8 <$> o .: "document") + +instance ToJSON Cached where + toJSON c = + object + [ "salmon-cache" .= cacheFormatVersion + , "id" .= c.cachedId + , "sha256" .= c.cachedDigest.unDigest + , "document" .= Text.decodeUtf8Lenient (LByteString.toStrict c.cachedBytes) + ] + +{- | The cache's file for a label: @\/\.applied.json@. Not +'documentPath''s name, so that a cache directory pointed at a registry +directory by mistake overwrites nothing the registry serves. +-} +cachePath :: FilePath -> Label -> FilePath +cachePath dir (Label t) = dir Text.unpack t <.> "applied" <.> "json" + +{- | The cached entry for a label, its digest checked against the bytes: +'Nothing' when there is none, a reason when there is one that cannot be +used. The bytes are as fetched, so what they parse as depends on the +verifier — see 'readCache' for the unsigned reading. Never throws. +-} +readCacheEntry :: FilePath -> Label -> IO (Either Text (Maybe Cached)) +readCacheEntry dir lbl = do + let path = cachePath dir lbl + present <- doesFileExist path + if not present + then pure (Right Nothing) + else do + attempt <- try (LByteString.readFile path >>= \b -> LByteString.length b `seq` pure b) + pure $ case attempt of + Left (ex :: SomeException) -> Left (Text.pack (show ex)) + Right bytes -> case eitherDecode bytes of + Left err -> Left (Text.pack err) + Right c + | digestOf c.cachedBytes /= c.cachedDigest -> Left "the cached bytes do not hash to the digest kept beside them" + | otherwise -> Right (Just c) + +{- | 'readCacheEntry', with the bytes parsed as the 'Document' they hold +directly — the reading for a cache written under 'noVerifier'. A cache +written under a verifier that unwraps (a signed envelope) parses only +through that verifier, which is how 'follower' reads it. +-} +readCache :: FilePath -> Label -> IO (Either Text (Maybe (Cached, Document))) +readCache dir lbl = do + entry <- readCacheEntry dir lbl + pure $ case entry of + Left err -> Left err + Right Nothing -> Right Nothing + Right (Just c) -> case eitherDecode c.cachedBytes of + Left err -> Left ("the cached document does not parse: " <> Text.pack err) + Right doc -> Right (Just (c, doc)) + +{- | Write a label's cache entry: to a temporary file beside it, then +renamed over it, so that a crash mid-write leaves the previous entry rather +than half of this one. May throw; the caller reports and moves on. +-} +writeCache :: FilePath -> Label -> Cached -> IO () +writeCache dir lbl c = do + createDirectoryIfMissing True dir + let path = cachePath dir lbl + tmp = path <.> "tmp" + LByteString.writeFile tmp (encode c) + renameFile tmp path + +------------------------------------------------------------------------------- +-- following + +data Follow = Follow + { followRegistry :: Registry + , followLabels :: [Label] + , followSchedule :: Scheduler.Config + -- ^ the ladder toward the registry and the window toward the loop + , followCache :: Maybe FilePath + -- ^ where each label's last applied document is kept across restarts; + -- 'Nothing' keeps none + , followRefuseOlder :: Bool + -- ^ refuse a document whose @published@ is older than the one already + -- applied or pending for its label + , followVerify :: Verifier + -- ^ run on the raw bytes of every document before it is parsed, cache + -- replay included; 'noVerifier' accepts everything + } + +{- | The verify-before-inject hook: the label the bytes were fetched *for*, +the digest and the bytes exactly as fetched; a reason to refuse them, or the +bytes the loop is to parse as the 'Document' — the same ones for a verifier +that only checks, the unwrapped document for one that strips a signed +envelope. It may throw, which is a refusal with the exception's text. + +The label is an argument because a document is only worth applying at the +address it was signed for: a verifier that is not told which label it is +looking at cannot tell a @canary@ document that is validly signed from the +same bytes served at @prod@'s address. -} +type Verifier = Label -> Digest -> ByteString -> IO (Either Text ByteString) + +-- | Accepts everything as it is: the default, and unsigned mode. +noVerifier :: Verifier +noVerifier _ _ bytes = pure (Right bytes) + +-- | 'followVerify' with a throw contained as a refusal. +verify :: Follow -> Label -> Digest -> ByteString -> IO (Either Text ByteString) +verify follow lbl digest bytes = do + outcome <- try (follow.followVerify lbl digest bytes) + pure $ case outcome of + Left (ex :: SomeException) -> Left (Text.pack (show ex)) + Right verdict -> verdict + +{- | The document last applied for a label: what the next diff is against. +The stamp is 'Nothing' for a document replayed from the cache — a stamp +belongs to the registry, and the cache is not it — so the registry reads +the file once and hands the stamp back from then on. -} +data Applied = Applied + { appliedStamp :: !(Maybe Stamp) + , appliedDigest :: !Digest + , appliedId :: !Text + , appliedSeeds :: [Entry] + , appliedPublished :: !(Maybe UTCTime) + , appliedAt :: !UTCTime + -- ^ when it was injected (the wall clock), for the status sink + } + deriving (Show, Eq) + +data Report + = -- | registry, labels, schedule + Following !Text ![Label] !Scheduler.Config + | -- | a changed document was injected: label, id, digest, seeds up, seeds down + Injected !Label !Text !Digest !Int !Int + | -- | a changed document whose seed set is the one already applied + -- (its id or an annotation changed); recorded, nothing injected + NoDiff !Label !Text !Digest + | -- | a changed document, seen after startup: it waits for the quiet + -- window (label, id, digest); what it turns into is the 'Injected' + -- or 'NoDiff' that follows + Deferred !Label !Text !Digest + | -- | a round failed: consecutive failures, microseconds until the next round + Backoff !Int !Int + | -- | no document for this label + Missing !Label + | -- | the document was applied once and is now gone; what it declared + -- stays in force + Vanished !Label + | -- | the bytes did not parse as a document: label, digest, why + Malformed !Label !Digest !Text + | -- | asking the registry threw + FetchFailed !Label !Text + | -- | the registry could not be read at startup and the cached + -- document was applied instead: label, id, digest. The 'Injected' + -- that follows is its declarations. + Replayed !Label !Text !Digest + | -- | under 'followRefuseOlder', a document published before the one + -- already applied or pending for its label: label, id. Not injected. + Stale !Label !Text + | -- | a cache entry that cannot be used: label, why. Ignored. + BadCache !Label !Text + | -- | writing a label's cache entry threw: label, why. The document + -- was injected all the same; only the next restart is affected. + CacheFailed !Label !Text + | -- | 'followVerify' refused the bytes: label, digest, why. Not + -- injected, not cached; a failed round. For a cached document at + -- startup, not replayed. + Rejected !Label !Digest !Text + deriving (Show, Eq) + +-- | One write per report, for the same reason as 'Serve.reportText': the +-- loop's own reporter writes to this handle from another thread. +reportText :: Reporter Report +reportText = ReporterM $ \rep -> do + Text.putStr (Text.unlines (renderReport rep)) + hFlush stdout + +renderReport :: Report -> [Text] +renderReport rep = + case rep of + Following reg lbls cfg -> + [ "follow: " + <> reg + <> " for " + <> Text.intercalate ", " (fmap labelText lbls) + <> " " + <> Scheduler.renderConfig cfg + ] + Injected lbl did dg nup ndown -> + [ "follow: " + <> labelText lbl + <> " id=" + <> did + <> " sha256=" + <> Text.take 12 dg.unDigest + <> ": " + <> Text.pack (show nup) + <> " seed(s) up, " + <> Text.pack (show ndown) + <> " down" + ] + NoDiff lbl did dg -> + ["follow: " <> labelText lbl <> " id=" <> did <> " sha256=" <> Text.take 12 dg.unDigest <> ": same seeds as before, nothing to declare"] + Deferred lbl did dg -> + ["follow: " <> labelText lbl <> " id=" <> did <> " sha256=" <> Text.take 12 dg.unDigest <> ": changed, waiting for the registry to go quiet"] + Backoff n us -> + ["follow: " <> Text.pack (show n) <> " failed round(s) in a row; next in " <> Text.pack (show (us `div` 1000000)) <> "s"] + Missing lbl -> ["follow: no document for " <> labelText lbl] + Vanished lbl -> ["follow: document for " <> labelText lbl <> " is gone; its last declarations stay in force"] + Malformed lbl dg err -> ("follow: cannot read document for " <> labelText lbl <> " (sha256=" <> Text.take 12 dg.unDigest <> "):") : Text.lines err + FetchFailed lbl err -> ["follow: fetching " <> labelText lbl <> " failed: " <> err] + Replayed lbl did dg -> + ["follow: " <> labelText lbl <> ": registry unreachable; replaying the cached document id=" <> did <> " sha256=" <> Text.take 12 dg.unDigest] + Stale lbl did -> + ["follow: " <> labelText lbl <> " id=" <> did <> ": published before the document already applied; refused (--follow-refuse-older)"] + BadCache lbl err -> ("follow: ignoring the cached document for " <> labelText lbl <> ":") : Text.lines err + CacheFailed lbl err -> ("follow: could not cache the document for " <> labelText lbl <> ":") : Text.lines err + Rejected lbl dg err -> ("follow: refusing the document for " <> labelText lbl <> " (sha256=" <> Text.take 12 dg.unDigest <> "):") : Text.lines err + +{- | The diff-batch for a label whose document changed: what to declare up +(in the new document, not in the old one) and down (in the old one, not in +the new one, and not in any other label's document either — the union +across labels, taken over what the other labels are /about to/ say when +several are injected together). The old document is 'Nothing' for a label +seen for the first time. +-} +diffBatch :: Label -> Maybe Applied -> [Entry] -> Map Label Applied -> ([Entry], [Entry]) +diffBatch lbl previous new others = + (ups, downs) + where + old = maybe [] appliedSeeds previous + elsewhere = concat [a.appliedSeeds | (l, a) <- Map.toList others, l /= lbl] + ups = [e | e <- new, e `notElem` old] + downs = [e | e <- old, e `notElem` new, e `notElem` elsewhere] + +{- | The cell the fetcher keeps its 'Serve.Mode' in, made by the caller so +that the loop can be handed a reader of it ('followed') before the producer +runs. Starts 'Serve.Following'; only the startup round can turn it to +'Serve.Replay'. -} +newMode :: IO (IORef Serve.Mode) +newMode = newIORef Serve.Following + +{- | The cell the fetcher keeps the document last applied per label in, +made by the caller for the same reason as 'newMode': the status sink reads +it ('appliedDocuments') and the sink is composed before the producer runs. +Starts empty. -} +newApplied :: IO (IORef (Map Label Applied)) +newApplied = newIORef Map.empty + +-- | The loop's side: what @fetch@ pokes, what @status@ reads, and what +-- the status sink lists per label. +followed :: Scheduler.Poke -> IORef Serve.Mode -> IORef (Map Label Applied) -> Serve.Followed +followed pk mode applied = + Serve.Followed + { Serve.followedFetch = Scheduler.poke pk + , Serve.followedMode = readIORef mode + , Serve.followedApplied = appliedDocuments applied + } + +-- | The document last applied per label, in label order, as the status +-- sink publishes it. +appliedDocuments :: IORef (Map Label Applied) -> IO [Serve.AppliedDocument] +appliedDocuments applied = do + m <- readIORef applied + pure [Serve.AppliedDocument (labelText lbl) a.appliedId a.appliedDigest.unDigest a.appliedAt | (lbl, a) <- Map.toList m] + +-- | The producer, on the system clock and seeded from the wall clock (so +-- that two hosts started together draw different jitter). See 'followerWith'. +follower :: Reporter Report -> Scheduler.Poke -> IORef Serve.Mode -> IORef (Map Label Applied) -> Follow -> IO () -> Producer +follower r pk mode applied follow primed = Producer $ \inbox -> do + seed <- fromIntegral . (`div` 1000) . fromEnum <$> getPOSIXTime + produceInto (followerWith r (Scheduler.systemClock pk) (Scheduler.mkRng seed) mode applied follow primed) inbox + +{- | The producer. One round runs synchronously before the given action +(meant to release the standard-input producer, see 'gated'), and whatever it +found is injected at once — no window: there is nothing to coalesce yet, and +the first convergence is meant to be as deterministic as a piped script's. +A label that round could not read is replayed from the cache, if there is +one for it (see the module's summary for why only this round is). Rounds +then run on the schedule ("Salmon.Actions.Follow.Scheduler"), on the clock +given: the system's, or a test's. The thread never sends an 'Eof': a +registry that goes quiet is not the loop ending. +-} +followerWith :: Reporter Report -> Scheduler.Clock -> Scheduler.Rng -> IORef Serve.Mode -> IORef (Map Label Applied) -> Follow -> IO () -> Producer +followerWith r clock rng mode applied follow primed = Producer $ \inbox -> do + runReporter r (Following (registryName follow.followRegistry) follow.followLabels follow.followSchedule) + st <- Fetcher applied <$> newIORef Map.empty <*> newIORef Set.empty <*> newIORef Map.empty + cached <- loadCache + replayed <- forM follow.followLabels $ \lbl -> do + outcome <- fetchOne r follow st lbl + case (outcome, Map.lookup lbl cached) of + (Scheduler.Failed, Just (c, doc)) -> do + modifyIORef' st.fetcherSeen (Map.insert lbl (Seen Nothing c.cachedDigest doc.docId doc.docSeeds doc.docPublished c.cachedBytes)) + runReporter r (Replayed lbl doc.docId c.cachedDigest) + pure True + _ -> pure False + when (or replayed) $ writeIORef mode Serve.Replay + injectPending r follow st inbox + primed + now <- Scheduler.clockNow clock + Scheduler.run + follow.followSchedule + clock + Scheduler.Hooks + { Scheduler.hookFetch = round_ st >>= \o -> deferred st o >> answered o >> pure o + , Scheduler.hookInject = injectPending r follow st inbox + , Scheduler.hookBackoff = \n us -> runReporter r (Backoff n us) + } + (Scheduler.start follow.followSchedule rng now) + where + round_ st = mconcat <$> forM follow.followLabels (fetchOne r follow st) + -- the changes a scheduled round found are going to wait: say so once + -- per label, at the round that saw them + deferred :: Fetcher -> Scheduler.Outcome -> IO () + deferred st o = + when (o == Scheduler.Changed) $ do + fresh <- atomicModifyIORef' st.fetcherFresh (\s -> (Set.empty, s)) + seen <- readIORef st.fetcherSeen + forM_ (Set.toList fresh) $ \lbl -> + forM_ (Map.lookup lbl seen) $ \s -> runReporter r (Deferred lbl s.seenId s.seenDigest) + -- a round in which every label answered ends a replay: from here on + -- the world is what the registry says + answered :: Scheduler.Outcome -> IO () + answered o = unless (o == Scheduler.Failed) $ writeIORef mode Serve.Following + -- every label's cache entry, read once; a bad one is reported and left out + loadCache :: IO (Map Label (Cached, Document)) + loadCache = case follow.followCache of + Nothing -> pure Map.empty + Just dir -> + fmap (Map.fromList . catMaybes) $ + forM follow.followLabels $ \lbl -> do + entry <- readCacheEntry dir lbl + case entry of + Left err -> runReporter r (BadCache lbl err) >> pure Nothing + Right Nothing -> pure Nothing + -- verified as a fetched one is, and parsed from + -- what the verifier hands back: the cache is as + -- writable as the registry + Right (Just c) -> do + verdict <- verify follow lbl c.cachedDigest c.cachedBytes + case verdict of + Left why -> runReporter r (Rejected lbl c.cachedDigest why) >> pure Nothing + Right inner -> case eitherDecode inner of + Left err -> runReporter r (BadCache lbl ("the cached document does not parse: " <> Text.pack err)) >> pure Nothing + Right doc -> pure (Just (lbl, (c, doc))) + +{- | A producer that does not start until the 'MVar' is filled — what puts +standard input behind the fetcher's first round. -} +gated :: MVar () -> Producer -> Producer +gated gate p = Producer $ \inbox -> do + readMVar gate + produceInto p inbox + +-- | A document seen and not yet applied: the latest for its label. The +-- stamp is 'Nothing' for one replayed from the cache, and the bytes are +-- kept so the cache can be written once it is applied. +data Seen = Seen + { seenStamp :: !(Maybe Stamp) + , seenDigest :: !Digest + , seenId :: !Text + , seenSeeds :: [Entry] + , seenPublished :: !(Maybe UTCTime) + , seenBytes :: !ByteString + } + +-- | What a fetcher carries between rounds. +data Fetcher = Fetcher + { fetcherApplied :: IORef (Map Label Applied) + -- ^ per label, the document the loop last heard about + , fetcherSeen :: IORef (Map Label Seen) + -- ^ per label, a newer document waiting for its window + , fetcherFresh :: IORef (Set Label) + -- ^ labels whose 'Seen' changed since last reported + , fetcherNoise :: IORef (Map Label Report) + -- ^ the last complaint per label, so an unchanged one is not repeated + } + +-- | The outcome of a round is the worst of its labels'. +instance Semigroup Scheduler.Outcome where + Scheduler.Failed <> _ = Scheduler.Failed + _ <> Scheduler.Failed = Scheduler.Failed + Scheduler.Changed <> _ = Scheduler.Changed + _ <> Scheduler.Changed = Scheduler.Changed + Scheduler.Unchanged <> Scheduler.Unchanged = Scheduler.Unchanged + +instance Monoid Scheduler.Outcome where + mempty = Scheduler.Unchanged + +{- | One label's share of a round. Nothing here writes to the inbox: a +document whose digest differs from the last one seen is parsed and set +aside as this label's 'Seen', to be diffed and injected by 'injectPending' +when the scheduler says so. Every other outcome is a report at most — and a +repeated one (a label still missing, a file still malformed) is not even +that, since a report per round about a condition that has not changed is +noise. A registry that throws, bytes the verifier refuses, or bytes that do +not parse, is a 'Failed' round; a label with no document is not (the +registry answered), and neither is a document refused for being 'Stale'. +The verifier runs before the parser and after the digest comparison, so it +sees every document that could reach the loop and nothing that could not. -} +fetchOne :: Reporter Report -> Follow -> Fetcher -> Label -> IO Scheduler.Outcome +fetchOne r follow st lbl = do + applied <- Map.lookup lbl <$> readIORef st.fetcherApplied + seen <- Map.lookup lbl <$> readIORef st.fetcherSeen + -- what was last read, applied or not: the stamp to hand back, the + -- digest a re-read is compared against, and the publication time a + -- refused document is older than + let (lastStamp, lastDigest, lastPublished) = case seen of + Just s -> (s.seenStamp, Just s.seenDigest, s.seenPublished) + Nothing -> (appliedStamp =<< applied, appliedDigest <$> applied, appliedPublished =<< applied) + outcome <- try (registryFetch registry lbl lastStamp) :: IO (Either SomeException Fetch) + case outcome of + Left ex -> complain (FetchFailed lbl (Text.pack (show ex))) >> pure Scheduler.Failed + Right Absent -> complain (maybe (Missing lbl) (const (Vanished lbl)) applied) >> pure Scheduler.Unchanged + Right Unchanged -> pure Scheduler.Unchanged + Right (Found stamp digest bytes) + -- the mtime moved but the bytes did not: the starvation rule. + -- Remember the new stamp so the file is not re-read every round. + | Just digest == lastDigest -> do + case seen of + Just s -> modifyIORef' st.fetcherSeen (Map.insert lbl s{seenStamp = Just stamp}) + Nothing -> modifyIORef' st.fetcherApplied (Map.adjust (\a -> a{appliedStamp = Just stamp}) lbl) + pure Scheduler.Unchanged + | otherwise -> do + -- verified before it is parsed, on the bytes as fetched + verdict <- verify follow lbl digest bytes + case verdict of + Left why -> complain (Rejected lbl digest why) >> pure Scheduler.Failed + Right inner -> case eitherDecode inner :: Either String Document of + Left err -> complain (Malformed lbl digest (Text.pack err)) >> pure Scheduler.Failed + Right doc + | follow.followRefuseOlder + , Just newer <- lastPublished + , Just published <- doc.docPublished + , published < newer -> + complain (Stale lbl doc.docId) >> pure Scheduler.Unchanged + | otherwise -> do + quiet + modifyIORef' st.fetcherSeen (Map.insert lbl (Seen (Just stamp) digest doc.docId doc.docSeeds doc.docPublished bytes)) + modifyIORef' st.fetcherFresh (Set.insert lbl) + pure Scheduler.Changed + where + registry = follow.followRegistry + -- report a complaint once per change of complaint, not once per round + complain rep = do + last_ <- readIORef st.fetcherNoise + unless (Map.lookup lbl last_ == Just rep) $ do + writeIORef st.fetcherNoise (Map.insert lbl rep last_) + runReporter r rep + quiet = modifyIORef' st.fetcherNoise (Map.delete lbl) + +{- | Inject everything 'Seen' as one batch: per label, the diff against the +document last applied — so three documents seen inside one window amount to +one diff, from the one the loop knows to the latest — and one 'Serve.Batch' +for all of them, each command carrying its own label's provenance. A label +whose latest document turns out to say what was already applied (written +and written back inside the window) is reported 'NoDiff' and adopted +without a declaration. Nothing to inject writes nothing. Each label's +document is then written to the cache, if there is one — after the batch +is in the inbox, since a cache that cannot be written must not hold the +injection back. -} +injectPending :: Reporter Report -> Follow -> Fetcher -> TChan Line -> IO () +injectPending r follow st inbox = do + seen <- atomicModifyIORef' st.fetcherSeen (\s -> (Map.empty, s)) + writeIORef st.fetcherFresh Set.empty + unless (Map.null seen) $ do + applied <- readIORef st.fetcherApplied + now <- getCurrentTime + let adopt :: Seen -> Applied + adopt s = Applied s.seenStamp s.seenDigest s.seenId s.seenSeeds s.seenPublished now + -- what every label is about to say: the union the diff is against + upcoming = Map.union (fmap adopt seen) applied + let perLabel :: (Label, Seen) -> (Report, [(Origin, ServeCommand)]) + perLabel (lbl, s) = + let previous = Map.lookup lbl applied + (ups, downs) = diffBatch lbl previous s.seenSeeds upcoming + origin = + Fetched + Provenance + { provRegistry = registryName follow.followRegistry + , provLabel = labelText lbl + , provDocument = s.seenId + , provDigest = s.seenDigest.unDigest + } + in if null ups && null downs + then (NoDiff lbl s.seenId s.seenDigest, []) + else + ( Injected lbl s.seenId s.seenDigest (length ups) (length downs) + , [(origin, cmd) | cmd <- fmap (entryCommand Add lbl) ups ++ fmap (entryCommand Remove lbl) downs] + ) + (reports, cmds) = fmap concat (unzip (fmap perLabel (Map.toList seen))) + writeIORef st.fetcherApplied upcoming + unless (null cmds) $ + atomically (writeTChan inbox (Batch cmds)) + forM_ reports (runReporter r) + forM_ follow.followCache $ \dir -> + forM_ (Map.toList seen) $ \(lbl, s) -> do + written <- try (writeCache dir lbl (Cached s.seenId s.seenDigest s.seenBytes)) + case written of + Left (ex :: SomeException) -> runReporter r (CacheFailed lbl (Text.pack (show ex))) + Right () -> pure () diff --git a/src/Salmon/Actions/Follow/Registry.hs b/src/Salmon/Actions/Follow/Registry.hs new file mode 100644 --- /dev/null +++ b/src/Salmon/Actions/Follow/Registry.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- | Which registry @--follow@ names, from the shape of its argument +(milestone 6 of @specs/pull-mode.md@). Every backend is a +'Salmon.Actions.Follow.Registry' value owning the template that turns a +label into an address; the fetcher and the scheduler see none of this. + +> --follow /srv/reg a directory: /srv/reg/