diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,43 @@ ## Unreleased +## 0.2.0.0 — 2026-07-11 + +### Breaking Changes + +* The standalone `kiroku` binary is now a pure remote client. It no longer opens + a store, and the `--database-url`, `--schema`, and `--pool-size` options are + gone. Subscription status is resolved from `--remote-url` or the + `KIROKU_REMOTE_URL` environment variable and served by a running worker's + `kiroku-metrics` `/subscriptions` endpoint; with neither set, the binary exits + with guidance instead of connecting to a database. The embeddable library path + (`runKirokuCommandWithStore` / `renderKirokuCommandWithStore`) still reads the + in-process registry, so host applications are unaffected. +* `StandaloneOptions` and `StandaloneRuntime` are now newtypes carrying only + `command :: KirokuCommand`. `StandaloneOptions` lost `databaseUrl`, `schema`, + and `poolSize`; `StandaloneRuntime` lost `settings :: ConnectionSettings`. + `resolveStandaloneOptions` no longer builds connection settings. +* Record field prefixes were dropped throughout the public API, so field + selectors are renamed. `StandaloneOptions.standaloneCommand` and + `StandaloneRuntime.runtimeCommand` both become `command`, and + `SubscriptionStatusRow`'s `rowSubscription`, `rowMember`, `rowPhase`, and + `rowGlobalPosition` become `subscription`, `member`, `phase`, and + `globalPosition`. The affected records now derive `Generic`, so they are + addressable with `generic-lens` labels (`row ^. #subscription`). +* Requires `kiroku-store ^>=0.3`. + +### New Features + +* `Kiroku.Cli.Subscription.Status` gains a remote client: + `fetchRemoteSubscriptionStatusRows` and `renderRemoteSubscriptionStatus` query + a worker's `/subscriptions` endpoint over `http-client` /`http-client-tls`. +* `SubscriptionStatusRow` gains `ToJSON` / `FromJSON` instances, giving the HTTP + endpoint and the CLI a single wire contract; `renderJson` now encodes through + that codec. +* `StatusOptions` gains `endpoint :: Maybe RemoteEndpoint` (`Nothing` reads the + in-process registry; `Just` queries a remote worker), populated by the new + `--remote-url` option. + ## 0.1.0.0 — 2026-05-31 ### New Features diff --git a/kiroku-cli.cabal b/kiroku-cli.cabal --- a/kiroku-cli.cabal +++ b/kiroku-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: kiroku-cli -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Embeddable operator CLI for Kiroku description: Parser, runner, and executable entry points for Kiroku operator commands. @@ -46,7 +46,10 @@ , bytestring >=0.11 && <0.13 , containers >=0.6 && <0.8 , generic-lens >=2.2 && <2.4 - , kiroku-store ^>=0.2 + , http-client >=0.7 && <0.8 + , http-client-tls >=0.3 && <0.4 + , http-types >=0.12 && <0.13 + , kiroku-store ^>=0.3 , lens >=5.2 && <5.4 , optparse-applicative >=0.19 && <0.20 , text >=2.0 && <2.2 @@ -76,6 +79,8 @@ , containers , generic-lens >=2.2 && <2.4 , hspec >=2.10 && <2.12 + , http-client >=0.7 && <0.8 + , http-client-tls >=0.3 && <0.4 , kiroku-cli , kiroku-store , kiroku-test-support diff --git a/src/Kiroku/Cli/Command.hs b/src/Kiroku/Cli/Command.hs --- a/src/Kiroku/Cli/Command.hs +++ b/src/Kiroku/Cli/Command.hs @@ -1,10 +1,13 @@ module Kiroku.Cli.Command ( KirokuCommand (..), OutputFormat (..), + RemoteEndpoint (..), StatusOptions (..), SubscriptionCommand (..), ) where +import Data.Text (Text) + data KirokuCommand = KirokuNoCommand | KirokuSubscriptions SubscriptionCommand @@ -14,8 +17,18 @@ = SubscriptionStatus StatusOptions deriving stock (Eq, Show) -newtype StatusOptions = StatusOptions - { outputFormat :: OutputFormat +{- | The base URL of a running worker's @kiroku-metrics@ server (e.g. +@http://worker:9091@), used to query its @\/subscriptions@ endpoint. +-} +newtype RemoteEndpoint = RemoteEndpoint Text + deriving stock (Eq, Show) + +data StatusOptions = StatusOptions + { outputFormat :: !OutputFormat + , endpoint :: !(Maybe RemoteEndpoint) + {- ^ 'Nothing' = read the in-process registry (embeddable library); 'Just' = + query a remote worker over HTTP. + -} } deriving stock (Eq, Show) diff --git a/src/Kiroku/Cli/Parser.hs b/src/Kiroku/Cli/Parser.hs --- a/src/Kiroku/Cli/Parser.hs +++ b/src/Kiroku/Cli/Parser.hs @@ -5,6 +5,7 @@ ) where import Control.Applicative (optional) +import Data.Text qualified as T import Kiroku.Cli.Command (KirokuCommand (..)) import Kiroku.Cli.Command qualified as Command import Options.Applicative ( @@ -23,6 +24,7 @@ metavar, option, progDesc, + strOption, subparser, value, (<**>), @@ -62,6 +64,16 @@ <> metavar "table|json" <> value Command.OutputTable <> help "Render as a human table or script-friendly JSON." + ) + <*> optional + ( Command.RemoteEndpoint . T.pack + <$> strOption + ( long "remote-url" + <> metavar "URL" + <> help + "Query a running worker's kiroku-metrics /subscriptions endpoint \ + \(e.g. http://worker:9091) instead of this process's local registry." + ) ) parseOutputFormat :: String -> Either String Command.OutputFormat diff --git a/src/Kiroku/Cli/Run.hs b/src/Kiroku/Cli/Run.hs --- a/src/Kiroku/Cli/Run.hs +++ b/src/Kiroku/Cli/Run.hs @@ -7,7 +7,11 @@ import Data.Text (Text) import Data.Text.IO qualified as TIO import Kiroku.Cli.Command (KirokuCommand (..), StatusOptions (..), SubscriptionCommand (..)) -import Kiroku.Cli.Subscription.Status (renderSubscriptionStatusRows, subscriptionStatusRows) +import Kiroku.Cli.Subscription.Status ( + renderRemoteSubscriptionStatus, + renderSubscriptionStatusRows, + subscriptionStatusRows, + ) import Kiroku.Store (KirokuStore) import Kiroku.Store.Subscription (subscriptionStates) @@ -24,6 +28,11 @@ renderKirokuCommandWithStore :: KirokuStore -> KirokuCommand -> IO Text renderKirokuCommandWithStore _ KirokuNoCommand = pure "No Kiroku operator command was selected." -renderKirokuCommandWithStore store (KirokuSubscriptions (SubscriptionStatus (StatusOptions format))) = do - snapshot <- subscriptionStates store - pure (renderSubscriptionStatusRows format (subscriptionStatusRows snapshot)) +renderKirokuCommandWithStore store (KirokuSubscriptions (SubscriptionStatus (StatusOptions format endpoint))) = + case endpoint of + -- An optional remote override: a host can point the in-process command at + -- a sibling worker over HTTP instead of reading its own registry. + Just ep -> renderRemoteSubscriptionStatus ep format + Nothing -> do + snapshot <- subscriptionStates store + pure (renderSubscriptionStatusRows format (subscriptionStatusRows snapshot)) diff --git a/src/Kiroku/Cli/Standalone.hs b/src/Kiroku/Cli/Standalone.hs --- a/src/Kiroku/Cli/Standalone.hs +++ b/src/Kiroku/Cli/Standalone.hs @@ -7,112 +7,97 @@ runStandaloneCommand, ) where -import Control.Applicative (optional, (<|>)) -import Control.Lens ((&), (.~)) +import Control.Applicative ((<|>)) import Data.Generics.Labels () import Data.Text (Text) import Data.Text qualified as T -import Kiroku.Cli.Command (KirokuCommand (..), OutputFormat (..), StatusOptions (..), SubscriptionCommand (..)) +import GHC.Generics (Generic) +import Kiroku.Cli.Command ( + KirokuCommand (..), + RemoteEndpoint (..), + StatusOptions (..), + SubscriptionCommand (..), + ) import Kiroku.Cli.Parser (kirokuCommandParser) -import Kiroku.Cli.Subscription.Status (renderSubscriptionStatusRows, subscriptionStatusRows) -import Kiroku.Store (ConnectionSettings, KirokuStore, defaultConnectionSettings, withStore) -import Kiroku.Store.Subscription (subscriptionStates) +import Kiroku.Cli.Subscription.Status (renderRemoteSubscriptionStatus) import Options.Applicative ( Parser, ParserInfo, - auto, fullDesc, header, - help, helper, info, - long, - metavar, - option, progDesc, - strOption, - value, (<**>), ) -data StandaloneOptions = StandaloneOptions - { databaseUrl :: !(Maybe Text) - , schema :: !Text - , poolSize :: !Int - , standaloneCommand :: !KirokuCommand +{- | Options for the standalone @kiroku@ binary. The binary is a pure remote +client: it carries only the parsed command (whose @--remote-url@ lives inside +'StatusOptions'); it never opens a store. +-} +newtype StandaloneOptions = StandaloneOptions + { command :: KirokuCommand } - deriving stock (Eq, Show) + deriving stock (Generic, Eq, Show) -data StandaloneRuntime = StandaloneRuntime - { settings :: !ConnectionSettings - , runtimeCommand :: !KirokuCommand +{- | The resolved command, with any subscription-status endpoint filled in from +@--remote-url@ or @KIROKU_REMOTE_URL@. +-} +newtype StandaloneRuntime = StandaloneRuntime + { command :: KirokuCommand } + deriving stock (Generic) standaloneParserInfo :: ParserInfo StandaloneOptions standaloneParserInfo = info (standaloneOptionsParser <**> helper) ( fullDesc - <> progDesc "Run Kiroku operator commands against a store opened by this process. Subscription status reads this process-local live registry." - <> header "kiroku - operator commands for Kiroku event stores" + <> progDesc + "Inspect a running Kiroku worker over HTTP. Subscription status queries the worker's \ + \kiroku-metrics /subscriptions endpoint (--remote-url or KIROKU_REMOTE_URL); the binary \ + \opens no store of its own." + <> header "kiroku - remote operator client for Kiroku event stores" ) standaloneOptionsParser :: Parser StandaloneOptions standaloneOptionsParser = - StandaloneOptions - <$> optional - ( strOption - ( long "database-url" - <> metavar "URL" - <> help "PostgreSQL connection string. Defaults to KIROKU_DATABASE_URL." - ) - ) - <*> strOption - ( long "schema" - <> metavar "SCHEMA" - <> value "kiroku" - <> help "PostgreSQL schema that owns Kiroku objects." - ) - <*> option - auto - ( long "pool-size" - <> metavar "INT" - <> value 2 - <> help "Connection pool size for this operator command." - ) - <*> kirokuCommandParser + StandaloneOptions <$> kirokuCommandParser +{- | Resolve the parsed options into a runnable command. For a subscription-status +command, the endpoint is taken from @--remote-url@ or, failing that, the +@KIROKU_REMOTE_URL@ environment variable; if neither is present, fail with +guidance. Commands that need no endpoint pass through unchanged. +-} resolveStandaloneOptions :: [(String, String)] -> StandaloneOptions -> Either Text StandaloneRuntime -resolveStandaloneOptions env opts - | poolSize opts <= 0 = Left "kiroku: --pool-size must be greater than zero" - | otherwise = do - conn <- case databaseUrl opts <|> (T.pack <$> lookup "KIROKU_DATABASE_URL" env) of - Just connString | not (T.null connString) -> Right connString - _ -> Left "kiroku: missing database connection string; pass --database-url or set KIROKU_DATABASE_URL" - pure - StandaloneRuntime - { settings = - defaultConnectionSettings conn - & #schema .~ schema opts - & #poolSize .~ poolSize opts - , runtimeCommand = standaloneCommand opts - } +resolveStandaloneOptions env (StandaloneOptions cmd) = + case cmd of + KirokuNoCommand -> Right (StandaloneRuntime KirokuNoCommand) + KirokuSubscriptions (SubscriptionStatus (StatusOptions format mEndpoint)) -> + case mEndpoint <|> envEndpoint of + Just ep -> + Right + ( StandaloneRuntime + (KirokuSubscriptions (SubscriptionStatus (StatusOptions format (Just ep)))) + ) + Nothing -> Left noEndpointMessage + where + envEndpoint = + case T.pack <$> lookup "KIROKU_REMOTE_URL" env of + Just url | not (T.null url) -> Just (RemoteEndpoint url) + _ -> Nothing + noEndpointMessage = + "kiroku: no worker endpoint; pass --remote-url or set KIROKU_REMOTE_URL. \ + \The standalone binary inspects a running worker over HTTP; it cannot see \ + \in-process subscriptions because it runs none." runStandaloneCommand :: StandaloneRuntime -> IO Text -runStandaloneCommand runtime = - withStore (settings runtime) $ \store -> - renderStandaloneCommand store (runtimeCommand runtime) - -renderStandaloneCommand :: KirokuStore -> KirokuCommand -> IO Text -renderStandaloneCommand _ KirokuNoCommand = - pure "No Kiroku operator command was selected." -renderStandaloneCommand store (KirokuSubscriptions (SubscriptionStatus (StatusOptions format))) = do - snapshot <- subscriptionStates store - let rows = subscriptionStatusRows snapshot - rendered = renderSubscriptionStatusRows format rows - pure $ - case (format, rows) of - (OutputTable, []) -> - rendered - <> "No live subscriptions in this process-local registry. Standalone status cannot inspect subscriptions running in another service process." - _ -> rendered +runStandaloneCommand (StandaloneRuntime cmd) = + case cmd of + KirokuNoCommand -> pure "No Kiroku operator command was selected." + KirokuSubscriptions (SubscriptionStatus (StatusOptions format (Just ep))) -> + renderRemoteSubscriptionStatus ep format + KirokuSubscriptions (SubscriptionStatus (StatusOptions _ Nothing)) -> + -- Unreachable: resolveStandaloneOptions fills the endpoint or fails. + pure + "kiroku: no worker endpoint; pass --remote-url or set KIROKU_REMOTE_URL." diff --git a/src/Kiroku/Cli/Subscription/Status.hs b/src/Kiroku/Cli/Subscription/Status.hs --- a/src/Kiroku/Cli/Subscription/Status.hs +++ b/src/Kiroku/Cli/Subscription/Status.hs @@ -2,10 +2,15 @@ SubscriptionStatusRow (..), renderSubscriptionStatusRows, subscriptionStatusRows, + fetchRemoteSubscriptionStatusRows, + renderRemoteSubscriptionStatus, ) where +import Control.Exception (SomeException, try) +import Control.Lens ((^.)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as LBS +import Data.Generics.Labels () import Data.Int (Int32, Int64) import Data.List (sortOn) import Data.Map.Strict (Map) @@ -13,22 +18,56 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as TE -import Kiroku.Cli.Command (OutputFormat (..)) +import GHC.Generics (Generic) +import Kiroku.Cli.Command (OutputFormat (..), RemoteEndpoint (..)) import Kiroku.Store.Subscription (SubscriptionStateView (..)) import Kiroku.Store.Subscription.Types (SubscriptionName (..)) import Kiroku.Store.Types (GlobalPosition (..)) +import Network.HTTP.Client ( + Request, + Response, + httpLbs, + newManager, + parseRequest, + responseBody, + responseStatus, + ) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types.Status (statusCode) data SubscriptionStatusRow = SubscriptionStatusRow - { rowSubscription :: !Text - , rowMember :: !Int32 - , rowPhase :: !Text - , rowGlobalPosition :: !Int64 + { subscription :: !Text + , member :: !Int32 + , phase :: !Text + , globalPosition :: !Int64 } - deriving stock (Eq, Show) + deriving stock (Generic, Eq, Show) +{- | The IP-5 wire contract: a JSON object with keys @subscription@, @member@, +@phase@, @global_position@. This is the single source of truth shared by the +@kiroku-metrics@ @\/subscriptions@ endpoint (which encodes) and the CLI remote +client (which decodes). +-} +instance Aeson.ToJSON SubscriptionStatusRow where + toJSON row = + Aeson.object + [ "subscription" Aeson..= (row ^. #subscription) + , "member" Aeson..= (row ^. #member) + , "phase" Aeson..= (row ^. #phase) + , "global_position" Aeson..= (row ^. #globalPosition) + ] + +instance Aeson.FromJSON SubscriptionStatusRow where + parseJSON = Aeson.withObject "SubscriptionStatusRow" $ \o -> + SubscriptionStatusRow + <$> o Aeson..: "subscription" + <*> o Aeson..: "member" + <*> o Aeson..: "phase" + <*> o Aeson..: "global_position" + subscriptionStatusRows :: Map (SubscriptionName, Int32) SubscriptionStateView -> [SubscriptionStatusRow] subscriptionStatusRows = - sortOn (\row -> (rowSubscription row, rowMember row)) + sortOn (\row -> (row ^. #subscription, row ^. #member)) . fmap toRow . Map.elems where @@ -36,10 +75,10 @@ let SubscriptionName name = subscriptionName view GlobalPosition position = cursor view in SubscriptionStatusRow - { rowSubscription = name - , rowMember = member view - , rowPhase = statePhase view - , rowGlobalPosition = position + { subscription = name + , member = view ^. #member + , phase = view ^. #statePhase + , globalPosition = position } renderSubscriptionStatusRows :: OutputFormat -> [SubscriptionStatusRow] -> Text @@ -57,17 +96,17 @@ <> " " <> pad phaseWidth "PHASE" <> " GLOBAL_POSITION" - subWidth = columnWidth "SUBSCRIPTION" (fmap rowSubscription rows) - memberWidth = columnWidth "MEMBER" (fmap (T.pack . show . rowMember) rows) - phaseWidth = columnWidth "PHASE" (fmap rowPhase rows) + subWidth = columnWidth "SUBSCRIPTION" (fmap (^. #subscription) rows) + memberWidth = columnWidth "MEMBER" (fmap (T.pack . show . (^. #member)) rows) + phaseWidth = columnWidth "PHASE" (fmap (^. #phase) rows) renderRow row = - pad subWidth (rowSubscription row) + pad subWidth (row ^. #subscription) <> " " - <> pad memberWidth (T.pack (show (rowMember row))) + <> pad memberWidth (T.pack (show (row ^. #member))) <> " " - <> pad phaseWidth (rowPhase row) + <> pad phaseWidth (row ^. #phase) <> " " - <> T.pack (show (rowGlobalPosition row)) + <> T.pack (show (row ^. #globalPosition)) columnWidth :: Text -> [Text] -> Int columnWidth label values = @@ -82,12 +121,43 @@ TE.decodeUtf8 . LBS.toStrict . Aeson.encode - . fmap rowJson + +{- | Fetch a running worker's @\/subscriptions@ endpoint and decode the rows. +GETs @\/subscriptions@ (trimming a trailing slash on the base), and on a +2xx response decodes @[SubscriptionStatusRow]@ via the shared 'Aeson.FromJSON'. +Non-2xx responses, connection failures, and decode errors are returned as a +readable 'Left' message rather than thrown. +-} +fetchRemoteSubscriptionStatusRows :: RemoteEndpoint -> IO (Either Text [SubscriptionStatusRow]) +fetchRemoteSubscriptionStatusRows (RemoteEndpoint base) = do + let url = T.unpack (T.dropWhileEnd (== '/') base) <> "/subscriptions" + reqResult <- try (parseRequest url) :: IO (Either SomeException Request) + case reqResult of + Left err -> pure (Left ("kiroku: invalid --remote-url " <> T.pack url <> ": " <> T.pack (show err))) + Right req -> do + manager <- newManager tlsManagerSettings + respResult <- try (httpLbs req manager) :: IO (Either SomeException (Response LBS.ByteString)) + pure $ case respResult of + Left err -> Left ("kiroku: could not reach " <> T.pack url <> ": " <> T.pack (show err)) + Right resp -> decodeResponse url resp where - rowJson row = - Aeson.object - [ "subscription" Aeson..= rowSubscription row - , "member" Aeson..= rowMember row - , "phase" Aeson..= rowPhase row - , "global_position" Aeson..= rowGlobalPosition row - ] + decodeResponse :: String -> Response LBS.ByteString -> Either Text [SubscriptionStatusRow] + decodeResponse url resp = + let code = statusCode (responseStatus resp) + in if code >= 200 && code < 300 + then case Aeson.eitherDecode (responseBody resp) of + Right rows -> Right rows + Left decodeErr -> + Left ("kiroku: could not decode response from " <> T.pack url <> ": " <> T.pack decodeErr) + else + Left ("kiroku: " <> T.pack url <> " returned HTTP " <> T.pack (show code)) + +{- | Fetch and render a remote worker's subscription status, reusing the same +table/JSON renderer the in-process command uses. On error, returns the error text. +-} +renderRemoteSubscriptionStatus :: RemoteEndpoint -> OutputFormat -> IO Text +renderRemoteSubscriptionStatus ep format = do + result <- fetchRemoteSubscriptionStatusRows ep + pure $ case result of + Left err -> err + Right rows -> renderSubscriptionStatusRows format rows diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,16 +1,14 @@ module Main where import Control.Concurrent (threadDelay) -import Control.Lens ((^.)) import Data.Aeson qualified as Aeson -import Data.Generics.Labels () import Data.Int (Int32, Int64) import Data.List (isInfixOf) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as T import Kiroku.Cli (KirokuCommand (..), kirokuParserInfo, kirokuSubparser, renderKirokuCommandWithStore) -import Kiroku.Cli.Command (OutputFormat (..), StatusOptions (..), SubscriptionCommand (..)) +import Kiroku.Cli.Command (OutputFormat (..), RemoteEndpoint (..), StatusOptions (..), SubscriptionCommand (..)) import Kiroku.Cli.Standalone (StandaloneOptions (..), StandaloneRuntime (..), resolveStandaloneOptions, runStandaloneCommand, standaloneParserInfo) import Kiroku.Cli.Subscription.Status (SubscriptionStatusRow (..), renderSubscriptionStatusRows, subscriptionStatusRows) import Kiroku.Store @@ -20,7 +18,6 @@ Parser, ParserInfo, ParserResult (..), - command, defaultPrefs, execParserPure, fullDesc, @@ -31,6 +28,7 @@ subparser, (<**>), ) +import Options.Applicative qualified as Options import Test.Hspec data HostCommand @@ -49,15 +47,23 @@ it "parses subscriptions status with the default table format" $ do case execParserPure defaultPrefs kirokuParserInfo ["subscriptions", "status"] of Success parsed -> - parsed `shouldBe` KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable)) + parsed `shouldBe` KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable Nothing)) other -> expectationFailure ("expected parser success, got " <> renderedHelp other) it "parses subscriptions status with JSON output" $ do case execParserPure defaultPrefs kirokuParserInfo ["subscriptions", "status", "--format", "json"] of Success parsed -> - parsed `shouldBe` KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson)) + parsed `shouldBe` KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson Nothing)) other -> expectationFailure ("expected parser success, got " <> renderedHelp other) + it "parses subscriptions status with a remote URL" $ do + case execParserPure defaultPrefs kirokuParserInfo ["subscriptions", "status", "--remote-url", "http://worker:9091"] of + Success parsed -> + parsed + `shouldBe` KirokuSubscriptions + (SubscriptionStatus (StatusOptions OutputTable (Just (RemoteEndpoint "http://worker:9091")))) + other -> expectationFailure ("expected parser success, got " <> renderedHelp other) + it "renders status help" $ do let result = execParserPure defaultPrefs kirokuParserInfo ["subscriptions", "status", "--help"] renderedHelp result `shouldSatisfy` isInfixOf "List live subscription phases" @@ -71,62 +77,95 @@ it "parses a nested subscription status command" $ do case execParserPure defaultPrefs hostParserInfo ["kiroku", "subscriptions", "status", "--format", "json"] of Success parsed -> - parsed `shouldBe` HostKiroku (KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson))) + parsed `shouldBe` HostKiroku (KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson Nothing))) other -> expectationFailure ("expected parser success, got " <> renderedHelp other) it "renders nested help under a host command parser" $ do let result = execParserPure defaultPrefs hostParserInfo ["kiroku", "--help"] renderedHelp result `shouldSatisfy` isInfixOf "Run Kiroku operator commands." - describe "standaloneParserInfo" $ do - it "parses process options separately from the Kiroku command" $ do - case execParserPure defaultPrefs standaloneParserInfo ["--database-url", "postgres://flag", "--schema", "ops", "--pool-size", "3", "subscriptions", "status", "--format", "json"] of + describe "standaloneParserInfo (remote client)" $ do + it "parses a status command with a remote URL and format" $ do + case execParserPure defaultPrefs standaloneParserInfo ["subscriptions", "status", "--remote-url", "http://worker:9091", "--format", "json"] of Success parsed -> parsed `shouldBe` StandaloneOptions - { databaseUrl = Just "postgres://flag" - , schema = "ops" - , poolSize = 3 - , standaloneCommand = KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson)) + { command = + KirokuSubscriptions + (SubscriptionStatus (StatusOptions OutputJson (Just (RemoteEndpoint "http://worker:9091")))) } other -> expectationFailure ("expected parser success, got " <> renderedHelp other) - it "resolves database URL from the environment when the flag is absent" $ do - case execParserPure defaultPrefs standaloneParserInfo ["subscriptions", "status"] of - Success parsed -> - case resolveStandaloneOptions [("KIROKU_DATABASE_URL", "postgres://env")] parsed of - Right StandaloneRuntime{settings = settings, runtimeCommand = parsedCommand} -> do - settings ^. #connString `shouldBe` "postgres://env" - settings ^. #schema `shouldBe` "kiroku" - settings ^. #poolSize `shouldBe` 2 - parsedCommand `shouldBe` KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable)) - Left err -> expectationFailure ("expected resolved runtime, got " <> show err) - other -> expectationFailure ("expected parser success, got " <> renderedHelp other) + it "no longer accepts --database-url" $ do + case execParserPure defaultPrefs standaloneParserInfo ["--database-url", "postgres://x", "subscriptions", "status"] of + Success _ -> expectationFailure "expected --database-url to be rejected" + _ -> pure () - it "lets --database-url override the environment and rejects invalid pool sizes" $ do + it "resolves the endpoint from --remote-url" $ do let opts = StandaloneOptions - { databaseUrl = Just "postgres://flag" - , schema = "ops" - , poolSize = 0 - , standaloneCommand = KirokuNoCommand + { command = + KirokuSubscriptions + (SubscriptionStatus (StatusOptions OutputTable (Just (RemoteEndpoint "http://flag:9091")))) } - case resolveStandaloneOptions [("KIROKU_DATABASE_URL", "postgres://env")] opts of - Left err -> err `shouldBe` "kiroku: --pool-size must be greater than zero" - Right _ -> expectationFailure "expected invalid pool size to fail" + case resolveStandaloneOptions [("KIROKU_REMOTE_URL", "http://env:9091")] opts of + Right (StandaloneRuntime{command = KirokuSubscriptions (SubscriptionStatus (StatusOptions _ endpoint))}) -> + endpoint `shouldBe` Just (RemoteEndpoint "http://flag:9091") + other -> expectationFailure ("expected resolved remote runtime, got " <> show' other) - it "requires a database URL from either flag or environment" $ do + it "falls back to KIROKU_REMOTE_URL when no flag is given" $ do let opts = StandaloneOptions - { databaseUrl = Nothing - , schema = "kiroku" - , poolSize = 2 - , standaloneCommand = KirokuNoCommand + { command = KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable Nothing)) } + case resolveStandaloneOptions [("KIROKU_REMOTE_URL", "http://env:9091")] opts of + Right (StandaloneRuntime{command = KirokuSubscriptions (SubscriptionStatus (StatusOptions _ endpoint))}) -> + endpoint `shouldBe` Just (RemoteEndpoint "http://env:9091") + other -> expectationFailure ("expected resolved remote runtime, got " <> show' other) + + it "errors with guidance when no endpoint is given" $ do + let opts = + StandaloneOptions + { command = KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable Nothing)) + } case resolveStandaloneOptions [] opts of - Left err -> err `shouldBe` "kiroku: missing database connection string; pass --database-url or set KIROKU_DATABASE_URL" - Right _ -> expectationFailure "expected missing database URL to fail" + Left err -> T.unpack err `shouldSatisfy` isInfixOf "no worker endpoint" + Right _ -> expectationFailure "expected missing endpoint to fail" + it "reports an unreachable endpoint as a readable error, not an exception" $ do + let opts = + StandaloneOptions + { command = + -- 127.0.0.1:1 is reserved and refuses connections. + KirokuSubscriptions + (SubscriptionStatus (StatusOptions OutputTable (Just (RemoteEndpoint "http://127.0.0.1:1")))) + } + case resolveStandaloneOptions [] opts of + Right runtime -> do + output <- runStandaloneCommand runtime + T.unpack output `shouldSatisfy` isInfixOf "could not reach" + Left err -> expectationFailure ("expected resolved runtime, got " <> T.unpack err) + + describe "SubscriptionStatusRow codec (IP-5 wire contract)" $ do + it "round-trips through encode/decode" $ do + let rows = + [ SubscriptionStatusRow "alpha" 0 "catching_up" 7 + , SubscriptionStatusRow "beta" 1 "live" 9223372036854775807 + , SubscriptionStatusRow "gamma" 2 "reconnecting" 0 + ] + Aeson.decode (Aeson.encode rows) `shouldBe` Just rows + + it "uses the exact wire keys" $ do + Aeson.decode (Aeson.encode (SubscriptionStatusRow "alpha" 0 "live" 12)) + `shouldBe` Just + ( Aeson.object + [ "subscription" Aeson..= ("alpha" :: Text) + , "member" Aeson..= (0 :: Int) + , "phase" Aeson..= ("live" :: Text) + , "global_position" Aeson..= (12 :: Int) + ] + ) + describe "subscriptionStatusRows" $ do it "sorts rows and extracts public scalar fields" $ do subscriptionStatusRows @@ -170,7 +209,7 @@ output <- renderKirokuCommandWithStore store - (KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable))) + (KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable Nothing))) output `shouldSatisfy` T.isInfixOf "cli-registry" output `shouldSatisfy` T.isInfixOf "live" output `shouldSatisfy` T.isInfixOf "0" @@ -178,26 +217,9 @@ it "runs nested Kiroku commands through a host command wrapper" $ withTestStore $ \store -> do - output <- runHostCommand store (HostKiroku (KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson)))) + output <- runHostCommand store (HostKiroku (KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputJson Nothing)))) output `shouldBe` "[]" - describe "runStandaloneCommand" $ do - it "opens a migrated store and reports an empty process-local registry successfully" $ - withMigratedTestDatabase $ \connStr -> do - let opts = - StandaloneOptions - { databaseUrl = Just connStr - , schema = "kiroku" - , poolSize = 2 - , standaloneCommand = KirokuSubscriptions (SubscriptionStatus (StatusOptions OutputTable)) - } - case resolveStandaloneOptions [] opts of - Left err -> expectationFailure ("expected resolved runtime, got " <> show err) - Right runtime -> do - output <- runStandaloneCommand runtime - output `shouldSatisfy` T.isInfixOf "SUBSCRIPTION" - output `shouldSatisfy` T.isInfixOf "No live subscriptions in this process-local registry" - hostParserInfo :: ParserInfo HostCommand hostParserInfo = info @@ -207,7 +229,7 @@ hostCommandParser :: Parser HostCommand hostCommandParser = subparser - ( command + ( Options.command "host" (info (pure HostOnly) (progDesc "Run a host-only command.")) <> kirokuSubparser HostKiroku @@ -226,6 +248,11 @@ "" renderedHelp (CompletionInvoked _) = "" + +-- | 'StandaloneRuntime' has no 'Show'; describe a resolved/failed result for test messages. +show' :: Either Text StandaloneRuntime -> String +show' (Left err) = "Left " <> T.unpack err +show' (Right _) = "Right " view :: Text -> Int32 -> Text -> Int64 -> SubscriptionStateView view name member phase position =