packages feed

plexus-synapse 4.0.0 → 4.1.0

raw patch · 36 files changed

+164/−1258 lines, 36 filesdep ~aesondep ~plexus-protocolPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, plexus-protocol

API changes (from Hackage documentation)

- Synapse.Bidir: BidirAutoCancel :: BidirMode
- Synapse.Bidir: BidirCmd :: Text -> BidirMode
- Synapse.Bidir: BidirDefaults :: BidirMode
- Synapse.Bidir: BidirInteractive :: BidirMode
- Synapse.Bidir: BidirJson :: BidirMode
- Synapse.Bidir: BidirRespond :: BidirMode
- Synapse.Bidir: data BidirMode
- Synapse.Bidir: defaultBidirMode :: BidirMode
- Synapse.Bidir: detectBidirMode :: IO BidirMode
- Synapse.Bidir: handleBidirRequest :: BidirMode -> Maybe Value -> Text -> Request Value -> IO (Maybe (Response Value))
- Synapse.Bidir: instance GHC.Classes.Eq Synapse.Bidir.BidirMode
- Synapse.Bidir: instance GHC.Show.Show Synapse.Bidir.BidirMode
- Synapse.Bidir: isTTY :: IO Bool
- Synapse.Bidir: parseBidirMode :: Text -> Maybe BidirMode
- Synapse.Bidir: type BidirHandler = Text -> Request Value -> IO Maybe Response Value
- Synapse.IR.Types: [mdBidirResponseSchema] :: MethodDef -> Maybe Value
- Synapse.IR.Types: [mdBidirResponseType] :: MethodDef -> Maybe TypeRef
- Synapse.IR.Types: [mdBidirType] :: MethodDef -> Maybe TypeRef
- Synapse.Log: SubsystemBidir :: Subsystem
- Synapse.Output: promptHandle :: IO Handle
- Synapse.Schema.Types: Cancelled :: Response t
- Synapse.Schema.Types: Confirm :: Text -> Maybe Bool -> Request t
- Synapse.Schema.Types: Confirmed :: Bool -> Response t
- Synapse.Schema.Types: Prompt :: Text -> Maybe t -> Maybe Text -> Request t
- Synapse.Schema.Types: Select :: Text -> [SelectOption t] -> Bool -> Request t
- Synapse.Schema.Types: SelectOption :: t -> Text -> Maybe Text -> SelectOption t
- Synapse.Schema.Types: Selected :: [t] -> Response t
- Synapse.Schema.Types: Value :: t -> Response t
- Synapse.Schema.Types: [confirmDefault] :: Request t -> Maybe Bool
- Synapse.Schema.Types: [confirmMessage] :: Request t -> Text
- Synapse.Schema.Types: [confirmedValue] :: Response t -> Bool
- Synapse.Schema.Types: [methodBidirectional] :: MethodSchema -> Bool
- Synapse.Schema.Types: [methodRequestType] :: MethodSchema -> Maybe Value
- Synapse.Schema.Types: [methodResponseType] :: MethodSchema -> Maybe Value
- Synapse.Schema.Types: [optionDescription] :: SelectOption t -> Maybe Text
- Synapse.Schema.Types: [optionLabel] :: SelectOption t -> Text
- Synapse.Schema.Types: [optionValue] :: SelectOption t -> t
- Synapse.Schema.Types: [promptDefault] :: Request t -> Maybe t
- Synapse.Schema.Types: [promptMessage] :: Request t -> Text
- Synapse.Schema.Types: [promptPlaceholder] :: Request t -> Maybe Text
- Synapse.Schema.Types: [responseValue] :: Response t -> t
- Synapse.Schema.Types: [selectMessage] :: Request t -> Text
- Synapse.Schema.Types: [selectMulti] :: Request t -> Bool
- Synapse.Schema.Types: [selectOptions] :: Request t -> [SelectOption t]
- Synapse.Schema.Types: [selectedValues] :: Response t -> [t]
- Synapse.Schema.Types: data Request t
- Synapse.Schema.Types: data Response t
- Synapse.Schema.Types: data SelectOption t
- Synapse.Schema.Types: pattern ServiceRequest :: Text -> Provenance -> Text -> Request Value -> Maybe Int -> ServiceStreamItem
- Synapse.Schema.Types: type StandardRequest = Request Value
- Synapse.Schema.Types: type StandardResponse = Response Value
- Synapse.Transport: invokeStreamingWithBidir :: CallShape -> IO (Maybe Headers) -> (Resumed -> IO ()) -> Path -> Text -> Value -> (ServiceStreamItem -> IO ()) -> (Text -> Request Value -> IO (Maybe (Response Value))) -> SynapseM ()
- Synapse.Transport: sendResponse :: Text -> Response Value -> SynapseM ()
+ Synapse.Transport: invokeStreamingCall :: CallShape -> IO (Maybe Headers) -> (Resumed -> IO ()) -> Path -> Text -> Value -> (ServiceStreamItem -> IO ()) -> SynapseM ()
- Synapse.IR.Types: MethodDef :: Text -> Text -> Text -> Maybe Text -> [ParamDef] -> TypeRef -> Maybe TypeRef -> Maybe TypeRef -> Cardinality -> Maybe TypeRef -> Maybe TypeRef -> Maybe Value -> MethodRole -> Maybe Text -> Maybe Text -> Maybe Text -> [InjectedParam] -> Maybe TypeRef -> MethodDef
+ Synapse.IR.Types: MethodDef :: Text -> Text -> Text -> Maybe Text -> [ParamDef] -> TypeRef -> Maybe TypeRef -> Maybe TypeRef -> Cardinality -> MethodRole -> Maybe Text -> Maybe Text -> Maybe Text -> [InjectedParam] -> Maybe TypeRef -> MethodDef
- Synapse.Schema.Types: MethodSchema :: Text -> Text -> PluginHash -> Maybe Value -> Value -> Maybe Value -> Maybe Value -> Cardinality -> Bool -> Text -> Maybe Value -> Maybe Value -> Maybe DeprecationInfo -> Maybe [ParamSchema] -> MethodRole -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe [Text] -> Bool -> Maybe Text -> [MethodExample] -> Maybe Value -> MethodSchema
+ Synapse.Schema.Types: MethodSchema :: Text -> Text -> PluginHash -> Maybe Value -> Value -> Maybe Value -> Maybe Value -> Cardinality -> Text -> Maybe DeprecationInfo -> Maybe [ParamSchema] -> MethodRole -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe [Text] -> Bool -> Maybe Text -> [MethodExample] -> Maybe Value -> MethodSchema

Files

