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 +27/−0
- README.md +14/−15
- app/Main.hs +10/−53
- plexus-synapse.cabal +3/−42
- src/Synapse/Bidir.hs +0/−275
- src/Synapse/CLI/Parse.hs +1/−1
- src/Synapse/CLI/Source.hs +4/−4
- src/Synapse/Deprecation.hs +2/−2
- src/Synapse/Endpoint.hs +1/−1
- src/Synapse/Hold.hs +8/−4
- src/Synapse/IR/Builder.hs +3/−19
- src/Synapse/IR/Types.hs +9/−39
- src/Synapse/Log.hs +0/−2
- src/Synapse/Output.hs +2/−12
- src/Synapse/Reconnect.hs +4/−6
- src/Synapse/Schema/Types.hs +0/−16
- src/Synapse/Self/Protocol/StreamTracker.hs +0/−2
- src/Synapse/Self/Protocol/TestRunner.hs +0/−12
- src/Synapse/Self/Protocol/Validator.hs +6/−9
- src/Synapse/Transport.hs +9/−47
- test/BidirIntegrationSpec.hs +0/−268
- test/BidirSpec.hs +0/−325
- test/DeprecationSpec.hs +0/−3
- test/FindSpec.hs +2/−2
- test/HoldSpec.hs +17/−16
- test/IR12MethodRoleSpec.hs +0/−3
- test/IR3Spec.hs +12/−4
- test/IRCoverageSpec.hs +2/−1
- test/IRSpec.hs +1/−1
- test/MockService.hs +0/−30
- test/OutputSpec.hs +7/−16
- test/ParseSpec.hs +0/−3
- test/ReconnectSpec.hs +2/−4
- test/RenderSpec.hs +2/−2
- test/Req8RenderSpec.hs +0/−3
- test/TlsSpec.hs +16/−16
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 ->