CHANGELOG.md view
@@ -1,5 +1,32 @@ # Changelog for plexus-synapse +## 4.1.0++bidir removed (ASK-1, ASK-3); plexus 0.10's schemas read (NEST-10). Breaking+under the PVP.++### Breaking++- **bidir is gone.** `--bidir-mode`, `--bidir-cmd`, `--bidir-respond`, the+  `respond` subcommand and `Synapse.Bidir` are removed, with spec/08's+  `request` item and `{ns}.respond` (plexus-protocol 0.7). Nothing replaces+  them: synapse has no in-call or protocol-wide confirmation, and an item a+  service names `needs_input` is printed like any other. IR 3.1 is 3.0+  without `mdBidirType` / `mdBidirResponseType` / `mdBidirResponseSchema`+  (an older IR's are read past). Requires `plexus-protocol >= 0.7`.+- **Holder protocol 6.** The connection holder's socket is+  `$XDG_RUNTIME_DIR/synapse/holder-6.sock` (4 carried the input half; 5 was+  VISION-7's unmerged question routing, never reused; 6 relays plexus-protocol+  0.7's items, with no `request` item, and routes nothing). A run never uses+  or replaces a holder of another protocol (3.x's `holder-2.sock`, 4.0.0's+  `holder-4.sock`), nor the reverse; they run side by side.++### Changed++- plexus-core 0.10's `MethodRole` is read whole: a peer slot is a+  `static_child` marked `peer` with its `interface` (NEST-7), and a+  `dynamic_child` carries its slot's type, `child` (NEST-5).+ ## 4.0.0  Everything since 3.17.3 (3.17.4 was never published; its change is listed here).
README.md view
@@ -202,7 +202,7 @@  **Everything rides the same address**: the `_info` probe, calls, streams and their reconnects (SYNAPSE-20 — the outage line names the URL), `-s`, `-i`,-`_find`, bidirectional requests and their `respond`, `_login` / `_logout` and the+`_find`, `_login` / `_logout` and the session every later call carries. The upgrade's `Host` is the host alone on 443 (`host:port` otherwise). A registry lists plain `ws://HOST:PORT` backends, so an address behind TLS or on a path is never auto-registered: name it each time,@@ -351,7 +351,7 @@ | `--body VALUE` | the next argument is the value, whatever it begins with: `---`, `--force`, `-5`, `--`, or nothing (`''`) | | `--body=VALUE` | everything after the first `=`, which may be empty or contain `=` | | `--body @body.md` | the file's contents, UTF-8, exactly as they are (3.14.8, SYNAPSE-10): no argument carries the value, so a body may be as large as the backend accepts; `~/` and a relative path resolve as the shell's would; a file that cannot be read is a refusal naming the flag and the path |-| `--body -` | standard input, read once however many values ask for it; it cannot be combined with `--bidir-mode json`, which reads stdin too |+| `--body -` | standard input, read once however many values ask for it | | `--handle @@alice` | the text `@alice`: one `@` is dropped, so a value that really begins with `@` can still be sent | | `--summary` (a boolean) | `true`; it takes the next argument only when that is `true` or `false` (or `1`, `0`), so `--summary --limit 3` is two flags | | `--summary=false` | `false` |@@ -538,11 +538,9 @@ - A stream (`watch`) has no end: its items are appended to FILE and flushed   as each comes. A stream that fails keeps what it wrote. - A write's answer is written whole, whoever reads it.-- What must be seen while the call waits goes to **stderr**, not FILE: a-  two-way request (the interactive prompt, `--bidir-mode json`'s and-  `respond`'s request lines — the answer still goes to FILE), and under-  `-j` an error or a refusal (its `-j` line goes with the failed run's FILE,-  so a refused call says why on stderr and exits 77).+- Under `-j` an error or a refusal goes to **stderr**, not FILE (its `-j`+  line goes with the failed run's FILE, so a refused call says why on stderr+  and exits 77). - `-o -` is stdout. A FILE that cannot be made (no such directory, a   directory) is said on stderr and the run **exits 73** before anything is   sent; a write to it that fails later (a full disk, a file size limit) is@@ -575,7 +573,7 @@  - **A read is sent again; a write is not.** A method is a read when its   schema's `group` is `read` (else when its name is a read's: `get`, `list`,-  `watch`, …); anything else, and anything bidirectional, is a write. A+  `watch`, …); anything else is a write. A   write whose request went out before the connection was lost may have   happened, so synapse says so and **exits 75** (`connection to … lost   before an answer — the write may have happened; check before sending it@@ -644,7 +642,7 @@ - **A connection held between runs**, as ssh's ControlMaster holds one. The   first call starts a holder (`synapse _hold`, a process of synapse's own)   that keeps the signed-in WebSocket open and listens on a unix socket:-  `$XDG_RUNTIME_DIR/synapse/holder-4.sock` (0600, in a 0700 directory of+  `$XDG_RUNTIME_DIR/synapse/holder-6.sock` (0600, in a 0700 directory of   yours). Later runs hand it their requests and read the replies back, so   the TCP, TLS and upgrade handshakes (about 0.3 s to a hosted service) are   paid once. Since 3.17.4 it is **one holder for all your calls**@@ -703,7 +701,7 @@ throwaway servers on fresh ports left one per port, 1,634 of them (24.9 GB) on 2026-11-02. Now one process holds every connection your runs keep, however many services and agents you call — `synapse _hold`, at-`$XDG_RUNTIME_DIR/synapse/holder-4.sock` — and inside it a connection per+`$XDG_RUNTIME_DIR/synapse/holder-6.sock` — and inside it a connection per address, agent and credential. A call as one agent never rides another agent's connection, even when neither carries a credential; a session made again from the key is a connection beside the old one, which closes once@@ -815,16 +813,17 @@ $ synapse --emit-ir <backend> conformance > conformance.ir.json ``` -IR 3.0 (plexus 0.7) carries each method's contract as its schema states it:-its item type (`mdReturns`), its error type when it can say no (`mdError`),-its progress type when it reports progress (`mdProgress`), and whether it-yields one item or many (`mdCardinality`). An excerpt of RETURNS-7's+IR 3.1 (plexus 0.7; 3.1 is 3.0 without the bidir keys, ASK-1) carries each+method's contract as its schema states it: its item type (`mdReturns`), its+error type when it can say no (`mdError`), its progress type when it reports+progress (`mdProgress`), and whether it yields one item or many+(`mdCardinality`); 3.0's `mdBidir*` are gone and read past. An excerpt of RETURNS-7's conformance fixture, whose whole IR is `plexus-macros/fixtures/conformance/expected/ir.json`:  ```json {-  "irVersion": "3.0",+  "irVersion": "3.1",   "irTypes": {     "conformance.Loaded": {       "tdKind": {"tag": "KindStruct", "ksFields": [
app/Main.hs view
@@ -76,8 +76,6 @@ import qualified Synapse.CLI.Template as TemplateIR import Synapse.Deprecation (emitActivationWarning, emitMethodWarning) import Synapse.Transport-import Synapse.Bidir (BidirMode(..), parseBidirMode, detectBidirMode, handleBidirRequest)-import Plexus.Types (Response(..)) import Synapse.CLI.Transform (TransformEnv(..), mkTransformEnv, transformParams, defaultTransformers, injectBooleanDefaults, injectSmartDefaults) import Synapse.CLI.Source (SourceEnv, mkSourceEnv, expandSources, expandValue, stdinWasRead, renderSourceError) import Synapse.IR.Builder (buildIR)@@ -131,8 +129,6 @@   , soParams        :: Maybe Text    -- ^ JSON params via -p   , soRpc           :: Maybe Text    -- ^ Raw JSON-RPC passthrough   , soGeneratorInfo :: [Text]        -- ^ Generator tool info (tool:version pairs)-  , soBidirMode     :: Maybe Text    -- ^ Bidirectional mode override-  , soBidirCmd      :: Maybe Text    -- ^ Bidirectional subprocess command (--bidir-cmd)   , soNoCache       :: Bool          -- ^ Disable IR caching   , soLogLevel      :: Maybe Text    -- ^ Log level: info, debug, trace   , soLogSubsystems :: [Text]        -- ^ Filter logs by subsystems (empty = all)@@ -1156,12 +1152,8 @@           sourcedParams <- if helpRequested then pure rawParams else keepStreamFlags rawParams           inlineParams <- liftIO $ transformParams transformEnv defaultTransformers sourcedParams -          -- Mode 1.5: Respond subcommand (agent sends a response to a pending bidir request)-          if not (null pathSegs) && head pathSegs == "respond"-            then expandStreamFlags sourcedParams >>= handleRespondCommand-           -- Mode 2: Schema request-          else if soSchema+          if soSchema             then do               -- Try to navigate and determine if last segment is a method               schemaResult <- fetchSchemaForPath pathSegs@@ -1496,18 +1488,6 @@             }       liftIO $ TIO.putStr (renderAnonymousPage page) -    handleRespondCommand :: [(Text, Text)] -> SynapseM ()-    handleRespondCommand params = do-      let mRequestId = lookup "request_id" params-          mResponseStr = lookup "response" params-      case (mRequestId, mResponseStr) of-        (Nothing, _) -> throwParse "Missing --request-id for respond subcommand"-        (_, Nothing) -> throwParse "Missing --response for respond subcommand"-        (Just requestId, Just responseStr) ->-          case eitherDecode (LBS.fromStrict $ TE.encodeUtf8 responseStr) of-            Left err -> throwParse $ "Invalid --response JSON: " <> T.pack err-            Right (resp :: Response Value) -> sendResponse requestId resp-     -- BIDIR-18: what an input call reads and how: the flag's name, the     -- item's kind, the chunk, --progress, the source. No stream named is     -- refused before anything is sent, naming the flag.@@ -1535,22 +1515,9 @@       let methodName' = last path       -- Set method path hint for template resolution       let rendererCfg' = withMethodPath rendererCfg path-      -- Determine bidirectional mode (--bidir-cmd takes precedence)-      bidirMode <- liftIO $ case soBidirCmd of-        Just cmd -> pure $ BidirCmd cmd-        Nothing  -> case soBidirMode of-          Just modeStr -> case parseBidirMode modeStr of-            Just mode -> pure mode-            Nothing -> do-              TIO.hPutStrLn stderr $ "[synapse] Unknown --bidir-mode: " <> modeStr <> ", using auto-detect"-              detectBidirMode-          Nothing -> detectBidirMode-      -- SYNAPSE-10: a value read from stdin (-) has taken it; the JSON-      -- bidirectional mode reads stdin too, and the two cannot share+      -- SYNAPSE-10: a value read from stdin (-) has taken it; an input+      -- stream cannot read it too       stdinTaken <- liftIO $ stdinWasRead srcEnv-      case bidirMode of-        BidirJson | stdinTaken -> throwParse "a value was read from stdin (-), so --bidir-mode json cannot read it too; answer the backend's requests with --bidir-cmd, or use a file (@FILE) for the value"-        _ -> pure ()       -- IDENTITY-43: while the stored session could still be made again,       -- a "you have signed out" answered before anything else is held back       -- for 'run' to log in again and retry.@@ -1619,16 +1586,8 @@         invokeWithInput (Reconnect.callShape method) refreshAuth kind chunk progress src           namespacePath methodName' params printer'        Nothing ->-        -- Use bidirectional streaming handler-        invokeStreamingWithBidir-        (Reconnect.callShape method)-        refreshAuth-        resumed-        namespacePath-        methodName'-        params-        printer-        (handleBidirRequest bidirMode Nothing)+        invokeStreamingCall (Reconnect.callShape method) refreshAuth resumed+          namespacePath methodName' params printer      endedMessage item = case item of       ServiceData _ _ _ (Object o) | Just (String m) <- KM.lookup "message" o -> m@@ -1788,7 +1747,7 @@       , ""       , "A connection held between runs (SYNAPSE-28, SYNAPSE-40):"       , "  the first call starts the holder, one process for all your calls"-      , "  ($XDG_RUNTIME_DIR/synapse/holder-4.sock), which keeps a signed-in socket per"+      , "  ($XDG_RUNTIME_DIR/synapse/holder-6.sock), which keeps a signed-in socket per"       , "  address and agent; later calls cost one round trip. A socket whose server is"       , "  gone is let go at once, one idle for --hold-for (10m) closed, past 256 the"       , "  longest idle first; the holder exits when it has held nothing for --hold-for."@@ -1796,6 +1755,10 @@       , "  is held. A call is sent from the schema cache (~/.cache/synapse/schemas-4) and"       , "  checked against the server only when it fails"       , ""+      , "Exit codes: 69 unreachable for the whole window, 75 a write may have"+      , "  happened, 77 refused, 73 / 74 -o FILE could not be made / written, 141"+      , "  stdout's reader closed the pipe"+      , ""       , "Meta-commands:"       , ""       , "  synapse _key new|show|list [NAME]"@@ -2170,12 +2133,6 @@   soGeneratorInfo <- many $ T.pack <$> strOption     ( long "generator-info" <> metavar "TOOL:VERSION"    <> help "Generator tool version info (can be specified multiple times)" )-  soBidirMode <- optional $ T.pack <$> strOption-    ( long "bidir-mode" <> short 'b' <> metavar "MODE"-   <> help "Bidirectional mode: interactive (TTY), json (pipe protocol), auto-cancel, defaults, respond" )-  soBidirCmd <- optional $ T.pack <$> strOption-    ( long "bidir-cmd" <> metavar "CMD"-   <> help "Shell command to handle bidir requests (stdin=JSON request, stdout=JSON response)" )   soNoCache <- switch     ( long "no-cache"    <> help "Disable IR caching (force rebuild from schema)" )
plexus-synapse.cabal view
@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               plexus-synapse-version:            4.0.0+version:            4.1.0 synopsis:           Schema-driven CLI for Plexus RPC servers description:        Synapse is the command-line frontend for Plexus RPC. It discovers a                     server's methods at runtime and builds its commands, help text,@@ -34,8 +34,7 @@   description: Build the suites that need a live service: cli-test,                websocket-raw-test and ir-test (a substrate and registry on                127.0.0.1:4444; cli-test also a synapse binary at a fixed-               dist-newstyle path) and bidir-integration-test (a backend-               named in --test-options). Opt-in, so a default `cabal test`+               dist-newstyle path). Opt-in, so a default `cabal test`                needs nothing running. Enable with: cabal test -f live-tests   default:     False   manual:      True@@ -61,7 +60,6 @@     Synapse.IR.Builder     Synapse.IR.Read     Synapse.IR.Cache-    Synapse.Bidir     Synapse.CLI.Help     Synapse.CLI.Parse     Synapse.CLI.Support@@ -105,7 +103,7 @@     base >= 4.17 && < 5,     -- SYNAPSE-28: setCallRouter, substrateRpcSub, unsubscribe; RETURNS-12:     -- the plexus 0.7 schema and envelope-    plexus-protocol >= 0.6 && < 0.7,+    plexus-protocol >= 0.7 && < 0.8,     aeson >= 2.0 && < 2.3,     aeson-pretty >= 0.8 && < 0.9,     text >= 2.0 && < 2.2,@@ -407,43 +405,6 @@   default-language: GHC2021   default-extensions:     OverloadedStrings-  ghc-options:      -threaded-  if !flag(live-tests)-    buildable: False--test-suite bidir-test-  type:             exitcode-stdio-1.0-  main-is:          BidirSpec.hs-  build-depends:-    base >= 4.17 && < 5,-    plexus-protocol,-    plexus-synapse,-    text >= 2.0 && < 2.2,-    bytestring >= 0.11 && < 0.13,-    aeson >= 2.2 && < 2.3,-    hspec >= 2.10 && < 2.12-  hs-source-dirs:   test-  default-language: GHC2021-  default-extensions:-    OverloadedStrings-    RecordWildCards-  ghc-options:      -threaded--test-suite bidir-integration-test-  type:             exitcode-stdio-1.0-  main-is:          BidirIntegrationSpec.hs-  build-depends:-    base >= 4.17 && < 5,-    plexus-synapse,-    text >= 2.0 && < 2.2,-    containers >= 0.6 && < 0.8,-    hspec >= 2.10 && < 2.12,-    katip >= 0.8 && < 0.9-  hs-source-dirs:   test-  default-language: GHC2021-  default-extensions:-    OverloadedStrings-    RecordWildCards   ghc-options:      -threaded   if !flag(live-tests)     buildable: False
− src/Synapse/Bidir.hs
@@ -1,275 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}---- | Bidirectional communication support for Synapse------ This module handles bidirectional requests (confirm, prompt, select) from--- the backend, supporting multiple modes for both human and agent users.------ = Modes------ - @interactive@: Uses TTY prompts (requires terminal)--- - @json@: Outputs request as JSON to stdout, reads response from stdin--- - @auto-cancel@: Automatically cancels all requests with a warning--- - @defaults@: Uses default values from requests if available--- - @--bidir-cmd CMD@: Spawns a subprocess per request (stdin=JSON, stdout=JSON)--- - @--bidir-respond@: Prints request to stdout as JSON, returns Nothing so the---   agent can respond via a separate @synapse \<backend\> respond@ invocation------ Under @-o FILE@ (SYNAPSE-39) stdout is FILE, renamed into place only when--- the call ends: every prompt and request line goes to stderr instead, to--- be seen while the call waits.------ = Protocol------ When a @StreamRequest@ arrives, the handler:--- 1. Processes it according to the current mode--- 2. If a response is produced, sends it via @{backend}.respond@ RPC method--- 3. If Nothing is returned (BidirRespond), the caller skips sending a response-module Synapse.Bidir-  ( -- * Types-    BidirMode(..)-  , parseBidirMode-  , defaultBidirMode--    -- * TTY Detection-  , isTTY-  , detectBidirMode--    -- * Request Handling-  , handleBidirRequest-  , BidirHandler-  ) where--import Data.Aeson-import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as TIO-import System.IO (hClose, hFlush, hIsTerminalDevice, stderr, stdin, stdout)--import Synapse.Output (promptHandle)-import System.Process (createProcess, proc, std_in, std_out, StdStream(..), waitForProcess)-import System.Exit (ExitCode(..))--import Plexus.Types-  ( Request(..)-  , Response(..)-  , SelectOption(..)-  )---- | Bidirectional communication mode-data BidirMode-  = BidirInteractive   -- ^ Use TTY prompts (requires terminal)-  | BidirJson          -- ^ Output request as JSON, read response from stdin-  | BidirAutoCancel    -- ^ Automatically cancel all requests-  | BidirDefaults      -- ^ Use default values from requests-  | BidirCmd Text      -- ^ Spawn subprocess per request (stdin=JSON request, stdout=JSON response)-  | BidirRespond       -- ^ Print request to stdout as JSON; agent responds via separate process call-  deriving (Show, Eq)---- | Parse bidirectional mode from string-parseBidirMode :: Text -> Maybe BidirMode-parseBidirMode = \case-  "interactive" -> Just BidirInteractive-  "json"        -> Just BidirJson-  "auto-cancel" -> Just BidirAutoCancel-  "defaults"    -> Just BidirDefaults-  "respond"     -> Just BidirRespond-  _             -> Nothing---- | Default mode when running in TTY-defaultBidirMode :: BidirMode-defaultBidirMode = BidirInteractive---- | Check if stdin is a terminal-isTTY :: IO Bool-isTTY = hIsTerminalDevice stdin---- | Detect the appropriate bidirectional mode based on environment--- Returns Interactive for TTY, AutoCancel for piped mode-detectBidirMode :: IO BidirMode-detectBidirMode = do-  tty <- isTTY-  pure $ if tty then BidirInteractive else BidirAutoCancel---- | Handler type for bidirectional requests--- Takes request ID, request data, and returns an optional response.--- Nothing means no immediate response (e.g., BidirRespond mode; agent responds separately).-type BidirHandler = Text -> Request Value -> IO (Maybe (Response Value))---- | Handle a bidirectional request according to the mode--- The response schema (if available) is passed for modes that output requests (e.g., BidirRespond)-handleBidirRequest :: BidirMode -> Maybe Value -> Text -> Request Value -> IO (Maybe (Response Value))-handleBidirRequest mode mResponseSchema requestId req = case mode of-  BidirInteractive -> Just <$> handleInteractive requestId req-  BidirJson        -> Just <$> handleJson requestId req-  BidirAutoCancel  -> Just <$> handleAutoCancel requestId req-  BidirDefaults    -> Just <$> handleDefaults requestId req-  BidirCmd cmd     -> Just <$> handleCmd cmd requestId req-  BidirRespond     -> handleRespond mResponseSchema requestId req---- | Interactive TTY handling-handleInteractive :: Text -> Request Value -> IO (Response Value)-handleInteractive _requestId req = case req of-  Confirm{..} -> do-    let defaultHint = case confirmDefault of-          Just True  -> " [Y/n]"-          Just False -> " [y/N]"-          Nothing    -> " [y/n]"-    promptHandle >>= \h -> TIO.hPutStr h $ confirmMessage <> defaultHint <> ": "-    promptHandle >>= hFlush-    input <- TIO.getLine-    let confirmed = case T.toLower (T.strip input) of-          ""    -> case confirmDefault of-                     Just d  -> d-                     Nothing -> False-          "y"   -> True-          "yes" -> True-          _     -> False-    pure $ Confirmed confirmed--  Prompt{..} -> do-    let hint = case promptPlaceholder of-          Just ph -> " (" <> ph <> ")"-          Nothing -> ""-    promptHandle >>= \h -> TIO.hPutStr h $ promptMessage <> hint <> ": "-    promptHandle >>= hFlush-    input <- TIO.getLine-    let response = if T.null input-          then case promptDefault of-                 Just d  -> d-                 Nothing -> String input-          else String input-    pure $ Value response--  Select{..} -> do-    promptHandle >>= \h -> TIO.hPutStrLn h selectMessage-    mapM_ printOption (zip [1..] selectOptions)-    promptHandle >>= \h -> TIO.hPutStr h "Select (enter number): "-    promptHandle >>= hFlush-    input <- TIO.getLine-    case reads (T.unpack input) of-      [(n, "")] | n >= 1 && n <= length selectOptions ->-        let selected = optionValue (selectOptions !! (n - 1))-        in pure $ Selected [selected]-      _ -> pure Cancelled-  where-    printOption :: (Int, SelectOption Value) -> IO ()-    printOption (idx, SelectOption{..}) = do-      let desc = case optionDescription of-            Just d  -> " - " <> d-            Nothing -> ""-      promptHandle >>= \h -> TIO.hPutStrLn h $ "  " <> T.pack (show idx) <> ") " <> optionLabel <> desc---- | JSON protocol handling for piped mode--- Outputs request as a JSON line to stdout (stderr under -o, SYNAPSE-39), reads a JSON response line from stdin-handleJson :: Text -> Request Value -> IO (Response Value)-handleJson requestId req = do-  let jsonReq = encode $ object-        [ "type"       .= ("bidir_request" :: Text)-        , "request_id" .= requestId-        , "request"    .= req-        ]-  promptHandle >>= \h -> LBS.hPutStrLn h jsonReq-  promptHandle >>= hFlush-  inputLine <- TIO.getLine-  case eitherDecode (LBS.fromStrict $ T.encodeUtf8 inputLine) of-    Left err -> do-      TIO.hPutStrLn stderr $ "[synapse] Failed to parse bidir response: " <> T.pack err-      pure Cancelled-    Right resp -> pure resp---- | Auto-cancel mode: cancels all requests with a warning-handleAutoCancel :: Text -> Request Value -> IO (Response Value)-handleAutoCancel requestId req = do-  TIO.hPutStrLn stderr $ "[synapse] Auto-cancelling " <> requestTypeName req-    <> " request (id: " <> requestId <> ") - not in interactive mode"-  TIO.hPutStrLn stderr "[synapse] Use --bidir-mode to change: json, defaults, interactive"-  TIO.hPutStrLn stderr "[synapse] Or use --bidir-cmd CMD / --bidir-respond for agent mode"-  pure Cancelled---- | Defaults mode: uses default values from requests if available-handleDefaults :: Text -> Request Value -> IO (Response Value)-handleDefaults requestId req = case req of-  Confirm{..} -> case confirmDefault of-    Just d -> do-      TIO.hPutStrLn stderr $ "[synapse] Using default for confirm (id: "-        <> requestId <> "): " <> if d then "yes" else "no"-      pure $ Confirmed d-    Nothing -> do-      TIO.hPutStrLn stderr $ "[synapse] No default for confirm (id: "-        <> requestId <> "), cancelling"-      pure Cancelled--  Prompt{..} -> case promptDefault of-    Just d -> do-      TIO.hPutStrLn stderr $ "[synapse] Using default for prompt (id: " <> requestId <> ")"-      pure $ Value d-    Nothing -> do-      TIO.hPutStrLn stderr $ "[synapse] No default for prompt (id: "-        <> requestId <> "), cancelling"-      pure Cancelled--  Select{..} -> do-    TIO.hPutStrLn stderr $ "[synapse] No default for select (id: "-      <> requestId <> "), cancelling"-    pure Cancelled---- | Command mode: spawn a subprocess per request--- The subprocess receives a JSON object on stdin:---   {"request_id": "...", "request": {...}}--- And must write a JSON Response object to stdout:---   {"type": "confirmed", "value": true}-handleCmd :: Text -> Text -> Request Value -> IO (Response Value)-handleCmd cmd requestId req = do-  let reqJson = encode $ object-        [ "request_id" .= requestId-        , "request"    .= req-        ]-  (Just hIn, Just hOut, _, ph) <- createProcess (proc "sh" ["-c", T.unpack cmd])-    { std_in  = CreatePipe-    , std_out = CreatePipe-    }-  LBS.hPutStr hIn reqJson-  hClose hIn-  outputBytes <- LBS.hGetContents hOut-  exitCode <- waitForProcess ph-  case exitCode of-    ExitFailure code -> do-      TIO.hPutStrLn stderr $ "[synapse] --bidir-cmd subprocess exited with code "-        <> T.pack (show code) <> " (id: " <> requestId <> ")"-      pure Cancelled-    ExitSuccess -> case eitherDecode outputBytes of-      Left err -> do-        TIO.hPutStrLn stderr $ "[synapse] Failed to parse --bidir-cmd response: " <> T.pack err-        pure Cancelled-      Right resp -> pure resp---- | Respond mode: print request to stdout as JSON, return Nothing--- The caller (invokeStreamingWithBidir) will skip sending a response.--- The agent is expected to call: synapse <backend> respond --request-id <id> --response <json>-handleRespond :: Maybe Value -> Text -> Request Value -> IO (Maybe (Response Value))-handleRespond mResponseSchema requestId req = do-  let baseFields =-        [ "type"       .= ("bidir_request" :: Text)-        , "request_id" .= requestId-        , "request"    .= req-        ]-      -- Include response_schema if available-      allFields = case mResponseSchema of-        Just schema -> baseFields ++ ["response_schema" .= schema]-        Nothing     -> baseFields-      jsonReq = encode $ object allFields-  promptHandle >>= \h -> LBS.hPutStrLn h jsonReq-  promptHandle >>= hFlush-  pure Nothing---- | Get a human-readable name for the request type-requestTypeName :: Request t -> Text-requestTypeName = \case-  Confirm{} -> "confirm"-  Prompt{}  -> "prompt"-  Select{}  -> "select"
src/Synapse/CLI/Parse.hs view
@@ -143,7 +143,7 @@ -- unless that begins with @--@ and is not exactly @--@. That is enough to find -- the path. Once the method is known, 'pairFlags' pairs the flag arguments -- again by type; the pairs returned here serve only where there is no method--- schema (@_self@, @respond@, a method missing from the IR).+-- schema (@_self@, a method missing from the IR). -- -- Example: ["echo", "once", "--message", "hello", "--count", "3"] --       -> (["echo", "once"], [("message", "hello"), ("count", "3")],
src/Synapse/CLI/Source.hs view
@@ -64,8 +64,8 @@   pure SourceEnv { seCwd = cwd, seHome = home, seStdin = readToEnd stdin, seCache = cache }  -- | All of a handle, without closing it: 'BS.getContents' semi-closes--- stdin, and the bidirectional mode's terminal check later throws on a--- closed handle.+-- stdin, and a later read of it (an input stream's) throws on a closed+-- handle. readToEnd :: Handle -> IO BS.ByteString readToEnd h = go []   where@@ -73,8 +73,8 @@       chunk <- BS.hGetSome h 65536       if BS.null chunk then pure (BS.concat (reverse acc)) else go (chunk : acc) --- | Whether some value has taken stdin: the bidirectional JSON mode reads it--- too, and the two cannot share.+-- | Whether some value has taken stdin: an input stream (BIDIR-18) reads+-- it too, and the two cannot share. stdinWasRead :: SourceEnv -> IO Bool stdinWasRead env = maybe False (const True) <$> readIORef (seCache env) 
src/Synapse/Deprecation.hs view
@@ -28,7 +28,7 @@ -- The dedupe 'IORef' is a top-level, 'NOINLINE' global because "per session" -- in the ticket means "per process lifetime". Embedding the set in -- 'Synapse.Monad.SynapseEnv' would also work but would force every call site--- that currently runs in 'IO' (e.g. bidir callbacks) to thread the env around.+-- that currently runs in 'IO' (e.g. stream callbacks) to thread the env around. -- The IORef approach keeps the API callable from plain 'IO'. module Synapse.Deprecation   ( -- * Emission@@ -74,7 +74,7 @@ --   the key was already present (caller must stay silent). -- --   'atomicModifyIORef'' makes this safe under the IO concurrency we care---   about here (streaming RPC callback threads, bidir handlers). There is+--   about here (streaming RPC callback threads). There is --   no correctness problem if two threads lose the race and both see the --   key as "already present" — the semantics we promise are "fires at --   least once per session", and 'atomicModifyIORef'' gives us exactly
src/Synapse/Endpoint.hs view
@@ -4,7 +4,7 @@ -- -- One value, from the command line (@--url@, or @-H@ / @-P@ with @--tls@ -- and @--path@), carried to every dial: the probe, the call, the stream and--- its reconnects, the schema, a bidirectional response, @_login@ and the+-- its reconnects, the schema, @_login@ and the -- session a call carries. The store keys a session by 'addressKey': a -- plain @ws://HOST:PORT/@ keeps the @HOST:PORT@ it always had (no stored -- session moves), anything else is keyed by its whole URL, so a @ws@ and a
src/Synapse/Hold.hs view
@@ -12,7 +12,7 @@ --   per user__ (and per 'holdProtocol'), in the manner of ssh's --   ControlMaster. It keeps signed-in WebSockets open between runs, one per --   address, agent and credential, and listens on a unix socket---   (@$XDG_RUNTIME_DIR/synapse/holder-4.sock@, 0600, in a 0700 directory).+--   (@$XDG_RUNTIME_DIR/synapse/holder-6.sock@, 0600, in a 0700 directory). --   A run hands it each request, with the agent it calls as, and reads the --   reply back, so a warm call costs local IPC and one round trip. The --   first run starts it. A connection whose server has gone is let go at@@ -531,9 +531,13 @@ -- error and progress), so a 4.0 holder never serves a 3.x run nor the -- reverse; 4 is 3 carrying a call's input half (BIDIR-18: "input", "sig", -- "in", "bin", "end"), so a run with input never meets a holder that--- would drop it.+-- would drop it. 5 was VISION-7's unmerged question routing (a+-- @{ns}.respond@ sent on the asking connection), never released and never+-- reused; 6 is 4 with bidir gone (ASK-3): its items are plexus-protocol+-- 0.7's, with no @request@ item, and nothing about it routes an answer. A+-- 4 or 5 holder is never reused by a 6 run, nor the reverse. holdProtocol :: Int-holdProtocol = 4+holdProtocol = 6  encodeRequest :: Text -> Maybe Double -> Bool -> SubstrateConfig -> Text -> Value -> Value encodeRequest agent holdFor input c method params = object $@@ -1014,7 +1018,7 @@       _ -> pure ()  -- | SYNAPSE-40: the one holder's socket:--- @$XDG_RUNTIME_DIR/synapse/holder-4.sock@ (a temporary directory of the+-- @$XDG_RUNTIME_DIR/synapse/holder-6.sock@ (a temporary directory of the -- user's own without one) — one per user and 'holdProtocol'. holderSocketPath :: IO FilePath holderSocketPath = (</> ("holder-" <> show holdProtocol <> ".sock")) <$> runtimeDir
src/Synapse/IR/Builder.hs view
@@ -407,7 +407,7 @@       other -> other  -- | SYNAPSE-CC-8: how often each type is named, by full name — in every---   method's params, returns, input and bidirectional type, and every type's+--   method's params, returns and input, and every type's --   fields, before deduplication. A namespace names only its own copy, so a --   copy's count is how much its namespace refers to it. refCounts :: Set.Set (Text, Text) -> IR -> Map (Text, Text) Int@@ -419,7 +419,7 @@          ++ concatMap (kindNames . tdKind) (Map.elems (irTypes ir))     methodNames md = concatMap refKeys       (map pdType (mdParams md) ++ [mdReturns md] ++ maybe [] pure (mdError md) ++ maybe [] pure (mdProgress md)-        ++ maybe [] pure (mdInput md) ++ maybe [] pure (mdBidirType md))+        ++ maybe [] pure (mdInput md))     kindNames = \case       KindStruct fs -> concatMap (refKeys . fdType) fs       KindEnum _ vs _ -> concatMap (\v -> concatMap (refKeys . fdType) (vdFields v) ++ maybe [] refKeys (vdRef v)) vs@@ -474,9 +474,8 @@   , mdReturns = updateTypeRef redirects (mdReturns md)   , mdError = fmap (updateTypeRef redirects) (mdError md)   , mdProgress = fmap (updateTypeRef redirects) (mdProgress md)-  , mdBidirType = fmap (updateTypeRef redirects) (mdBidirType md)   , mdInput = fmap (updateTypeRef redirects) (mdInput md)-  -- mdRole, mdBidirResponse*: left unchanged via record-update syntax+  -- mdRole: left unchanged via record-update syntax   }  -- | Update type references in a parameter@@ -750,9 +749,6 @@         , mdProgress = rrRef <$> progressRead         , mdCardinality = methodCardinality method           -- RETURNS-13: the schema's cardinality, never inferred-        , mdBidirType = inferBidirType method-        , mdBidirResponseType = Nothing  -- TODO: could extract from response_type title-        , mdBidirResponseSchema = methodResponseType method         , mdRole = methodRole method           -- IR-12: lift MethodSchema.role onto the IR so service-codegen's           -- typed-handle codegen (IR-9) sees DynamicChild/StaticChild tags.@@ -765,18 +761,6 @@         , mdInput = rrRef <$> inputRead         }     )---- | Infer the bidirectional type parameter from a MethodSchema.------ Returns:---   Nothing    – method is not bidirectional---   Just RefJson – method is bidirectional with default T=Value (StandardBidirChannel)------ TODO: When the activation macro emits a structured "bidir_type", read it here.-inferBidirType :: MethodSchema -> Maybe TypeRef-inferBidirType method-  | not (methodBidirectional method) = Nothing-  | otherwise = Just RefJson  -- StandardBidirChannel's T = serde_json::Value  -- ============================================================================ -- Parameter Extraction
src/Synapse/IR/Types.hs view
@@ -187,12 +187,13 @@     <*> o .:? "irPluginRoles"     <*> o .:? "irRefusals" .!= [] --- | The IR format this synapse writes: 3.0 (RETURNS-13: a method's returns,---   error, progress and cardinality, read from the plexus 0.7 schema) over---   2.1's forms (SYNAPSE-CC-8). A cache holding any other is discarded and+-- | The IR format this synapse writes: 3.1 (ASK-1: 3.0 without the+--   @mdBidir*@ keys, nothing in their place) over 3.0+--   (RETURNS-13: a method's returns, error, progress and cardinality, read+--   from the plexus 0.7 schema) and 2.1's forms (SYNAPSE-CC-8). A cache holding any other is discarded and --   built again. currentIrVersion :: Text-currentIrVersion = "3.0"+currentIrVersion = "3.1"  -- ============================================================================ -- IR 2.1: refusals, injected params, refinements@@ -288,7 +289,7 @@ -- | Empty IR for folding emptyIR :: IR emptyIR = IR-  { irVersion = currentIrVersion  -- 3.0: MethodDef carries returns · error · progress · cardinality (plexus 0.7); 2.1's SYNAPSE-CC-8 forms kept+  { irVersion = currentIrVersion  -- 3.1 (ASK-1): 3.0 without mdBidir*; 3.0: MethodDef carries returns · error · progress · cardinality (plexus 0.7); 2.1's SYNAPSE-CC-8 forms kept   , irBackend = ""  -- Will be set by buildIR   , irHash = Nothing   , irMetadata = Nothing@@ -434,34 +435,9 @@   , mdCardinality :: Cardinality     -- ^ One item or many. From @MethodSchema.cardinality@ — never inferred     --   from the shape of 'mdReturns'.-  , mdBidirType   :: Maybe TypeRef-    -- ^ Bidirectional channel type parameter T, when the method uses-    -- BidirChannel<StandardRequest<T>, StandardResponse<T>>.-    ---    -- Populated from the "bidirectional" / "request_type" fields in the-    -- MethodSchema (emitted by plexus-macros when #[bidirectional] is set).-    ---    -- - Nothing  → method is not bidirectional, OR uses the default-    --              T = serde_json::Value (StandardBidirChannel)-    -- - Just RefJson → bidirectional with T=Value (explicit marker)-    -- - Just (RefNamed ...) → bidirectional with a specific named T type-    ---    -- NOTE: The substrate schema currently emits 'bidirectional: true' but-    -- does not yet include a structured 'bidir_type' field.  When that field-    -- is added to MethodSchema, populate it here from methodRequestType.-    -- For now this is always Nothing.-  , mdBidirResponseType :: Maybe TypeRef-    -- ^ Expected response type for bidirectional methods.-    ---    -- Populated from the "response_type" field in the MethodSchema.-    -- This allows agents to know what response format is expected-    -- when they receive a bidirectional request.-  , mdBidirResponseSchema :: Maybe Value-    -- ^ Full JSON Schema for the bidirectional response type.-    ---    -- Cached from MethodSchema.response_type so synapse can include it-    -- in bidir_request output. Synapse controls whether to print this-    -- (e.g., first request, --bidir-schemas flag, etc.)+    -- ASK-1: bidir is gone, with nothing in its place. A 3.0 IR's+    -- @mdBidirType@ / @mdBidirResponseType@ / @mdBidirResponseSchema@ (and+    -- an @mdAsks@, from a build of the withdrawn ASK-3) are read past.   , mdRole        :: MethodRole     -- ^ Structural role of this method in the activation graph     -- (IR-12). Mirrors 'Plexus.Schema.Recursive.MethodRole' /@@ -506,9 +482,6 @@     , "mdError"               .= mdError     , "mdProgress"            .= mdProgress     , "mdCardinality"         .= mdCardinality-    , "mdBidirType"           .= mdBidirType-    , "mdBidirResponseType"   .= mdBidirResponseType-    , "mdBidirResponseSchema" .= mdBidirResponseSchema     , "mdRole"                .= mdRole     ] <> catMaybes     -- AUTH-9: present only when the schema says them, so a pre-AUTH@@ -532,9 +505,6 @@     <*> o .:? "mdError"     <*> o .:? "mdProgress"     <*> o .:  "mdCardinality"-    <*> o .:? "mdBidirType"-    <*> o .:? "mdBidirResponseType"-    <*> o .:? "mdBidirResponseSchema"     <*> o .:? "mdRole" .!= MethodRoleRpc     <*> o .:? "mdGrant"     <*> o .:? "mdTarget"
src/Synapse/Log.hs view
@@ -43,7 +43,6 @@   | SubsystemNavigation   | SubsystemRendering   | SubsystemCLI-  | SubsystemBidir   deriving (Show, Eq)  -- | Logger handle@@ -63,7 +62,6 @@ subsystemToNamespace SubsystemNavigation = "navigation" subsystemToNamespace SubsystemRendering  = "rendering" subsystemToNamespace SubsystemCLI        = "cli"-subsystemToNamespace SubsystemBidir      = "bidir"  -- | Create a logger with specified minimum severity -- Default: ErrorS (only show errors)
src/Synapse/Output.hs view
@@ -26,16 +26,13 @@ -- at once, past the runtime's last flush, which would fail on what is left -- in stdout's buffer and make the exit 1. ----- What must be seen while the call waits goes to stderr under @-o@, not--- FILE: a two-way request's prompt ('promptHandle'), and under @-j@ an error--- or a refusal — FILE goes with the failed run, so its line alone would be--- lost. A SIGTERM or SIGHUP ends the run as a failed one (143, 129): the+-- Under @-o@ with @-j@ an error or a refusal goes to stderr, not FILE:+-- FILE goes with the failed run, so its line alone would be lost. A SIGTERM or SIGHUP ends the run as a failed one (143, 129): the -- temporary file is removed. A SIGKILL can leave it behind. module Synapse.Output   ( withOutputFile   , streaming   , active-  , promptHandle   , exitCannotCreate   , exitCannotWrite   ) where@@ -147,13 +144,6 @@ -- | Whether @-o FILE@ holds stdout. active :: IO Bool active = maybe False (const True) <$> readIORef current---- | Where a prompt goes that must be seen while the call waits: stderr--- under @-o@ (stdout is FILE), else stdout.-promptHandle :: IO Handle-promptHandle = do-  a <- active-  pure (if a then stderr else stdout)  -- | The call is a stream: FILE is its temporary file from now on, each -- item in it as it is printed.
src/Synapse/Reconnect.hs view
@@ -28,10 +28,8 @@ -- sent again for as long as the pipe stayed closed. Whatever the call's -- callbacks raise is marked where it is raised, and the call ends there, -- never retried. Those callbacks are the caller's side of the call: the--- printer (each item, the @-j@ reconnected line, the stderr lines) and the--- answering of a two-way request (the prompt or @--bidir-cmd@ that--- answers it; sending the answer, @<backend>.respond@, reports its own--- failure as a value and raises nothing). A closed stdout (or stderr) exits+-- printer (each item, the @-j@ reconnected line, the stderr lines). A+-- closed stdout (or stderr) exits -- 'exitOutputClosed' (141, what a shell says of a filter the pipe closed -- on) saying nothing, with the stream unsubscribed and the socket closed -- as the transport unwinds; any other failure there is reported as@@ -149,11 +147,11 @@  -- | A method's shape from its schema: a read when its group says @read@ -- (menger's methods do), else when its name is a read's; anything else —--- and anything bidirectional — is a write, never sent twice.+-- is a write, never sent twice. callShape :: MethodSchema -> CallShape callShape m = CallShape   { csStream = methodCardinality m == CardinalityMany-  , csRead   = not (methodBidirectional m) && isRead+  , csRead   = isRead   , csSince  = takesSince (methodParams m)   }   where
src/Synapse/Schema/Types.hs view
@@ -36,14 +36,6 @@   , jsonLine   , pattern ServiceDone   , pattern ServiceGuidance-  , pattern ServiceRequest--    -- * Bidirectional Types (re-exported)-  , Request(..)-  , StandardRequest-  , Response(..)-  , StandardResponse-  , SelectOption(..)   ) where  import Data.Aeson (Value(..), encode, object, toJSON, (.=))@@ -75,11 +67,6 @@   , Provenance   , GuidanceErrorType   , GuidanceSuggestion-  , Request(..)-  , StandardRequest-  , Response(..)-  , StandardResponse-  , SelectOption(..)   , StreamMetadata(..)   , itemErrorMessage   )@@ -186,6 +173,3 @@ pattern ServiceGuidance :: Text -> Provenance -> GuidanceErrorType -> GuidanceSuggestion -> Maybe [Text] -> Maybe Value -> ServiceStreamItem pattern ServiceGuidance hash prov errType suggestion methods schema = StreamGuidance hash prov errType suggestion methods schema --- | Pattern synonym for bidirectional request events-pattern ServiceRequest :: Text -> Provenance -> Text -> Request Value -> Maybe Int -> ServiceStreamItem-pattern ServiceRequest hash prov reqId reqData timeout = StreamRequest hash prov reqId reqData timeout
src/Synapse/Self/Protocol/StreamTracker.hs view
@@ -128,7 +128,6 @@                 String "progress" -> Just StreamProgressMsg                 String "error" -> Just StreamErrorMsg                 String "guidance" -> Just StreamGuidanceMsg-                String "request" -> Just StreamRequestMsg                 _ -> Just UnknownMsg             _ -> Just UnknownMsg @@ -144,7 +143,6 @@   | StreamProgressMsg   | StreamErrorMsg   | StreamGuidanceMsg-  | StreamRequestMsg   | UnknownMsg   deriving (Show, Eq) 
src/Synapse/Self/Protocol/TestRunner.hs view
@@ -316,18 +316,6 @@         , "timestamp" .= (0 :: Int)         ]     ]-plexusItemToValue (PT.StreamRequest hash prov reqId reqData timeout) =-  object-    [ "type" .= ("request" :: Text)-    , "request_id" .= reqId-    , "request_data" .= reqData-    , "timeout" .= timeout-    , "metadata" .= object-        [ "provenance" .= provenanceToValue prov-        , "plexus_hash" .= hash-        , "timestamp" .= (0 :: Int)-        ]-    ] plexusItemToValue (PT.StreamGuidance hash prov errType suggestion availMethods methodSchema) =   object $     [ "type" .= ("guidance" :: Text)
src/Synapse/Self/Protocol/Validator.hs view
@@ -124,20 +124,21 @@         { pvMessage = "Missing 'type' field in stream item"         , pvSeverity = Error         , pvLocation = InConnection-        , pvExpected = Just "type field with value: data, error, progress, done, or request"+        , pvExpected = Just "type field with value: data, error, progress or done"         , pvActual = Just "missing"         , pvFix = Just "Add 'type' field to stream item"         }     ]   Just (String typeStr) ->-    if typeStr `elem` ["data", "error", "progress", "done", "request"]+    -- ASK-3: spec/08's request item is gone with bidir (ASK-1)+    if typeStr `elem` ["data", "error", "progress", "done"]       then []       else         [ ProtocolViolation             { pvMessage = "Invalid stream item type: " <> typeStr             , pvSeverity = Error             , pvLocation = InConnection-            , pvExpected = Just "data, error, progress, done, or request"+            , pvExpected = Just "data, error, progress or done"             , pvActual = Just typeStr             , pvFix = Just "Use one of the valid stream item types"             }@@ -166,12 +167,9 @@ validateMetadata :: Value -> [ProtocolViolation] validateMetadata (Object obj) =   -- Check if this item type should have metadata-  case KM.lookup "type" obj of-    Just (String "request") ->-      -- Request items don't require metadata-      []+  -- Every item carries metadata+  case () of     _ ->-      -- All other types require metadata       case KM.lookup "metadata" obj of         Nothing ->           [ ProtocolViolation@@ -411,7 +409,6 @@   Just (String "progress") -> validateProgressItem (Object obj)   Just (String "error") -> validateErrorItem (Object obj)   Just (String "done") -> validateDoneItem (Object obj)-  Just (String "request") -> []  -- Request validation could be added   _ -> []  -- | Validate data item structure
src/Synapse/Transport.hs view
@@ -18,12 +18,9 @@      -- * Method Invocation (streaming)   , invokeStreaming-  , invokeStreamingWithBidir+  , invokeStreamingCall   , invokeWithInput -    -- * Bidirectional Response-  , sendResponse-     -- * Upgrade headers (IDENTITY-16: discovery probes carry them too)   , mergeUpgradeHeaders   ) where@@ -347,35 +344,21 @@     getPort (PT.ConnectionTimeout _ p) _ = p     getPort _ c = substratePort c --- | Invoke a method with streaming output and bidirectional request handling--- When a StreamRequest is received, the bidirectional handler is called and--- the response is sent back via {backend}.respond (if the handler returns Just).--- If the handler returns Nothing (BidirRespond mode), no response is sent immediately.-invokeStreamingWithBidir+-- | Invoke a method, each item to the handler as it comes, through an+-- outage as its shape says (SYNAPSE-20).+invokeStreamingCall   :: R.CallShape                                           -- ^ SYNAPSE-20: how it rides out an outage   -> IO (Maybe WS.Headers)                                 -- ^ SYNAPSE-20: sign in again; the upgrade's new headers   -> (R.Resumed -> IO ())                                  -- ^ told when a stream resumed after a gap   -> Path   -> Text   -> Value-  -> (ServiceStreamItem -> IO ())                              -- ^ Handler for non-request items-  -> (Text -> PT.Request Value -> IO (Maybe (PT.Response Value)))  -- ^ Handler for bidirectional requests+  -> (ServiceStreamItem -> IO ())                          -- ^ each item   -> SynapseM ()-invokeStreamingWithBidir shape refreshAuth onResume namespacePath method params onItem onBidirRequest = do+invokeStreamingCall shape refreshAuth onResume namespacePath method params onItem = do   cfg <- getConfig   cfgRef <- liftIO $ newIORef cfg-  let wrappedHandler item = case item of-        PT.StreamRequest _ _ reqId reqData _timeout -> do-          -- Handle the bidirectional request-          mResponse <- onBidirRequest reqId reqData-          -- Send the response back via {backend}.respond (if present)-          case mResponse of-            Just response -> do-              _ <- ST.sendBidirectionalResponse cfg reqId response-              pure ()-            Nothing -> pure ()  -- agent will respond via separate call-        _ -> onItem item-      attempt ps subscribed h = do+  let attempt ps subscribed h = do         c <- readIORef cfgRef         ST.invokeMethodStreamingWith c subscribed namespacePath method ps h       reauth = refreshAuth >>= \case@@ -384,7 +367,7 @@   -- SYNAPSE-20: through an outage — a read sent again, a stream resumed   -- (with since when it takes one), a write that went out never repeated   result <- liftIO $-    R.resilientCall (whereOf cfg) shape attempt reauth params onResume wrappedHandler+    R.resilientCall (whereOf cfg) shape attempt reauth params onResume onItem       >>= R.reportEnding (whereOf cfg)   case result of     Left transportErr -> do@@ -442,9 +425,7 @@               case In.inputRefusal i of                 Just r -> modifyIORef' refusal (maybe (Just r) Just)                 Nothing -> pure ()-              case i of-                PT.StreamRequest{} -> pure ()   -- an input call answers no request-                _ -> onItem untouched i+              onItem untouched i             attempt ps subscribed h = do               c <- readIORef cfgRef               ST.invokeMethodDuplex c half subscribed namespacePath method ps h@@ -497,25 +478,6 @@ whereOf c = case (substrateTls c, substratePath c) of   (Nothing, "/") -> T.pack (substrateHost c) <> ":" <> T.pack (show (substratePort c))   (tls, path) -> maybe "ws" (const "wss") tls <> "://" <> T.pack (hostHeader c) <> T.pack path---- | Send a response for a bidirectional request-sendResponse :: Text -> PT.Response Value -> SynapseM ()-sendResponse requestId response = do-  cfg <- getConfig-  result <- liftIO $ ST.sendBidirectionalResponse cfg requestId response-  case result of-    Left transportErr -> do-      backend <- asks seBackend-      let ctx = TransportContext-            { tcMessage  = transportErrorToText transportErr-            , tcHost     = T.pack $ substrateHost cfg-            , tcPort     = substratePort cfg-            , tcBackend  = backend-            , tcPath     = ["respond"]-            , tcCategory = transportErrorToCategory transportErr-            }-      throwTransportWith ctx-    Right () -> pure ()  -- | Get SubstrateConfig from environment getConfig :: SynapseM SubstrateConfig
− test/BidirIntegrationSpec.hs
@@ -1,268 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}---- | Bidirectional integration tests------ Tests for schema-driven bidirectional communication:--- - IR builder correctly sets mdBidirType field--- - Methods with bidirectional flag are detected--- - Schema-driven dispatch logic------ This test requires a running Service backend on localhost:4444--- with at least one method marked as bidirectional.-module Main where--import Control.Monad (forM_)-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Maybe (isJust, isNothing, catMaybes, mapMaybe)-import Data.Text (Text)-import qualified Data.Text as T-import System.Environment (getArgs, withArgs)-import Test.Hspec-import Text.Read (readMaybe)--import Synapse.IR.Types-import Synapse.IR.Builder (buildIR)-import Synapse.Monad-import qualified Synapse.Log as Log-import qualified Katip--main :: IO ()-main = do-  args <- getArgs-  case parseArgs args of-    Nothing -> do-      putStrLn "Usage: bidir-integration-test <backend> [--port <port>]"-      putStrLn "Example: cabal test bidir-integration-test --test-options=\"plexus\""-      putStrLn ""-      putStrLn "Note: This test validates bidirectional communication features."-      putStrLn "      Some tests may be skipped if no bidirectional methods exist."-      error "Backend argument required"-    Just (backend, port) -> do-      putStrLn $ "Running bidirectional integration tests against localhost:" <> show port-      putStrLn $ "(backend: " <> T.unpack backend <> ")"--      -- Initialize environment-      logger <- Log.makeLogger Katip.ErrorS-      env <- initEnv "127.0.0.1" port backend logger Nothing--      -- Build IR once for all tests-      irResult <- runSynapseM env (buildIR [] [])--      case irResult of-        Left err -> do-          putStrLn $ "Failed to build IR: " <> show err-          putStrLn "Is the Service backend running?"-          hspec $ describe "Bidirectional Integration Tests" $-            it "connects to Service backend" $-              expectationFailure $ "Could not connect: " <> show err--        Right ir -> withArgs [] $ hspec $ bidirIntegrationSpec ir---- | Parse command-line arguments: <backend> [--port <port>]-parseArgs :: [String] -> Maybe (Text, Int)-parseArgs [] = Nothing-parseArgs (backend:rest) = Just (T.pack backend, parsePort rest)-  where-    parsePort ("--port":p:_) = maybe 4444 id (readMaybe p)-    parsePort _ = 4444---- | Main spec using pre-built IR-bidirIntegrationSpec :: IR -> Spec-bidirIntegrationSpec ir = do-  describe "IR bidirectional field population" $ do-    it "IR has methods" $-      Map.size (irMethods ir) `shouldSatisfy` (> 0)--    it "mdBidirType field exists on all methods" $ do-      forM_ (Map.elems $ irMethods ir) $ \method ->-        -- Field should exist (even if Nothing)-        -- This tests that the field is part of MethodDef-        case mdBidirType method of-          Nothing -> (pure () :: IO ())  -- Not bidirectional-          Just _  -> (pure () :: IO ())  -- Bidirectional--    it "reports methods with mdBidirType set" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      let count = length bidirMethods-      putStrLn $ "  Found " <> show count <> " bidirectional method(s)"-      forM_ bidirMethods $ \method ->-        putStrLn $ "    - " <> T.unpack (mdFullPath method) <>-                   " (type: " <> show (mdBidirType method) <> ")"-      -- Don't fail if none exist - this is informational-      pure ()--  describe "Bidirectional type inference" $ do-    it "mdBidirType is Nothing for non-bidirectional methods" $ do-      -- Find methods that are NOT streaming and likely not bidirectional-      let nonStreamingMethods = filter ((/= CardinalityMany) . mdCardinality) (Map.elems $ irMethods ir)-      -- Check a sample (if any exist)-      case take 1 nonStreamingMethods of-        [] -> pending  -- No non-streaming methods to test-        (method:_) -> do-          -- Most non-streaming methods shouldn't be bidirectional-          -- But we can't enforce this strictly as it depends on the backend-          case mdBidirType method of-            Nothing -> pure ()  -- Expected for most methods-            Just _ -> putStrLn $ "  Note: " <> T.unpack (mdFullPath method) <>-                                " is bidirectional despite being non-streaming"--    it "mdBidirType is RefAny for standard bidirectional methods" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      forM_ bidirMethods $ \method ->-        case mdBidirType method of-          Just RefJson -> pure ()  -- Standard bidir with T=Value-          Just other ->-            -- Future: when custom bidir types are supported, this is valid-            putStrLn $ "  Note: " <> T.unpack (mdFullPath method) <>-                      " has custom bidir type: " <> show other-          Nothing -> expectationFailure "Expected bidir method to have mdBidirType"--  describe "Bidirectional method detection" $ do-    it "can identify all bidirectional methods" $ do-      let allMethods = Map.elems $ irMethods ir-      let bidirMethods = filter (isJust . mdBidirType) allMethods-      -- Report findings-      putStrLn $ "  Total methods: " <> show (length allMethods)-      putStrLn $ "  Bidirectional: " <> show (length bidirMethods)-      -- Test passes - we're just collecting data-      length allMethods `shouldSatisfy` (>= length bidirMethods)--    it "bidirectional methods have valid structure" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      forM_ bidirMethods $ \method -> do-        -- Should have a name-        T.length (mdName method) `shouldSatisfy` (> 0)-        -- Should have a full path-        T.length (mdFullPath method) `shouldSatisfy` (> 0)-        -- Should have a return type-        mdReturns method `shouldSatisfy` (/= RefUnknown)--  describe "Type reference validation for bidirectional types" $ do-    it "mdBidirType references resolve in irTypes (if not RefAny)" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      forM_ bidirMethods $ \method ->-        case mdBidirType method of-          Nothing -> pure ()-          Just RefJson -> pure ()  -- RefAny doesn't need resolution-          Just (RefNamed qn) -> do-            let typeName = qualifiedNameFull qn-            case Map.lookup typeName (irTypes ir) of-              Nothing -> expectationFailure $ T.unpack $-                "Bidirectional type not found in IR: " <> typeName <>-                " (referenced by " <> mdFullPath method <> ")"-              Just _ -> pure ()-          Just (RefArray _) ->-            -- Array types are valid, but we don't validate the inner type here-            pure ()-          Just (RefOptional _) ->-            -- Optional types are valid-            pure ()-          Just RefUnknown -> expectationFailure $ T.unpack $-            "mdBidirType should not be RefUnknown for " <> mdFullPath method-          Just (RefPrimitive _ _) ->-            -- Primitive types are valid-            pure ()--  describe "Schema-driven dispatch assumptions" $ do-    it "bidirectional methods are streaming (typically)" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      forM_ bidirMethods $ \method ->-        if mdCardinality method == CardinalityMany-          then pure ()  -- Expected - bidir usually requires streaming-          else putStrLn $ "  Note: Bidirectional method " <> T.unpack (mdFullPath method) <>-                         " is NOT streaming (unusual but valid)"--    it "non-bidirectional methods have Nothing for mdBidirType" $ do-      let allMethods = Map.elems $ irMethods ir-      forM_ allMethods $ \method ->-        case mdBidirType method of-          Nothing -> (pure () :: IO ())  -- Standard method-          Just _ -> (pure () :: IO ())   -- Should only be set for truly bidirectional methods--  describe "Specific bidirectional method tests (if available)" $ do-    -- Test common bidirectional methods if they exist-    -- These are examples - actual methods depend on the backend-    testBidirMethod ir "cone.chat"-    testBidirMethod ir "cone.edit"-    testBidirMethod ir "cone.generate"--  describe "IR metadata for bidirectional support" $ do-    it "IR version is set" $-      T.length (irVersion ir) `shouldSatisfy` (> 0)--    it "IR backend is set" $-      T.length (irBackend ir) `shouldSatisfy` (> 0)--    it "IR contains type definitions" $ do-      -- Should have at least some types (even if no bidirectional methods)-      Map.size (irTypes ir) `shouldSatisfy` (>= 0)--  describe "Edge cases and validation" $ do-    it "handles methods with no parameters but bidirectional" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      let noParamBidirMethods = filter (null . mdParams) bidirMethods-      -- These are valid - bidirectional methods can have no input params-      -- Just report findings-      unless (null noParamBidirMethods) $-        putStrLn $ "  Found " <> show (length noParamBidirMethods) <>-                  " bidirectional method(s) with no parameters"-      pure ()--    it "handles methods with complex return types and bidirectional" $ do-      let bidirMethods = filter (isJust . mdBidirType) (Map.elems $ irMethods ir)-      forM_ bidirMethods $ \method ->-        -- Return type should be valid (not RefUnknown)-        case mdReturns method of-          RefUnknown -> expectationFailure $ T.unpack $-            "Bidirectional method " <> mdFullPath method <> " has RefUnknown return type"-          _ -> pure ()--    it "mdBidirType is consistent across IR operations" $ do-      -- Test that mdBidirType survives IR transformations-      let allMethods = Map.elems $ irMethods ir-      let bidirCount = length $ filter (isJust . mdBidirType) allMethods-      -- The count should be stable-      bidirCount `shouldSatisfy` (>= 0)-      pure ()--  describe "Statistics and reporting" $ do-    it "reports bidirectional coverage statistics" $ do-      let allMethods = Map.elems $ irMethods ir-      let bidirMethods = filter (isJust . mdBidirType) allMethods-      let streamingMethods = filter ((== CardinalityMany) . mdCardinality) allMethods--      putStrLn "\n  Bidirectional Statistics:"-      putStrLn $ "    Total methods:        " <> show (length allMethods)-      putStrLn $ "    Streaming methods:    " <> show (length streamingMethods)-      putStrLn $ "    Bidirectional methods:" <> show (length bidirMethods)--      if null bidirMethods-        then putStrLn "    (No bidirectional methods found - tests are informational)"-        else do-          putStrLn "    Bidirectional methods:"-          forM_ bidirMethods $ \method ->-            putStrLn $ "      - " <> T.unpack (mdFullPath method)--      pure ()---- Helper to avoid importing Control.Monad.Extra-unless :: Bool -> IO () -> IO ()-unless condition action = if condition then pure () else action---- Helper function to test a specific bidirectional method-testBidirMethod :: IR -> Text -> Spec-testBidirMethod ir methodPath =-  case Map.lookup methodPath (irMethods ir) of-    Nothing -> it (T.unpack methodPath <> " exists (skipped - not found)") pending-    Just method -> do-      it (T.unpack methodPath <> " is marked as bidirectional") $-        isJust (mdBidirType method) `shouldBe` True--      it (T.unpack methodPath <> " has standard bidir type (RefAny)") $-        mdBidirType method `shouldSatisfy` (\case { Just RefJson -> True; _ -> False })--      it (T.unpack methodPath <> " is a streaming method") $-        mdCardinality method `shouldBe` CardinalityMany
− test/BidirSpec.hs
@@ -1,325 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}---- | Bidirectional communication tests------ Tests for Synapse.Bidir module, covering:--- - Request/Response type handling--- - BidirMode parsing and handling--- - JSON serialization/deserialization--- - BidirHandler functions-module Main where--import Data.Aeson (Value(..), decode, encode, object, (.=))-import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as LBS8-import Data.Maybe (isJust, isNothing, fromJust)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Test.Hspec--import Plexus.Types-  ( Request(..)-  , Response(..)-  , SelectOption(..)-  )-import Synapse.Bidir-  ( BidirMode(..)-  , parseBidirMode-  , defaultBidirMode-  )--main :: IO ()-main = hspec $ do--  describe "Request type constructors" $ do-    it "creates Confirm request" $ do-      let req = Confirm "Are you sure?" (Just True) :: Request Value-      confirmMessage req `shouldBe` "Are you sure?"-      confirmDefault req `shouldBe` Just True--    it "creates Prompt request with default" $ do-      let req = Prompt "Enter name" (Just (String "default")) (Just "placeholder") :: Request Value-      promptMessage req `shouldBe` "Enter name"-      promptDefault req `shouldBe` Just (String "default")-      promptPlaceholder req `shouldBe` Just "placeholder"--    it "creates Prompt request without default" $ do-      let req = Prompt "Enter value" Nothing Nothing :: Request Value-      promptMessage req `shouldBe` "Enter value"-      promptDefault req `shouldBe` Nothing-      promptPlaceholder req `shouldBe` Nothing--    it "creates Select request" $ do-      let opts = [ SelectOption (String "a") "Option A" Nothing-                 , SelectOption (String "b") "Option B" (Just "Description B")-                 ]-      let req = Select "Choose one" opts False :: Request Value-      selectMessage req `shouldBe` "Choose one"-      length (selectOptions req) `shouldBe` 2-      selectMulti req `shouldBe` False--  describe "Response type constructors" $ do-    it "creates Confirmed response" $ do-      let resp = Confirmed True :: Response Value-      confirmedValue resp `shouldBe` True--    it "creates Value response" $ do-      let resp = Value (String "result") :: Response Value-      responseValue resp `shouldBe` String "result"--    it "creates Selected response" $ do-      let resp = Selected [String "a", String "b"] :: Response Value-      selectedValues resp `shouldBe` [String "a", String "b"]--    it "creates Cancelled response" $ do-      let resp = Cancelled :: Response Value-      resp `shouldBe` Cancelled--  describe "Request JSON serialization" $ do-    it "serializes Confirm request" $ do-      let req = Confirm "Proceed?" (Just True) :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      decoded `shouldBe` Just req--    it "serializes Confirm without default" $ do-      let req = Confirm "Proceed?" Nothing :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      decoded `shouldBe` Just req--    it "serializes Prompt request" $ do-      let req = Prompt "Enter name" (Just (String "default")) (Just "hint") :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      decoded `shouldBe` Just req--    it "serializes Select request" $ do-      let opts = [SelectOption (String "x") "Label" Nothing]-      let req = Select "Choose" opts False :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      decoded `shouldBe` Just req--    it "deserializes confirm request from JSON" $ do-      let jsonStr = "{\"type\":\"confirm\",\"message\":\"Continue?\",\"default\":true}"-      let decoded = decode (LBS8.pack jsonStr) :: Maybe (Request Value)-      isJust decoded `shouldBe` True-      case decoded of-        Just (Confirm msg def) -> do-          msg `shouldBe` "Continue?"-          def `shouldBe` Just True-        _ -> expectationFailure "Expected Confirm request"--    it "deserializes prompt request from JSON" $ do-      let jsonStr = "{\"type\":\"prompt\",\"message\":\"Name?\",\"placeholder\":\"John\"}"-      let decoded = decode (LBS8.pack jsonStr) :: Maybe (Request Value)-      isJust decoded `shouldBe` True-      case decoded of-        Just (Prompt msg _ placeholder) -> do-          msg `shouldBe` "Name?"-          placeholder `shouldBe` Just "John"-        _ -> expectationFailure "Expected Prompt request"--  describe "Response JSON serialization" $ do-    it "serializes Confirmed response" $ do-      let resp = Confirmed True :: Response Value-      let json = encode resp-      let decoded = decode json :: Maybe (Response Value)-      decoded `shouldBe` Just resp--    it "serializes Value response with 'text' tag" $ do-      let resp = Value (String "answer") :: Response Value-      let json = encode resp-      let jsonText = T.decodeUtf8 $ LBS.toStrict json-      -- Should serialize with "text" tag for wire compatibility-      jsonText `shouldSatisfy` T.isInfixOf "\"text\""-      let decoded = decode json :: Maybe (Response Value)-      decoded `shouldBe` Just resp--    it "serializes Selected response" $ do-      let resp = Selected [String "a"] :: Response Value-      let json = encode resp-      let decoded = decode json :: Maybe (Response Value)-      decoded `shouldBe` Just resp--    it "serializes Cancelled response" $ do-      let resp = Cancelled :: Response Value-      let json = encode resp-      let decoded = decode json :: Maybe (Response Value)-      decoded `shouldBe` Just resp--    it "deserializes confirmed response from JSON" $ do-      let jsonStr = "{\"type\":\"confirmed\",\"value\":true}"-      let decoded = decode (LBS8.pack jsonStr) :: Maybe (Response Value)-      decoded `shouldBe` Just (Confirmed True)--    it "deserializes text response from JSON" $ do-      let jsonStr = "{\"type\":\"text\",\"value\":\"hello\"}"-      let decoded = decode (LBS8.pack jsonStr) :: Maybe (Response Value)-      decoded `shouldBe` Just (Value (String "hello"))--    it "deserializes cancelled response from JSON" $ do-      let jsonStr = "{\"type\":\"cancelled\"}"-      let decoded = decode (LBS8.pack jsonStr) :: Maybe (Response Value)-      decoded `shouldBe` Just Cancelled--  describe "SelectOption JSON serialization" $ do-    it "serializes SelectOption with description" $ do-      let opt = SelectOption (String "val") "Label" (Just "Desc") :: SelectOption Value-      let json = encode opt-      let decoded = decode json :: Maybe (SelectOption Value)-      decoded `shouldBe` Just opt--    it "serializes SelectOption without description" $ do-      let opt = SelectOption (String "val") "Label" Nothing :: SelectOption Value-      let json = encode opt-      let decoded = decode json :: Maybe (SelectOption Value)-      decoded `shouldBe` Just opt--    it "deserializes SelectOption from JSON" $ do-      let jsonStr = "{\"value\":\"x\",\"label\":\"X\",\"description\":\"Choose X\"}"-      let decoded = decode (LBS8.pack jsonStr) :: Maybe (SelectOption Value)-      isJust decoded `shouldBe` True-      case decoded of-        Just opt -> do-          optionValue opt `shouldBe` String "x"-          optionLabel opt `shouldBe` "X"-          optionDescription opt `shouldBe` Just "Choose X"-        _ -> expectationFailure "Expected SelectOption"--  describe "BidirMode parsing" $ do-    it "parses 'interactive'" $-      parseBidirMode "interactive" `shouldBe` Just BidirInteractive--    it "parses 'json'" $-      parseBidirMode "json" `shouldBe` Just BidirJson--    it "parses 'auto-cancel'" $-      parseBidirMode "auto-cancel" `shouldBe` Just BidirAutoCancel--    it "parses 'defaults'" $-      parseBidirMode "defaults" `shouldBe` Just BidirDefaults--    it "parses 'respond'" $-      parseBidirMode "respond" `shouldBe` Just BidirRespond--    it "returns Nothing for invalid mode" $-      parseBidirMode "invalid" `shouldBe` Nothing--    it "is case-sensitive" $-      parseBidirMode "INTERACTIVE" `shouldBe` Nothing--  describe "BidirMode defaults" $ do-    it "default mode is Interactive" $-      defaultBidirMode `shouldBe` BidirInteractive--  describe "BidirMode equality" $ do-    it "BidirInteractive equals itself" $-      BidirInteractive `shouldBe` BidirInteractive--    it "BidirJson equals itself" $-      BidirJson `shouldBe` BidirJson--    it "BidirAutoCancel equals itself" $-      BidirAutoCancel `shouldBe` BidirAutoCancel--    it "BidirDefaults equals itself" $-      BidirDefaults `shouldBe` BidirDefaults--    it "BidirRespond equals itself" $-      BidirRespond `shouldBe` BidirRespond--    it "BidirCmd with same command equals itself" $-      BidirCmd "test.sh" `shouldBe` BidirCmd "test.sh"--    it "BidirCmd with different commands are not equal" $-      BidirCmd "a.sh" `shouldNotBe` BidirCmd "b.sh"--    it "different modes are not equal" $-      BidirInteractive `shouldNotBe` BidirJson--  describe "Request/Response type compatibility" $ do-    it "Confirm request expects Confirmed response" $ do-      let req = Confirm "OK?" Nothing :: Request Value-      let resp = Confirmed True :: Response Value-      -- Test that types are compatible (both compile and serialize)-      isJust (decode (encode resp) :: Maybe (Response Value)) `shouldBe` True--    it "Prompt request expects Value response" $ do-      let req = Prompt "Input?" Nothing Nothing :: Request Value-      let resp = Value (String "answer") :: Response Value-      isJust (decode (encode resp) :: Maybe (Response Value)) `shouldBe` True--    it "Select request expects Selected response" $ do-      let opts = [SelectOption (String "a") "A" Nothing]-      let req = Select "Pick" opts False :: Request Value-      let resp = Selected [String "a"] :: Response Value-      isJust (decode (encode resp) :: Maybe (Response Value)) `shouldBe` True--    it "Any request can receive Cancelled response" $ do-      let req = Confirm "?" Nothing :: Request Value-      let resp = Cancelled :: Response Value-      isJust (decode (encode resp) :: Maybe (Response Value)) `shouldBe` True--  describe "Complex Request/Response scenarios" $ do-    it "handles Select with multiple options" $ do-      let opts = [ SelectOption (String "opt1") "Option 1" (Just "First option")-                 , SelectOption (String "opt2") "Option 2" (Just "Second option")-                 , SelectOption (String "opt3") "Option 3" Nothing-                 ]-      let req = Select "Choose multiple" opts True :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      isJust decoded `shouldBe` True-      case decoded of-        Just (Select _ decodedOpts multi) -> do-          length decodedOpts `shouldBe` 3-          multi `shouldBe` True-          optionLabel (head decodedOpts) `shouldBe` "Option 1"-        _ -> expectationFailure "Expected Select request"--    it "handles Selected with multiple values" $ do-      let resp = Selected [String "a", String "b", String "c"] :: Response Value-      let json = encode resp-      let decoded = decode json :: Maybe (Response Value)-      case decoded of-        Just (Selected vals) -> length vals `shouldBe` 3-        _ -> expectationFailure "Expected Selected response"--    it "handles Prompt with complex default value" $ do-      let defaultVal = object ["name" .= String "John", "age" .= (30 :: Int)]-      let req = Prompt "User info" (Just defaultVal) Nothing :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      isJust decoded `shouldBe` True-      case decoded of-        Just (Prompt _ def _) -> def `shouldBe` Just defaultVal-        _ -> expectationFailure "Expected Prompt request"--  describe "Edge cases" $ do-    it "handles empty string in Confirm message" $ do-      let req = Confirm "" Nothing :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      decoded `shouldBe` Just req--    it "handles empty options list in Select" $ do-      let req = Select "Choose" [] False :: Request Value-      let json = encode req-      let decoded = decode json :: Maybe (Request Value)-      decoded `shouldBe` Just req--    it "handles empty selected values" $ do-      let resp = Selected [] :: Response Value-      let json = encode resp-      let decoded = decode json :: Maybe (Response Value)-      decoded `shouldBe` Just resp--    it "handles SelectOption with empty label" $ do-      let opt = SelectOption (String "val") "" Nothing :: SelectOption Value-      let json = encode opt-      let decoded = decode json :: Maybe (SelectOption Value)-      decoded `shouldBe` Just opt
test/DeprecationSpec.hs view
@@ -64,10 +64,7 @@   , methodError          = Nothing   , methodProgress       = Nothing   , methodCardinality    = CardinalityOne-  , methodBidirectional  = False   , methodHttpMethod     = "POST"-  , methodRequestType    = Nothing-  , methodResponseType   = Nothing   , methodDeprecation    = Nothing   , methodParamSchemas   = Nothing   , methodRole           = MethodRoleRpc
test/FindSpec.hs view
@@ -102,8 +102,8 @@ method ns name desc = MethodDef   { mdName = name, mdFullPath = ns <> "." <> name, mdNamespace = ns   , mdDescription = Just desc, mdParams = []-  , mdReturns = RefUnknown, mdError = Nothing, mdProgress = Nothing, mdCardinality = CardinalityOne, mdBidirType = Nothing, mdBidirResponseType = Nothing-  , mdBidirResponseSchema = Nothing, mdRole = MethodRoleRpc+  , mdReturns = RefUnknown, mdError = Nothing, mdProgress = Nothing, mdCardinality = CardinalityOne+  , mdRole = MethodRoleRpc   , mdGrant = Nothing, mdTarget = Nothing, mdLongDescription = Nothing   , mdInjected = [], mdInput = Nothing   }
test/HoldSpec.hs view
@@ -148,20 +148,21 @@             (fromException e :: Maybe LostConnection) `shouldSatisfy` (\x -> case x of { Nothing -> True; Just _ -> False })           Right _ -> expectationFailure "a call to a closed port answered" -    it "carries a bidirectional request and its answer" $+    -- ASK-1: no question routing — a write is an ordinary call, and the+    -- call after it another, each through the holder+    it "carries a write and the call after it" $       withSystemTempDirectory "hold" $ \dir -> withMockService todaysService $ \port -> do         let sock = dir </> "h.sock"+            call m ps = Object (KM.fromList [("method", String m), ("params", Object (KM.fromList ps))])         _ <- forkIO $ Hold.runHolder (Hold.holdOpts sock 30) `catchAll` const (pure ())         waitFor (doesFileExist sock)-        answered <- newIORef Nothing-        let onItem i = case i of-              StreamRequest {} -> void $ collect (Hold.holderCall sock "a1" (serviceAt port)) "menger.respond"-                (Object (KM.fromList [ ("request_id", String "req-1")-                                     , ("response_data", Object (KM.fromList [("type", String "confirmed"), ("value", Bool True)])) ]))-              StreamData _ _ "tickets.ask" v -> writeIORef answered (Just v)-              _ -> pure ()-        Hold.holderCall sock "a1" (serviceAt port) (pure ()) "menger.call" (Object (KM.fromList [("method", String "tickets.ask")])) onItem-        readIORef answered >>= (`shouldSatisfy` isJust)+        written <- collect (Hold.holderCall sock "a1" (serviceAt port)) "menger.call"+          (call "tickets.set_status" [("id", String "MENGER-12"), ("status", String "Ready")])+        [ v | StreamData _ _ "tickets.set_status" (Object v) <- written ]+          `shouldBe` [KM.fromList [("type", String "status_changed")]]+        got <- collect (Hold.holderCall sock "a1" (serviceAt port)) "menger.call" (call "tickets.get" [("id", String "MENGER-12")])+        [ v | StreamData _ _ "tickets.get" (Object v) <- got, KM.lookup "type" v == Just (String "ticket") ]+          `shouldSatisfy` ((== 1) . length)      it "exits when it has held nothing for --hold-for, and takes its socket with it" $       withSystemTempDirectory "hold" $ \dir -> do@@ -340,10 +341,10 @@     -- RETURNS-36: 4.0 changes the items the holder relays (plexus 0.8's     -- typed error and progress), so its holder is protocol 3, apart from     -- 3.17.x's (2)-    it "is holder-4.sock in the runtime directory, whatever the address or agent" $ do+    it "is holder-6.sock in the runtime directory, whatever the address or agent" $ do       p <- Hold.holderSocketPath-      takeFileName p `shouldBe` "holder-4.sock"-      Hold.holdProtocol `shouldBe` 4+      takeFileName p `shouldBe` "holder-6.sock"+      Hold.holdProtocol `shouldBe` 6    describe "the CLI, sending first" $ do     synapse <- runIO (findExecutable "synapse")@@ -364,10 +365,10 @@     out `shouldStartWith` "4.0"    -- re-review #5: help names the holder's socket as it is-  it "help names holder-4.sock" $ do+  it "help names holder-6.sock" $ do     (_, out, err) <- readCreateProcessWithExitCode (proc exe ["--help"]) ""-    (out <> err) `shouldContain` "holder-4.sock"-    (out <> err) `shouldNotContain` "holder-3.sock"+    (out <> err) `shouldContain` "holder-6.sock"+    (out <> err) `shouldNotContain` "holder-4.sock"    it "answers cold, fills the cache, and opens one connection for the probe, the schema and the call" $     withRun $ \run _ -> do
test/IR12MethodRoleSpec.hs view
@@ -52,9 +52,6 @@   , mdError               = Nothing   , mdProgress            = Nothing   , mdCardinality         = CardinalityOne-  , mdBidirType           = Nothing-  , mdBidirResponseType   = Nothing-  , mdBidirResponseSchema = Nothing   , mdRole                = MethodRoleRpc   , mdGrant               = Nothing   , mdTarget              = Nothing
test/IR3Spec.hs view
@@ -203,8 +203,8 @@   it "expected/ir.json decodes back to the same IR" $     eitherDecode golden `shouldBe` Right ir -  it "is IR 3.0" $-    irVersion ir `shouldBe` "3.0"+  it "is IR 3.1 (ASK-1: 3.0 without the bidir keys)" $+    irVersion ir `shouldBe` "3.1"    it "has every method of the schema, keyed by full path" $     Map.keys (irMethods ir) `shouldBe`@@ -368,9 +368,17 @@     it "plexus-core's MethodRole (in the fixture's SchemaResult) is tagged by kind" $       kindOf fixture "conformance.MethodRole" `shouldBe` Just (taggedEnum "kind"         [ variant "rpc" Nothing []-        , variant "static_child" Nothing []+        -- NEST-7: a peer slot is a static child marked `peer`, with its+        -- interface and its list / search methods.+        , variant "static_child" Nothing+            [ FieldDef "interface" (RefOptional (RefNamed (QualifiedName "conformance" "Interface"))) Nothing False Nothing+            , FieldDef "list_method" (RefOptional (RefPrimitive "string" Nothing)) Nothing False Nothing+            , FieldDef "peer" (RefPrimitive "boolean" Nothing) Nothing False Nothing+            , FieldDef "search_method" (RefOptional (RefPrimitive "string" Nothing)) Nothing False Nothing ]+        -- NEST-5: a dynamic child carries its slot's type.         , variant "dynamic_child" Nothing-            [ FieldDef "list_method" (RefOptional (RefPrimitive "string" Nothing)) Nothing False Nothing+            [ FieldDef "child" (RefOptional (RefNamed (QualifiedName "conformance" "PluginSchema"))) Nothing False Nothing+            , FieldDef "list_method" (RefOptional (RefPrimitive "string" Nothing)) Nothing False Nothing             , FieldDef "search_method" (RefOptional (RefPrimitive "string" Nothing)) Nothing False Nothing ] ])      it "a tag called kind" $ do
test/IRCoverageSpec.hs view
@@ -370,7 +370,8 @@             [ "method " <> T.unpack key <> ":\n  old " <> show old' <> "\n  new " <> show new'             | (k, v) <- KM.toList oldMethods             , let key = K.toText k-                  old' = norm (dropKeys ["mdStreaming"] (dropInjected v))+                  -- ASK-1: 3.1 drops 2.0's mdBidir*+                  old' = norm (dropKeys ["mdStreaming", "mdBidirType", "mdBidirResponseType", "mdBidirResponseSchema"] (dropInjected v))                   new' = maybe Null (norm . dropKeys ["mdInjected", "mdInput", "mdError", "mdProgress", "mdCardinality"] . toJSON) (Map.lookup key (irMethods ir))             , not (changedIn20 (dropInjected v)), old' /= new'             -- chats.inputs is refused whole in 3.0 (two types titled Message)
test/IRSpec.hs view
@@ -89,7 +89,7 @@ irSpec ir = do   describe "Schema fetching" $ do     it "builds IR from root" $-      irVersion ir `shouldBe` "3.0"+      irVersion ir `shouldBe` "3.1"      it "IR contains methods" $       Map.size (irMethods ir) `shouldSatisfy` (> 0)
test/MockService.hs view
@@ -55,8 +55,6 @@   ) where  import Control.Concurrent (forkIO, threadDelay)-import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, tryPutMVar, tryTakeMVar)-import System.Timeout (timeout) import Control.Exception (SomeException, bracket, finally, try) import Control.Monad (forever, void) import Data.Aeson@@ -439,10 +437,6 @@                     Right () -> threadDelay 100000 >> tick (n + 1)           tick 0           atomicModifyIORef' floodsEnded (\n -> (n + 1, ()))-        -- waits for its answer off the connection's loop, as a real service-        -- runs calls side by side (SYNAPSE-28: the answer may come on this-        -- very connection)-        "tickets.ask" -> void $ forkIO (askBack emit meta dat err >> done)         -- SYNAPSE-28: a stream that never ends by itself (until unsubscribed)         "tickets.watch" -> dat "tickets.watch" (object ["type" .= ("watching" :: Text)])         -- BIDIR-18: a method with an input half: credit at once, then the@@ -465,10 +459,6 @@         "tickets.schema" | renamed, scView sc /= AnonymousView, not (scCatalog sc) ->           dat "tickets.schema" (renameGet (ticketsSchema sc)) >> done         _ -> callMethod sc signedIn inner args dat err >> done-    -- SCAFFOLD-21: a bidirectional answer, on a connection of its own-    "menger.respond" -> do-      void (tryPutMVar responses (KM.lookup "response_data" params))-      done     _ -> err ("Invalid method format: " <> method) [] >> done   where     send :: Value -> IO ()@@ -590,26 +580,6 @@   | lookup "error_kind" extra == Just (String "forbidden") = "-32003"   | "not found" `T.isInfixOf` m = "-32601"   | otherwise = "-32000"---- | SCAFFOLD-21: the answers to 'askBack's requests (@menger.respond@'s--- @response_data@), as they arrive on any connection.-{-# NOINLINE responses #-}-responses :: MVar (Maybe Value)-responses = unsafePerformIO newEmptyMVar---- | A bidirectional method (@tickets.ask@): it asks the caller to confirm--- (a @request@ item), waits up to 5 s for @menger.respond@, and answers--- with what came back.-askBack :: (Value -> IO ()) -> Value -> (Text -> Value -> IO ()) -> (Text -> [(K.Key, Value)] -> IO ()) -> IO ()-askBack emit meta dat err = do-  _ <- tryTakeMVar responses-  emit (object-    [ "type" .= ("request" :: Text), "metadata" .= meta, "request_id" .= ("req-1" :: Text)-    , "request" .= object ["type" .= ("confirm" :: Text), "message" .= ("go on?" :: Text)] ])-  got <- timeout 5000000 (takeMVar responses)-  case got of-    Just (Just r) -> dat "tickets.ask" (object ["type" .= ("answered" :: Text), "response" .= r])-    _ -> err "no response to req-1" []  infoFor :: Scenario -> Value infoFor sc = case scView sc of
test/OutputSpec.hs view
@@ -249,25 +249,17 @@         err `shouldContain` "tickets.set_status"         doesFileExist file >>= (`shouldBe` False) -  it "a two-way request's line goes to stderr, its answer to FILE" $+  -- ASK-1: a write is an ordinary call; under -j its line goes to FILE+  it "a write under -j: its answer in FILE, nothing on stdout, exit 0" $     withRun $ \dir spawn -> do       warm spawn       let file = dir </> "answer.out"-      (Just inp, Just out, Just err, ph) <- createProcess (spawn ["--bidir-mode", "json", "-o", file] ["tickets", "ask"])-      let untilRequest = do-            l <- hGetLine err-            if "bidir_request" `isInfixOf` l then pure l else untilRequest-      req <- timeout 10000000 untilRequest-      req `shouldSatisfy` (/= Nothing)-      hPutStrLn inp "{\"type\":\"confirmed\",\"value\":true}"-      hFlush inp-      code <- timeout 10000000 (waitForProcess ph)-      code `shouldBe` Just ExitSuccess-      o <- BS.hGetContents out-      BS.length o `shouldBe` 0+      (code, out, _) <- reading (spawn ["-j", "-o", file]) ["tickets", "set_status", "--id", "MENGER-12"]+      (code, out) `shouldBe` (ExitSuccess, "")       body <- readFile' file-      body `shouldContain` "answered"-      body `shouldNotContain` "bidir_request"+      body `shouldContain` "status_changed"+      modeOf file `shouldReturn` 0o600+      leftovers dir "answer.out" >>= (`shouldBe` [])    forM_ [("a SIGTERM", ExitFailure 143)] $ \(how, want) ->    it (how <> " during an answer leaves no FILE and no temporary file") $@@ -356,7 +348,6 @@       , m "amend" "Replace a ticket's body" (Just "write") False [("id", True), ("body", False)]       , m "flood" "Ticks, every 100 ms, until unsubscribed" (Just "read") True []       , m "set_status" "Change a ticket's status" (Just "write") False [("id", True)]-      , m "ask" "Ask the caller to confirm" (Just "write") False []         -- the service's tickets.watch, said here to be unary: one item, and no end       , m "watch" "One item, and no end" (Just "read") False [] ] ]   where
test/ParseSpec.hs view
@@ -348,9 +348,6 @@   , mdError = Nothing   , mdProgress = Nothing   , mdCardinality = CardinalityOne-  , mdBidirType = Nothing-  , mdBidirResponseType = Nothing-  , mdBidirResponseSchema = Nothing   , mdRole = MethodRoleRpc   , mdGrant = Nothing   , mdTarget = Nothing
test/ReconnectSpec.hs view
@@ -152,8 +152,8 @@ method name grp params = MethodSchema   { methodName = name, methodDescription = "", methodHash = "h", methodParams = params   , methodReturns = Object mempty, methodError = Nothing, methodProgress = Nothing-  , methodCardinality = CardinalityOne, methodBidirectional = False, methodHttpMethod = "POST"-  , methodRequestType = Nothing, methodResponseType = Nothing, methodDeprecation = Nothing+  , methodCardinality = CardinalityOne, methodHttpMethod = "POST"+  , methodDeprecation = Nothing   , methodParamSchemas = Nothing, methodRole = MethodRoleRpc, methodLongDescription = Nothing   , methodGrant = Nothing, methodTarget = Nothing, methodHeldOn = Nothing, methodPublic = False   , methodGroup = grp, methodExamples = [], methodInput = Nothing }@@ -179,8 +179,6 @@       csRead (callShape (method "list" (Just "inputs") Nothing)) `shouldBe` True       csRead (callShape (method "answer" (Just "inputs") Nothing)) `shouldBe` False       csRead (callShape (method "post" Nothing Nothing)) `shouldBe` False-    it "is never a read when bidirectional" $-      csRead (callShape ((method "get" (Just "read") Nothing) { methodBidirectional = True })) `shouldBe` False     it "takes since when its params have one" $ do       let ps = object ["type" .= ("object" :: Text), "properties" .= object ["since" .= object [], "id" .= object []]]       csSince (callShape (method "await_reply" (Just "read") (Just ps))) `shouldBe` True
test/RenderSpec.hs view
@@ -32,8 +32,8 @@ method name desc params = MethodSchema   { methodName = name, methodDescription = desc, methodHash = "h", methodParams = params   , methodReturns = Object mempty, methodError = Nothing, methodProgress = Nothing-  , methodCardinality = CardinalityMany, methodBidirectional = False, methodHttpMethod = "POST"-  , methodRequestType = Nothing, methodResponseType = Nothing, methodDeprecation = Nothing+  , methodCardinality = CardinalityMany, methodHttpMethod = "POST"+  , methodDeprecation = Nothing   , methodParamSchemas = Nothing, methodRole = MethodRoleRpc   , methodLongDescription = Nothing, methodGrant = Nothing, methodTarget = Nothing, methodHeldOn = Nothing, methodPublic = False   , methodGroup = Nothing, methodExamples = [], methodInput = Nothing }
test/Req8RenderSpec.hs view
@@ -52,10 +52,7 @@       , methodError         = Nothing       , methodProgress      = Nothing       , methodCardinality   = Plexus.Schema.Recursive.CardinalityOne-      , methodBidirectional = False       , methodHttpMethod    = "POST"-      , methodRequestType   = Nothing-      , methodResponseType  = Nothing       , methodDeprecation   = Nothing       , methodParamSchemas  = Nothing       , methodRole          = defaultRole
test/TlsSpec.hs view
@@ -15,7 +15,8 @@ import Control.Concurrent (forkIO, killThread) import Control.Exception (SomeException, bracket, finally, try) import Control.Monad (forever, void)-import Data.Aeson (Value(..), decodeStrict, object)+import Data.Aeson (Value(..), decodeStrict, object, (.=))+import Data.Text (Text) import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString as BS import qualified Data.ByteString.Base64.URL as B64U@@ -42,9 +43,8 @@ import qualified Synapse.Log as Log import Synapse.Monad (initEnvAt, runSynapseM) import Synapse.Schema.Types (pattern ServiceData)-import Synapse.Transport (invoke, invokeStreamingWithBidir)+import Synapse.Transport (invoke, invokeStreamingCall) import Synapse.Reconnect (CallShape(..))-import Plexus.Types (Response(..))  main :: IO () main = do@@ -160,25 +160,25 @@         proofs `shouldSatisfy` (not . null)         mapM_ (\p -> KM.lookup "aud" p `shouldBe` Just (String ("wss://localhost:" <> T.pack (show port)))) proofs -    it "carries a bidirectional request and its answer (respond goes over wss too)" $ \pki ->+    -- ASK-1: a write is an ordinary call; the call after it another, both+    -- through TLS at the path+    it "carries a write and the call after it (two calls, both over wss)" $ \pki ->       withMockService todaysService $ \service -> withTerminator pki service $ \port heads -> do         lg <- logger         env <- initEnvAt (Endpoint "localhost" port True "/ws" [pkiCa pki]) "menger" lg Nothing         seen <- newIORef []-        asked <- newIORef []-        r <- runSynapseM env $ invokeStreamingWithBidir-          (CallShape { csStream = False, csRead = False, csSince = False })-          (pure Nothing) (const (pure ())) ["tickets"] "ask" (object [])-          (\i -> modifyIORef' seen (++ [i]))-          (\rid _ -> modifyIORef' asked (++ [rid]) >> pure (Just (Confirmed True :: Response Value)))-        r `shouldSatisfy` either (const False) (const True)-        readIORef asked `shouldReturn` ["req-1"]+        let shape = CallShape { csStream = False, csRead = False, csSince = False }+            call m ps = runSynapseM env $ invokeStreamingCall shape (pure Nothing) (const (pure ()))+              ["tickets"] m ps (\i -> modifyIORef' seen (++ [i]))+        call "set_status" (object ["id" .= ("MENGER-12" :: Text), "status" .= ("Ready" :: Text)])+          >>= (`shouldSatisfy` either (const False) (const True))+        call "get" (object ["id" .= ("MENGER-12" :: Text)])+          >>= (`shouldSatisfy` either (const False) (const True))         items <- readIORef seen-        [v | ServiceData _ _ _ (Object v) <- items, KM.lookup "type" v == Just (String "answered")]-          `shouldBe` [KM.fromList [("type", String "answered"), ("response", object [("type", String "confirmed"), ("value", Bool True)])]]-        -- the call and the respond: two upgrades, both through TLS at the path+        [ t | ServiceData _ _ _ (Object v) <- items, Just (String t) <- [KM.lookup "type" v] ]+          `shouldBe` ["status_changed", "ticket"]         hs <- readIORef heads-        length (filter (BS.isPrefixOf "GET /ws HTTP/1.1") hs) `shouldSatisfy` (>= 2)+        length (filter (BS.isPrefixOf "GET /ws HTTP/1.1") hs) `shouldSatisfy` (>= 1)    describe "refusing what it cannot verify" $ do     it "refuses a certificate the trust store does not vouch for — nothing is sent" $ \pki ->