diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,47 @@ +# Changelog for plexus-protocol + +## 0.6.0.0 + +The Haskell side of plexus 0.7's schema and envelope. Breaking. + +### Breaking + +- **Method schemas (`Plexus.Schema.Recursive`).** `MethodSchema` gains + `methodReturns` (required), `methodError` and `methodProgress`, and + `methodCardinality :: Cardinality` (`CardinalityOne` / `CardinalityMany`). + `methodStreaming` is removed. A schema from the published 0.7.0 line (no + `cardinality`) is still read, its cardinality taken from the method's own + `streaming` flag; cardinality is never guessed otherwise. + `psSelfHash` (`self_hash`) and `methodHttpMethod` (`http_method`, default + `"POST"`) are read. Absent optional fields encode as omitted, not `null`, + as the Rust side writes them. +- **Typed remote errors (new `Plexus.RemoteError`).** `RemoteError` is one + of `ActivationNotFound`, `MethodNotFound`, `InvalidParams`, + `Unauthenticated`, `Forbidden DenyReason` (including `MissingGrant`), + `HandleNotSupported`, `Execution`, or an open variant that keeps an + unknown kind and all its fields and writes them back as they came. + `renderRemoteError` gives the Rust `Display` line. +- **Stream items (`Plexus.Types`).** `StreamError` carries + `error :: RemoteError` and `recoverable` (was `message`), keeping the + server's own message and any refusal fields sent beside it. + `StreamProgress` carries `content_type` and `content` (was `message`, + `percentage`); a 0.7.0 progress frame is read as a note. + `RpcError.errData` is `Maybe RemoteError`; `RpcError` has a `ToJSON` + instance. `-32601` is typed as an activation or method not found by its + message. +- `Plexus.Client` yields a rejection's `RemoteError` as its `StreamError`; + the `Transport` and `Schema` helpers render it to `Text` where they used + to return the message. + +### Added + +- **The input half of a call (new `Plexus.Input`, plexus-wire spec/10).** + The frames a client sends into a call (`.input`, `.end` and the + binary frame), the signals the callee sends back (`credit`, `ack`, + `input_closed`) and `itemKind`. `Plexus.Client.substrateRpcDuplex` hands a + call its `InputPort`; credit, ack and input_closed are taken off before + item parsing. `substrateRpcSub` is unchanged for a method without input. + `Plexus.Transport` adds `DuplexRoute`, `setDuplexRouter` and + `invokeMethodDuplex`. +- Test suite `plexus-protocol-test`: the plexus 0.7 conformance fixture + parsed and re-encoded. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,234 @@ +# plexus-protocol + +**Haskell types for Plexus RPC** — shared between Synapse and other Plexus RPC clients. + +## Layers + +``` +┌─────────────────────────────────────────┐ +│ Plexus.Types │ Stream items, provenance +│ Plexus.Schema.Recursive │ PluginSchema, MethodSchema +├─────────────────────────────────────────┤ +│ Substrate.Transport │ RPC calls, schema fetching +│ Substrate.Client │ WebSocket connection +└─────────────────────────────────────────┘ +``` + +**Substrate** = transport layer modules (WebSocket, JSON-RPC) +**Plexus** = Plexus RPC protocol types (schemas, stream items) + +## Usage + +```haskell +import Plexus +import qualified Streaming.Prelude as S + +main :: IO () +main = do + conn <- connect defaultConfig + S.print $ substrateRpc conn "health.check" (object []) + disconnect conn +``` + +### wss (SCAFFOLD-21, 0.5.2.0) + +A service behind TLS (a hosted app: `wss:///ws`) is dialed when +`substrateTls` is `Just`: the `tls` package over a TCP socket, SNI and the +name check against `substrateHost`, the chain against the system's trust +store (crypton-x509-system; `SYSTEM_CERTIFICATE_PATH` overrides it) plus each +PEM file in `tlsCaFiles`. Verification cannot be turned off. `defaultConfig` +is `Nothing` (plain `ws://`), as before; the upgrade's `Host` is `hostHeader` +(the host alone on the scheme's default port). + +```haskell +let cfg = (defaultConfig "hostdemo") + { substrateHost = "hostdemo.menger.sh", substratePort = 443 + , substratePath = "/ws", substrateTls = Just defaultTlsOptions } +Right items <- rpcCallWith cfg "_info" Null +``` + +### Routing calls (SYNAPSE-28, 0.5.3.0) + +`Plexus.Transport.setCallRouter` sends the calls whose config the router +answers `Just` for some other way than this process's pools — synapse uses +it to put every call of a run through a connection held between runs, or +through one connection the run shares. A route reports failures as +`connect` and `substrateRpcWith` do (`LostConnection` with whether the +request had gone out; a failed dial as an error call), so everything above +it reads them as before. A program that never sets it is unchanged. + +`Plexus.Client.substrateRpcSub` is `substrateRpcWith` telling the caller the +subscription's id, and `unsubscribe conn ".call_unsub" sid` ends a +call it no longer reads (a number id is sent as a number) — for a connection +shared by many calls, where one abandoned must not keep streaming. + +### Schema Fetching + +```haskell +import Substrate.Transport + +-- Fetch plugin schema +Right schema <- fetchSchemaAt defaultConfig ["echo"] +print $ psNamespace schema -- "echo" +print $ psMethods schema -- [MethodSchema...] + +-- Fetch method schema directly +Right method <- fetchMethodSchemaAt defaultConfig ["echo"] "once" +print $ methodName method -- "once" +print $ methodParams method -- Just (JSON Schema) +``` + +## Types + +### Transport Errors (v0.3.0+) + +Strongly-typed errors for transport-layer failures: + +```haskell +data TransportError + = ConnectionRefused { transportHost :: Text, transportPort :: Int } + | ConnectionTimeout { transportHost :: Text, transportPort :: Int } + | ProtocolError { transportMessage :: Text } + | NetworkError { transportMessage :: Text } +``` + +All transport functions return `Either TransportError a` instead of `Either Text a`: + +```haskell +-- Schema fetching +fetchSchemaAt :: SubstrateConfig -> [Text] -> IO (Either TransportError PluginSchema) + +-- Method invocation +invokeMethod :: SubstrateConfig -> [Text] -> Text -> Value + -> IO (Either TransportError [PlexusStreamItem]) + +-- Streaming invocation +invokeMethodStreaming :: SubstrateConfig -> [Text] -> Text -> Value + -> (PlexusStreamItem -> IO ()) + -> IO (Either TransportError ()) +``` + +**Benefits:** +- No string parsing to categorize errors +- Structured error information (host, port, message) +- Type-safe error handling +- Proper exception categorization using `IOException` matching + +**Example:** + +```haskell +result <- fetchSchemaAt cfg ["echo"] +case result of + Left (ConnectionRefused host port) -> + putStrLn $ "Can't connect to " <> host <> ":" <> show port + Left (ConnectionTimeout host port) -> + putStrLn $ "Timeout connecting to " <> host <> ":" <> show port + Left (ProtocolError msg) -> + putStrLn $ "Protocol error: " <> msg + Left (NetworkError msg) -> + putStrLn $ "Network error: " <> msg + Right schema -> + print schema +``` + +### Stream Items (plexus 0.7) + +```haskell +data PlexusStreamItem + = StreamProgress Text Provenance Text Value -- hash, provenance, content_type, content (the method's progress P) + | StreamData Text Provenance Text Value -- hash, provenance, content_type, content (T, or {"ok": T} | {"err": E}) + | StreamGuidance … + | StreamError Text Provenance RemoteError Bool -- hash, provenance, error, recoverable + | StreamRequest … + | StreamDone Text Provenance +``` + +An error frame means the call itself failed, and says why with a +`RemoteError` (`Plexus.RemoteError`, mirroring `plexus_client::RemoteError`; +`renderRemoteError` is its one-line rendering). A JSON-RPC rejection carries +the same type in `errData`. An activation saying no is a data item whose +content is `{"err": …}`. + +```haskell +data RemoteError + = ActivationNotFound Text -- activation + | MethodNotFound Text Text -- activation, method + | InvalidParams (Maybe Text) ParamProblem + | Unauthenticated + | Forbidden DenyReason + | HandleNotSupported Text -- activation + | Execution Text -- message + +data ParamProblem = Missing | Malformed Text +data DenyReason = MissingScope Text | TenantBoundary | NotAccepted +``` + +### Schema Types + +```haskell +data PluginSchema = PluginSchema + { psNamespace :: Text + , psVersion :: Text + , psDescription :: Text + , psLongDescription :: Maybe Text + , psSelfHash :: Maybe PluginHash + , psHash :: PluginHash + , psMethods :: [MethodSchema] + , psChildren :: Maybe [ChildSummary] + , psDeprecation :: Maybe DeprecationInfo + } + +-- plexus 0.7: a method's contract is T, E?, P? and its cardinality +data MethodSchema = MethodSchema + { methodName :: Text + , methodDescription :: Text + , methodHash :: PluginHash + , methodParams :: Maybe Value -- JSON Schema + , methodReturns :: Value -- JSON Schema of the item type T (required) + , methodError :: Maybe Value -- JSON Schema of the error type E (fallible methods) + , methodProgress :: Maybe Value -- JSON Schema of the progress type P + , methodCardinality :: Cardinality -- CardinalityOne | CardinalityMany (required) + , … -- bidirectional, http_method, request/response types, deprecation, role + } + +data SchemaResult + = SchemaPlugin PluginSchema + | SchemaMethod MethodSchema +``` + +## Structure + +``` +src/ +├── Plexus.hs # Re-exports +├── Plexus/ +│ ├── Types.hs # PlexusStreamItem, Provenance +│ ├── Schema.hs # Schema re-exports +│ └── Schema/ +│ ├── Recursive.hs # PluginSchema, MethodSchema, SchemaResult +│ └── Cache.hs # Schema caching +└── Substrate/ + ├── Client.hs # WebSocket connection + └── Transport.hs # RPC calls, schema fetching +``` + +## Build + +```bash +cabal build +cabal test # test-suite naming-gate +scripts/naming-gate.sh # the naming gate: each line that says the retired word (-c: the count) +``` + +A Plexus backend is a *service*, and an activation with children a *parent* +(`isParentActivation`; NAMING-9, `~/AGENTS.md` "Naming"). The suite runs the +gate, which passes only lines marked `naming-alias`: the deprecated old name of +`isParentActivation`, kept until NAMING-18. + +The tests read the plexus 0.7 conformance fixture (RETURNS-7) by sibling +path, `../plexus-macros/fixtures/conformance/expected/`: check out +plexus-macros next to this repository first. + +## License + +MIT diff --git a/plexus-protocol.cabal b/plexus-protocol.cabal --- a/plexus-protocol.cabal +++ b/plexus-protocol.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: plexus-protocol -version: 0.5.5.0 +version: 0.6.0.0 synopsis: Plexus RPC protocol types and client description: Haskell types and a client for Plexus RPC, a streaming JSON-RPC 2.0 protocol: stream items and provenance, recursive plugin and method @@ -14,15 +14,19 @@ category: Network build-type: Simple tested-with: GHC == 9.8.4, GHC == 9.12.4 +extra-doc-files: README.md + CHANGELOG.md library exposed-modules: Plexus.Client Plexus.Client.Pool + Plexus.Input Plexus.Transport Plexus Plexus.Types Plexus.Auth + Plexus.RemoteError Plexus.Schema Plexus.Schema.Cache Plexus.Schema.Recursive @@ -46,7 +50,9 @@ directory >= 1.3, filepath >= 1.4, time >= 1.9, - resource-pool >= 0.4 + resource-pool >= 0.4, + -- BIDIR-18: credit and seq read as bounded integers + scientific >= 0.3 hs-source-dirs: src default-language: GHC2021 default-extensions: @@ -72,3 +78,25 @@ hs-source-dirs: test default-language: GHC2021 ghc-options: -threaded -rtsopts "-with-rtsopts=-M6G" + +-- Golden tests against the plexus 0.7 conformance fixture (RETURNS-7), read +-- by sibling path from ../plexus-macros/fixtures/conformance/expected/. +test-suite plexus-protocol-test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + build-depends: + base, + plexus-protocol, + aeson, + bytestring, + containers, + directory, + filepath, + hspec >= 2.7, + text + default-language: GHC2021 + default-extensions: + OverloadedStrings + LambdaCase + ghc-options: -Wall diff --git a/src/Plexus.hs b/src/Plexus.hs --- a/src/Plexus.hs +++ b/src/Plexus.hs @@ -25,9 +25,9 @@ -- -- The Plexus RPC protocol returns a unified stream type with variants: -- --- * 'StreamProgress' - Progress updates with optional percentage +-- * 'StreamProgress' - A method's typed progress report (its @P@) -- * 'StreamData' - Actual data with content type information --- * 'StreamError' - Error (may be recoverable) +-- * 'StreamError' - The call failed, typed as a 'RemoteError' (may be recoverable) -- * 'StreamDone' - Stream completed successfully -- module Plexus @@ -66,9 +66,16 @@ , PlexusStreamItem(..) , Provenance(..) + -- * Call Failures + , RemoteError(..) + , ParamProblem(..) + , DenyReason(..) + , renderRemoteError + -- * Schema Types , PluginSchema(..) , MethodSchema(..) + , Cardinality(..) , ChildSummary(..) , PluginHash , SchemaResult(..) @@ -82,6 +89,7 @@ ) where import Plexus.Types +import Plexus.RemoteError import Plexus.Schema.Recursive import Plexus.Client import Plexus.Transport diff --git a/src/Plexus/Client.hs b/src/Plexus/Client.hs --- a/src/Plexus/Client.hs +++ b/src/Plexus/Client.hs @@ -23,6 +23,7 @@ , substrateRpc , substrateRpcWith , substrateRpcSub + , substrateRpcDuplex , unsubscribe -- * Configuration @@ -67,6 +68,8 @@ import Streaming import qualified Streaming.Prelude as Str +import Plexus.Input (InputHalf(..), InputPort(..), inputSignal, inputFrame, endFrame, binaryFrame, inputNamespace, subscriptionWord) +import Plexus.RemoteError (RemoteError(..)) import Plexus.Types -- | Substrate connection configuration @@ -386,6 +389,26 @@ decodeStrictText :: Text -> Maybe Value decodeStrictText = decode . LBS.fromStrict . BS8.pack . T.unpack +-- | BIDIR-18: the input port of a call on this connection: its frames +-- addressed to @ns@ and the subscription, sent on this socket. A send that +-- fails is the connection's loss, after the call's request went out. +connectionPort :: SubstrateConnection -> Text -> SubscriptionId -> InputPort +connectionPort conn ns sid = InputPort + { ipItems = \sq items -> sending (WS.sendTextData (scConnection conn) (inputFrame ns sid sq items)) + , ipBinary = \sq payload -> case subscriptionWord sid of + Just w -> sending (WS.sendBinaryData (scConnection conn) (binaryFrame w sq payload)) + Nothing -> throwIO (userError ("a binary input frame needs an integer subscription id, not " <> T.unpack (unSubscriptionId sid))) + , ipEnd = \sq -> sending (WS.sendTextData (scConnection conn) (endFrame ns sid sq)) + } + where + sending act = do + gone <- connectionLost conn + case gone of + Just why -> throwIO (LostConnection why True) + Nothing -> act `catch` \(e :: SomeException) -> do + why <- maybe (describeEnd e) id <$> connectionLost conn + throwIO (LostConnection why True) + -- | Disconnect from substrate disconnect :: SubstrateConnection -> IO () disconnect SubstrateConnection{..} = do @@ -500,7 +523,22 @@ -> Text -> Value -> Stream (Of PlexusStreamItem) IO () -substrateRpcSub conn onSubscribed method params = do +substrateRpcSub conn = substrateRpcDuplex conn Nothing + +-- | BIDIR-18: 'substrateRpcSub' for a call with an input half +-- (plexus-wire spec/10). Once the subscription is known the half's port is +-- handed over — before @onSubscribed@, so a caller told the call was taken +-- can send — and each @credit@, @ack@ and @input_closed@ goes to its +-- signal handler, never into the stream. Without a half, those three are +-- dropped (a method without input never sends them). +substrateRpcDuplex + :: SubstrateConnection + -> Maybe InputHalf + -> (SubscriptionId -> IO ()) + -> Text + -> Value + -> Stream (Of PlexusStreamItem) IO () +substrateRpcDuplex conn half onSubscribed method params = do -- SYNAPSE-20: a connection already gone (it died idle in a pool) takes -- no request; nothing was sent, so the caller may always try again gone <- liftIO $ connectionLost conn @@ -537,13 +575,19 @@ Left why -> liftIO $ throwIO (LostConnection why True) Right (RpcError _ err) -> do - -- Emit error as StreamError so caller can handle it properly + -- Emit error as StreamError so caller can handle it properly. + -- A Plexus rejection carries its RemoteError in `data`; one that + -- carries none (not a Plexus call failure) is reported as an + -- execution failure naming the whole rejection. Str.yield $ StreamErrorWith { itemPlexusHash = "" -- No hash available for subscription errors , itemProvenance = Provenance ["substrate"] - , itemError = T.pack $ "Subscription error: " <> show err + , itemError = case errData err of + Just remote -> remote + Nothing -> Execution $ T.pack $ "Subscription error: " <> show err , itemRecoverable = False , itemErrorRefusal = Nothing + , itemErrorBeside = KM.empty } Right (RpcSuccess _ result) -> do @@ -555,6 +599,7 @@ pure () Success subId -> do + liftIO $ mapM_ (\h -> ihPort h (connectionPort conn (inputNamespace method) subId)) half liftIO (onSubscribed subId) -- Stream items until done, cleanup when finished streamItems queue subId <* liftIO (cleanup subId) @@ -571,6 +616,14 @@ streamItems :: TQueue Value -> SubscriptionId -> Stream (Of PlexusStreamItem) IO () streamItems queue subId = do val <- liftIO $ next queue + case inputSignal val of + Just sig -> do + liftIO $ mapM_ (\h -> ihSignal h sig) half + streamItems queue subId + Nothing -> item val queue subId + + item :: Value -> TQueue Value -> SubscriptionId -> Stream (Of PlexusStreamItem) IO () + item val queue subId = case fromJSON val of Error err -> do liftIO $ putStrLn $ "Failed to parse stream item: " <> err diff --git a/src/Plexus/Input.hs b/src/Plexus/Input.hs new file mode 100644 --- /dev/null +++ b/src/Plexus/Input.hs @@ -0,0 +1,180 @@ +-- | BIDIR-18: a call's input half, as plexus-wire spec/10 draws it. +-- +-- A method that declares @input@ beside its @params@ takes a stream in +-- beside its stream out. The client sends +-- +-- @ +-- → {"jsonrpc":"2.0","method":".input","params":{"subscription":S,"seq":N,"items":[…]}} +-- → [0x01][S: u64 BE][N: u64 BE][payload] (a binary frame, one item: BIDIR-17) +-- → {"jsonrpc":"2.0","method":".end","params":{"subscription":S,"seq":FRAMES}} +-- @ +-- +-- under the credit the callee grants with its output items @credit {n}@ (items), +-- and is told what it consumed with @ack {seq}@ (frames) and when it stopped +-- reading with @input_closed {reason, ack?}@. Those three are the +-- transport's, never a 'Plexus.Types.PlexusStreamItem': 'inputSignal' reads +-- them off a notification's @result@ before anything parses it as an item. +-- +-- There is no resume (spec/10): a call dies with its socket, and nothing +-- here sends a frame twice. +module Plexus.Input + ( -- * What the callee says of the input half + InputSignal(..) + , inputSignal + , inputSignalValue + + -- * Where a call's input goes + , InputPort(..) + , InputHalf(..) + + -- * Frames + , inputFrame + , endFrame + , binaryFrame + , binaryHeader + , subscriptionValue + , subscriptionWord + , inputNamespace + + -- * An item schema + , ItemKind(..) + , itemKind + ) where + +import Data.Aeson +import qualified Data.Aeson.Key as K +import qualified Data.Aeson.KeyMap as KM +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import Data.Scientific (toBoundedInteger) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Word (Word64) + +import Plexus.Types (SubscriptionId(..)) + +-- | One of the input half's output items (spec/10). +data InputSignal + = InputCredit Integer + -- ^ @credit {n}@: the callee takes @n@ more items + | InputAck Integer + -- ^ @ack {seq}@: every frame through @seq@ is consumed + | InputClosed Text (Maybe Integer) + -- ^ @input_closed {reason, ack?}@: the callee reads no more — + -- @method_ended@, or the @error_kind@ of the refusal that follows + deriving stock (Show, Eq) + +-- | The signal a notification's @result@ is, if it is one. +inputSignal :: Value -> Maybe InputSignal +inputSignal = \case + Object o -> case KM.lookup "type" o of + Just (String "credit") -> InputCredit <$> int "n" o + Just (String "ack") -> InputAck <$> int "seq" o + Just (String "input_closed") -> Just $ InputClosed + (case KM.lookup "reason" o of { Just (String r) -> r; _ -> "" }) + (int "ack" o) + _ -> Nothing + _ -> Nothing + where + int k o = case KM.lookup k o of + Just (Number n) -> toInteger <$> (toBoundedInteger n :: Maybe Int) + _ -> Nothing + +-- | The signal as the callee writes it: 'inputSignal' reads it back. +inputSignalValue :: InputSignal -> Value +inputSignalValue = \case + InputCredit n -> object ["type" .= ("credit" :: Text), "n" .= n] + InputAck sq -> object ["type" .= ("ack" :: Text), "seq" .= sq] + InputClosed reason ack -> object $ + ["type" .= ("input_closed" :: Text), "reason" .= reason] ++ [ "ack" .= a | Just a <- [ack] ] + +-- | A call's input, once its subscription is known: each frame built and +-- sent on the connection that holds the call (spec/10: only that socket +-- may send it). The caller numbers the frames; a send that fails throws +-- as the connection's loss does. +data InputPort = InputPort + { ipItems :: Word64 -> [Value] -> IO () -- ^ @.input {subscription, seq, items}@ + , ipBinary :: Word64 -> BS.ByteString -> IO () -- ^ a binary frame of one item + , ipEnd :: Word64 -> IO () -- ^ @.end {subscription, seq}@ + } + +-- | What a call with an input half hands its route: where the port goes +-- when the subscription is known (before the call is said to be taken), +-- and where the callee's signals go as they come. +data InputHalf = InputHalf + { ihPort :: InputPort -> IO () + , ihSignal :: InputSignal -> IO () + } + +-- | The subscription id as the server gave it (a number stays a number). +subscriptionValue :: SubscriptionId -> Value +subscriptionValue (SubscriptionId raw) = case decodeStrict (TE.encodeUtf8 raw) of + Just n@(Number _) -> n + _ -> String raw + +-- | The subscription id as a binary frame carries it: an unsigned 64-bit +-- integer, or Nothing for an id that is not one. +subscriptionWord :: SubscriptionId -> Maybe Word64 +subscriptionWord sid = case subscriptionValue sid of + Number n -> toBoundedInteger n :: Maybe Word64 + _ -> Nothing + +-- | The namespace a call's frames are addressed to: @menger@ for a call +-- made as @menger.call@. +inputNamespace :: Text -> Text +inputNamespace method = maybe method id (T.stripSuffix ".call" method) + +-- | @{"jsonrpc":"2.0","method":".input","params":{"subscription":S,"seq":N,"items":[…]}}@ +inputFrame :: Text -> SubscriptionId -> Word64 -> [Value] -> LBS.ByteString +inputFrame ns sid sq items = encode $ object + [ "jsonrpc" .= ("2.0" :: Text), "method" .= (ns <> ".input") + , "params" .= object ["subscription" .= subscriptionValue sid, "seq" .= sq, "items" .= items] ] + +-- | @{"jsonrpc":"2.0","method":".end","params":{"subscription":S,"seq":FRAMES}}@ +endFrame :: Text -> SubscriptionId -> Word64 -> LBS.ByteString +endFrame ns sid sq = encode $ object + [ "jsonrpc" .= ("2.0" :: Text), "method" .= (ns <> ".end") + , "params" .= object ["subscription" .= subscriptionValue sid, "seq" .= sq] ] + +-- | BIDIR-17: @[0x01][subscription: u64 BE][seq: u64 BE]@ — the 17 bytes +-- before a binary frame's payload. +binaryHeader :: Word64 -> Word64 -> BS.ByteString +binaryHeader sub sq = LBS.toStrict $ B.toLazyByteString $ + B.word8 0x01 <> B.word64BE sub <> B.word64BE sq + +-- | A whole binary input frame. +binaryFrame :: Word64 -> Word64 -> BS.ByteString -> BS.ByteString +binaryFrame sub sq payload = binaryHeader sub sq <> payload + +-- | How a method's input items are written, from the item's schema. +data ItemKind + = ItemBytes -- ^ @"x-plexus-binary": true@ (@Input@): raw bytes, binary frames + | ItemString -- ^ a string: a line is an item + | ItemJson -- ^ anything else: one JSON value + deriving stock (Show, Eq) + +-- | The item schema's kind. A @$ref@ is followed into the schema's own +-- @$defs@ / @definitions@ once. +itemKind :: Value -> ItemKind +itemKind v = case v of + Object o + | KM.lookup "x-plexus-binary" o == Just (Bool True) -> ItemBytes + | KM.lookup "type" o == Just (String "string") -> ItemString + | Just (String ref) <- KM.lookup "$ref" o + , Just target <- deref o ref -> itemKind target + _ -> ItemJson + where + deref o ref = do + name <- T.stripPrefix "#/$defs/" ref <> T.stripPrefix "#/definitions/" ref + defs <- case (KM.lookup "$defs" o, KM.lookup "definitions" o) of + (Just (Object d), _) -> Just d + (_, Just (Object d)) -> Just d + _ -> Nothing + t <- KM.lookup (K.fromText name) defs + -- a $ref to another $ref is not followed again + case t of + Object to | KM.member "$ref" to -> Nothing + _ -> Just t + diff --git a/src/Plexus/RemoteError.hs b/src/Plexus/RemoteError.hs new file mode 100644 --- /dev/null +++ b/src/Plexus/RemoteError.hs @@ -0,0 +1,325 @@ +-- | The typed, exhaustive vocabulary of call failures (plexus 0.7). +-- +-- A call fails — as opposed to an activation saying no, which is an @err@ +-- item and therefore data — when the service could not or would not run it: no +-- such activation or method, bad params, no credentials, not allowed, or the +-- method itself blew up. The error frame carries exactly one 'RemoteError' +-- ('Plexus.Types.StreamError'), and so does the @data@ of a JSON-RPC-level +-- rejection ('Plexus.Types.errData'). +-- +-- Mirrors @plexus_client::RemoteError@ (RETURNS-4), which is canonical. +-- +-- = Wire shape +-- +-- @kind@-tagged, @snake_case@. 'ParamProblem' and 'DenyReason' are flattened +-- into their variant, under @problem@ and @reason@: +-- +-- @ +-- {"kind": "activation_not_found", "activation": "tickets"} +-- {"kind": "method_not_found", "activation": "tickets", "method": "frob"} +-- {"kind": "invalid_params", "param": "id", "problem": "missing"} +-- {"kind": "invalid_params", "param": "id", "problem": "malformed", "detail": "expected a string"} +-- {"kind": "unauthenticated"} +-- {"kind": "forbidden", "reason": "missing_scope", "scope": "tickets:write"} +-- {"kind": "forbidden", "reason": "tenant_boundary"} +-- {"kind": "forbidden", "reason": "missing_grant", "grant": "tickets.set_status", "scope": "IDENTITY", +-- "roles": ["editor", "admin"], "held_on": ["DOCS"]} +-- {"kind": "handle_not_supported", "activation": "tickets"} +-- {"kind": "execution", "message": "database is locked"} +-- {"kind": "too_many_calls", "max": 8} +-- {"kind": "child_unavailable", "child": "echo", "reason": "the connection has closed"} +-- {"kind": "child_timeout", "child": "echo", "timeout_ms": 5000} +-- @ +-- +-- @param@ is omitted when the failure is not about one parameter, and +-- decodes as 'Nothing' when absent or @null@. +-- +-- = Open, typed +-- +-- A @kind@ this library does not know is 'Other': its kind and every other +-- field kept, and written back exactly as they came (RETURNS-36, as +-- plexus-client's @RemoteError::Other@). A known kind that does not fit its +-- constructor — a @problem@ or @reason@ this library does not know, a field +-- missing — is still a decode error. +-- +-- The constructor names 'ActivationNotFound', 'MethodNotFound' and +-- 'InvalidParams' are also used by 'Plexus.Types.GuidanceErrorType', so +-- 'Plexus.Types' does not re-export them; import this module (or "Plexus"). +module Plexus.RemoteError + ( RemoteError(..) + , ParamProblem(..) + , DenyReason(..) + , renderRemoteError + , remoteErrorOfFields + ) where + +import Data.Aeson +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.Types (Pair, Parser) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) + +-- | Why a call failed — what an error frame carries, and the @data@ of a +-- JSON-RPC-level rejection. +data RemoteError + = ActivationNotFound Text + -- ^ The service has no activation by this name (@activation@). + | MethodNotFound Text Text + -- ^ The activation (@activation@) exists but has no method by this name + -- (@method@). + | InvalidParams (Maybe Text) ParamProblem + -- ^ The call's params did not fit the method: the parameter at fault + -- (@param@), when the failure is about one, and what is wrong with it. + | Unauthenticated + -- ^ The method requires credentials and the call carried none that + -- verified. + | Forbidden DenyReason + -- ^ The caller is authenticated but not allowed this call. + | HandleNotSupported Text + -- ^ The activation (@activation@) does not resolve handles. + | Execution Text + -- ^ The method ran and failed for a reason that is not the activation + -- saying no (that is an @err@ item): a panic, a lost dependency + -- (@message@). + | TooManyCalls Integer (Maybe Text) + -- ^ spec/05: too many calls open at once (@max@), on a child when the + -- limit is a child's (@child@, omitted otherwise). RETURNS-36. + | ChildUnavailable Text Text + -- ^ spec/12: the child the call was routed to (@child@) cannot be + -- reached (@reason@). RETURNS-36. + | ChildTimeout Text Integer + -- ^ spec/12: the child (@child@) did not open the call in the service's + -- time (@timeout_ms@). RETURNS-36. + | Other Text (KM.KeyMap Value) + -- ^ RETURNS-36 (the Rust side's review #4): a kind this library does not + -- know (@kind@; menger's @too_many_connections@, @too_many_writes@ with + -- @retry_after_ms@) and every other field, kept and written back exactly + -- as they came. Mirrors plexus-client's @RemoteError::Other@. + deriving stock (Show, Eq, Ord, Generic) + +-- | What is wrong with a call's params. Flattened into 'InvalidParams' under +-- the @problem@ key. +data ParamProblem + = Missing + -- ^ A required parameter was not supplied. + | Malformed Text + -- ^ A parameter was supplied but did not decode; the text (@detail@) + -- says how. + deriving stock (Show, Eq, Ord, Generic) + +-- | Why an authenticated caller was refused. Flattened into 'Forbidden' +-- under the @reason@ key. Each carries at most the single fact the caller +-- already failed. +data DenyReason + = MissingScope Text + -- ^ The caller's scopes do not include this one (@scope@) — the first + -- unmet one. + | TenantBoundary + -- ^ The call reaches across the caller's tenant boundary. + | NotAccepted + -- ^ The call was not accepted in the caller's action context. + | MissingGrant Text Text [Text] [Text] + -- ^ AUTH-2: the grant gate's refusal — the caller does not hold the + -- method's grant (@grant@, @.@) on the scope it was + -- needed on (@scope@, @*@ for a method without a target); the roles that + -- list it (@roles@, admin last) and where the caller does hold it + -- (@held_on@). Mirrors main's @AuthzDenyReason::MissingGrant@. + deriving stock (Show, Eq, Ord, Generic) + +-- ============================================================================ +-- JSON +-- ============================================================================ + +instance ToJSON RemoteError where + toJSON = object . remoteErrorPairs + +instance FromJSON RemoteError where + parseJSON = withObject "RemoteError" $ \o -> do + kind <- o .: "kind" :: Parser Text + case kind of + "activation_not_found" -> ActivationNotFound <$> o .: "activation" + "method_not_found" -> MethodNotFound <$> o .: "activation" <*> o .: "method" + "invalid_params" -> InvalidParams <$> o .:? "param" <*> parseParamProblem o + "unauthenticated" -> pure Unauthenticated + "forbidden" -> Forbidden <$> parseDenyReason o + "handle_not_supported" -> HandleNotSupported <$> o .: "activation" + "execution" -> Execution <$> o .: "message" + "too_many_calls" -> TooManyCalls <$> o .: "max" <*> o .:? "child" + "child_unavailable" -> ChildUnavailable <$> o .: "child" <*> o .: "reason" + "child_timeout" -> ChildTimeout <$> o .: "child" <*> o .: "timeout_ms" + other -> pure (Other other (KM.delete "kind" o)) + +-- | Standalone, a 'ParamProblem' is its flattened fields: +-- @{"problem": "missing"}@ or @{"problem": "malformed", "detail": …}@. +instance ToJSON ParamProblem where + toJSON = object . paramProblemPairs + +instance FromJSON ParamProblem where + parseJSON = withObject "ParamProblem" parseParamProblem + +-- | Standalone, a 'DenyReason' is its flattened fields: +-- @{"reason": "missing_scope", "scope": …}@, @{"reason": "tenant_boundary"}@. +instance ToJSON DenyReason where + toJSON = object . denyReasonPairs + +instance FromJSON DenyReason where + parseJSON = withObject "DenyReason" parseDenyReason + +kindPair :: Text -> Pair +kindPair k = "kind" .= k + +remoteErrorPairs :: RemoteError -> [Pair] +remoteErrorPairs = \case + ActivationNotFound a -> + [kindPair "activation_not_found", "activation" .= a] + MethodNotFound a m -> + [kindPair "method_not_found", "activation" .= a, "method" .= m] + InvalidParams mParam problem -> + kindPair "invalid_params" + : maybe [] (\p -> ["param" .= p]) mParam + <> paramProblemPairs problem + Unauthenticated -> + [kindPair "unauthenticated"] + Forbidden reason -> + kindPair "forbidden" : denyReasonPairs reason + HandleNotSupported a -> + [kindPair "handle_not_supported", "activation" .= a] + Execution msg -> + [kindPair "execution", "message" .= msg] + TooManyCalls mx child -> + kindPair "too_many_calls" : "max" .= mx : maybe [] (\c -> ["child" .= c]) child + ChildUnavailable child reason -> + [kindPair "child_unavailable", "child" .= child, "reason" .= reason] + ChildTimeout child ms -> + [kindPair "child_timeout", "child" .= child, "timeout_ms" .= ms] + Other kind fields -> + kindPair kind : KM.toList (KM.delete "kind" fields) + +paramProblemPairs :: ParamProblem -> [Pair] +paramProblemPairs = \case + Missing -> ["problem" .= ("missing" :: Text)] + Malformed detail -> ["problem" .= ("malformed" :: Text), "detail" .= detail] + +denyReasonPairs :: DenyReason -> [Pair] +denyReasonPairs = \case + MissingScope scope -> ["reason" .= ("missing_scope" :: Text), "scope" .= scope] + TenantBoundary -> ["reason" .= ("tenant_boundary" :: Text)] + NotAccepted -> ["reason" .= ("not_accepted" :: Text)] + MissingGrant g sc roles held -> + [ "reason" .= ("missing_grant" :: Text), "grant" .= g, "scope" .= sc + , "roles" .= roles, "held_on" .= held ] + +parseParamProblem :: Object -> Parser ParamProblem +parseParamProblem o = do + problem <- o .: "problem" :: Parser Text + case problem of + "missing" -> pure Missing + "malformed" -> Malformed <$> o .: "detail" + other -> fail $ "unknown ParamProblem: " <> T.unpack other + +parseDenyReason :: Object -> Parser DenyReason +parseDenyReason o = do + reason <- o .: "reason" :: Parser Text + case reason of + "missing_scope" -> MissingScope <$> o .: "scope" + "tenant_boundary" -> pure TenantBoundary + "not_accepted" -> pure NotAccepted + "missing_grant" -> MissingGrant <$> o .: "grant" <*> o .: "scope" + <*> o .:? "roles" .!= [] <*> o .:? "held_on" .!= [] + other -> fail $ "unknown DenyReason: " <> T.unpack other + +-- ============================================================================ +-- Rendering +-- ============================================================================ + +-- | One line, for a human — what a CLI prints. The same line as the Rust +-- @Display@ (and the @message@ of a JSON-RPC rejection); line breaks in +-- server-supplied text are folded to spaces so it stays one line. +renderRemoteError :: RemoteError -> Text +renderRemoteError = \case + ActivationNotFound a -> + "activation not found: " <> oneLine a + MethodNotFound a m -> + "method not found: " <> oneLine a <> "." <> oneLine m + InvalidParams mParam problem -> "invalid params: " <> case (problem, mParam) of + (Missing, Just p) -> "missing `" <> oneLine p <> "`" + (Missing, Nothing) -> "a required parameter is missing" + (Malformed d, Just p) -> "malformed `" <> oneLine p <> "`: " <> oneLine d + (Malformed d, Nothing) -> "malformed: " <> oneLine d + Unauthenticated -> + "unauthenticated: credentials required" + Forbidden reason -> "forbidden: " <> case reason of + MissingScope s -> "missing required scope `" <> oneLine s <> "`" + TenantBoundary -> "tenant boundary" + NotAccepted -> "call not accepted" + MissingGrant g "*" _ _ -> "needs `" <> oneLine g <> "`" + MissingGrant g sc _ _ -> "needs `" <> oneLine g <> "` on `" <> oneLine sc <> "`" + HandleNotSupported a -> + "handle resolution not supported by activation: " <> oneLine a + Execution msg -> + "execution failed: " <> oneLine msg + TooManyCalls mx child -> + "too many calls open" <> maybe "" (\c -> " on child " <> oneLine c) child + <> " (at most " <> T.pack (show mx) <> "): close one, or call again later" + ChildUnavailable child reason -> + "child " <> oneLine child <> " is unavailable: " <> oneLine reason + ChildTimeout child ms -> + "child " <> oneLine child <> " did not open the call in " <> T.pack (show ms) <> " ms" + Other kind fields -> + oneLine kind <> case KM.lookup "message" fields of + Just (String m) -> ": " <> oneLine m + _ -> "" + +oneLine :: Text -> Text +oneLine = T.map (\c -> if c == '\n' || c == '\r' then ' ' else c) + +-- ============================================================================ +-- A 0.7.0 frame's fields +-- ============================================================================ + +-- | RETURNS-36: the 'RemoteError' a frame of the published 0.7.0 line says +-- with spec/05's fields alone (no typed @error@): by @error_kind@ when there +-- is one, else by @code@; what neither names is the method failing +-- (@execution@, its @message@). The same reading as plexus-core's child +-- seam (@remote_child/peer.rs@, @remote_error_of@). +remoteErrorOfFields :: Object -> RemoteError +remoteErrorOfFields o = case maybe code id (str "error_kind") of + k | k `elem` ["invalid_params", "-32602"] -> InvalidParams Nothing (Malformed message) + | k `elem` ["unauthenticated", "-32001"] -> Unauthenticated + | k `elem` ["forbidden", "-32003"] -> Forbidden $ case str "reason" of + Just "missing_scope" -> MissingScope (txt "scope") + Just "tenant_boundary" -> TenantBoundary + Just "not_accepted" -> NotAccepted + _ -> MissingGrant (txt "grant") (txt "scope") (strings "roles") (strings "held_on") + "-32601" -> notFound + "too_many_calls" -> TooManyCalls (int "max") (str "child") + "child_unavailable" -> ChildUnavailable (txt "child") (txt "reason") + "child_timeout" -> ChildTimeout (txt "child") (int "timeout_ms") + -- a kind this library does not know, by its error_kind: that kind, its + -- fields kept (peer.rs: all but type, metadata, code and recoverable) + other | KM.member "error_kind" o -> + Other other (foldr KM.delete o ["error_kind", "type", "metadata", "code", "recoverable"]) + _ -> Execution message + where + str k = case KM.lookup k o of { Just (String t) -> Just t; _ -> Nothing } + txt k = maybe "" id (str k) + message = txt "message" + -- spec/05: -32601 is an activation or a method not found; its message + -- says which ("Activation not found: X", "Method not found: A.M") + notFound + | Just a <- T.stripPrefix "Activation not found: " message = ActivationNotFound (T.strip a) + | Just am <- T.stripPrefix "Method not found: " message + , (a, m) <- T.breakOnEnd "." (T.strip am) = MethodNotFound (T.dropEnd 1 a) m + -- (no dot: the method alone, no activation — as spec05.rs reads it) + | otherwise = MethodNotFound "" "" + code = case KM.lookup "code" o of + Just (String c) -> c + Just n@(Number _) | Success i <- fromJSON n -> T.pack (show (i :: Integer)) + _ -> "" + int k = case KM.lookup k o of + Just n@(Number _) | Success i <- fromJSON n -> i + _ -> 0 + strings k = case KM.lookup k o of + Just (Array a) -> [ t | String t <- foldr (:) [] a ] + _ -> [] diff --git a/src/Plexus/Schema.hs b/src/Plexus/Schema.hs --- a/src/Plexus/Schema.hs +++ b/src/Plexus/Schema.hs @@ -44,6 +44,7 @@ import qualified Data.Text as T import GHC.Generics (Generic) +import Plexus.RemoteError (renderRemoteError) import Plexus.Types (PlexusStreamItem(..)) import qualified Plexus.Schema.Recursive as RecursiveSchema @@ -530,7 +531,7 @@ Success schema -> Just (ActivationSchemaData schema) Error _ -> Nothing | otherwise = Nothing -extractActivationSchemaEvent (StreamError _ _ err _) = Just (ActivationSchemaError err) +extractActivationSchemaEvent (StreamError _ _ err _) = Just (ActivationSchemaError (renderRemoteError err)) extractActivationSchemaEvent _ = Nothing -- | Extract FullSchemaEvent from a stream item @@ -542,7 +543,7 @@ Success schema -> Just (FullSchemaData schema) Error _ -> Nothing | otherwise = Nothing -extractFullSchemaEvent (StreamError _ _ err _) = Just (FullSchemaError err) +extractFullSchemaEvent (StreamError _ _ err _) = Just (FullSchemaError (renderRemoteError err)) extractFullSchemaEvent _ = Nothing -- | Extract PlexusHashEvent from a stream item @@ -554,7 +555,7 @@ Success hash -> Just (HashData hash) Error _ -> Nothing | otherwise = Nothing -extractHashEvent (StreamError _ _ err _) = Just (HashError err) +extractHashEvent (StreamError _ _ err _) = Just (HashError (renderRemoteError err)) extractHashEvent _ = Nothing -- | Extract recursive plugin schema from stream item @@ -564,5 +565,5 @@ extractRecursiveSchema (StreamData _ _ contentType dat) | contentType == "plexus.schema" = Just $ RecursiveSchema.parsePluginSchema dat | otherwise = Nothing -extractRecursiveSchema (StreamError _ _ err _) = Just (Left err) +extractRecursiveSchema (StreamError _ _ err _) = Just (Left (renderRemoteError err)) extractRecursiveSchema _ = Nothing diff --git a/src/Plexus/Schema/Recursive.hs b/src/Plexus/Schema/Recursive.hs --- a/src/Plexus/Schema/Recursive.hs +++ b/src/Plexus/Schema/Recursive.hs @@ -33,6 +33,7 @@ , ChildSummary(..) , PluginHash , SchemaResult(..) + , Cardinality(..) -- * Deprecation Metadata (IR-5) , DeprecationInfo(..) @@ -64,7 +65,7 @@ import Control.Applicative ((<|>)) import Data.Aeson -import Data.Aeson.Types (Parser) +import Data.Aeson.Types (Pair, Parser) import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.Maybe (catMaybes, fromMaybe) @@ -208,15 +209,45 @@ , "hash" .= csHash ] --- | Schema for a single method +-- | Whether a method yields one item or many (plexus 0.7). +-- +-- Mirrors the Rust @plexus_core::Cardinality@; on the wire @"one"@ / +-- @"many"@. Read from the method's signature: a plain return type is one +-- item, @impl Stream@ is many. +data Cardinality + = CardinalityOne -- ^ The method yields exactly one item. + | CardinalityMany -- ^ The method yields a stream of zero or more items. + deriving stock (Show, Eq, Ord, Generic) + +instance FromJSON Cardinality where + parseJSON = withText "Cardinality" $ \case + "one" -> pure CardinalityOne + "many" -> pure CardinalityMany + other -> fail $ "unknown cardinality: " <> T.unpack other + +instance ToJSON Cardinality where + toJSON CardinalityOne = String "one" + toJSON CardinalityMany = String "many" + +-- | Schema for a single method (plexus 0.7) +-- +-- A method's contract is its item type @T@ ('methodReturns'), its error +-- type @E@ when it can say no ('methodError'), its progress type @P@ when +-- it reports progress ('methodProgress'), and its 'methodCardinality'. +-- @returns@ and @cardinality@ are required on the wire: a schema that does +-- not state them is not a 0.7 schema, and is a decode error rather than a +-- guess. data MethodSchema = MethodSchema { methodName :: Text , methodDescription :: Text , methodHash :: PluginHash , methodParams :: Maybe Value -- ^ JSON Schema for params - , methodReturns :: Maybe Value -- ^ JSON Schema for return events - , methodStreaming :: Bool -- ^ True if method streams multiple events + , methodReturns :: Value -- ^ JSON Schema for the item type @T@ — what one success carries (for @Result@ or @Progress@, @T@ alone) + , methodError :: Maybe Value -- ^ JSON Schema for the error type @E@ (@-> Result@); 'Nothing' when the method is infallible + , methodProgress :: Maybe Value -- ^ JSON Schema for the progress type @P@ carried by progress frames; 'Nothing' when the method reports no progress + , methodCardinality :: Cardinality -- ^ One item or many , methodBidirectional :: Bool -- ^ True if method uses a bidirectional channel + , methodHttpMethod :: Text -- ^ HTTP method of the method's REST endpoint (@"GET"@, @"POST"@, …); @"POST"@ when absent , methodRequestType :: Maybe Value -- ^ JSON Schema for the server→client request type (when bidirectional) , methodResponseType :: Maybe Value -- ^ JSON Schema for the client→server response type (when bidirectional) , methodDeprecation :: Maybe DeprecationInfo -- ^ Deprecation info, if any (IR-5) @@ -240,9 +271,12 @@ <*> o .:? "description" .!= "" <*> o .:? "hash" .!= "" <*> o .:? "params" - <*> o .:? "returns" - <*> o .:? "streaming" .!= False + <*> returnsOf o + <*> o .:? "error" + <*> o .:? "progress" + <*> cardinalityOf o <*> o .:? "bidirectional" .!= False + <*> o .:? "http_method" .!= "POST" <*> o .:? "request_type" <*> o .:? "response_type" <*> o .:? "deprecation" @@ -258,29 +292,54 @@ <*> (o .:? "examples" .!= [] <|> pure []) <*> o .:? "input" +-- | RETURNS-36: a method's cardinality — its @cardinality@ (plexus 0.8); +-- else, a method of the published 0.7.0 line, its own @streaming@ flag +-- (@true@ many, @false@ one), as plexus-core's child seam reads it; a +-- method that states neither is refused. +cardinalityOf :: Object -> Parser Cardinality +cardinalityOf o = case KM.lookup "cardinality" o of + Just c -> parseJSON c + Nothing -> case KM.lookup "streaming" o of + Just (Bool True) -> pure CardinalityMany + Just (Bool False) -> pure CardinalityOne + _ -> fail "a method states neither cardinality (plexus 0.8) nor streaming (0.7.0)" + +-- | RETURNS-36: a method's @returns@ — required of a 0.8 method (one that +-- states its cardinality); a 0.7.0 method's missing one is the empty +-- schema, @{}@. +returnsOf :: Object -> Parser Value +returnsOf o + | KM.member "cardinality" o = o .: "returns" + | otherwise = o .:? "returns" .!= Object KM.empty + +-- | Encodes as the Rust @MethodSchema@ serializes: an absent optional field +-- is omitted, not @null@. instance ToJSON MethodSchema where toJSON MethodSchema{..} = object $ [ "name" .= methodName , "description" .= methodDescription , "hash" .= methodHash - , "params" .= methodParams , "returns" .= methodReturns - , "streaming" .= methodStreaming + , "cardinality" .= methodCardinality , "bidirectional" .= methodBidirectional - , "request_type" .= methodRequestType - , "response_type" .= methodResponseType - , "deprecation" .= methodDeprecation - , "param_schemas" .= methodParamSchemas + , "http_method" .= methodHttpMethod , "role" .= methodRole ] <> catMaybes - [ ("long_description" .=) <$> methodLongDescription - , ("grant" .=) <$> methodGrant - , ("target" .=) <$> methodTarget - , ("held_on" .=) <$> methodHeldOn + [ "params" .=? methodParams + , "error" .=? methodError + , "progress" .=? methodProgress + , "request_type" .=? methodRequestType + , "response_type" .=? methodResponseType + , "deprecation" .=? methodDeprecation + , "param_schemas" .=? methodParamSchemas + , "long_description" .=? methodLongDescription + , "grant" .=? methodGrant + , "target" .=? methodTarget + , "held_on" .=? methodHeldOn , if methodPublic then Just ("public" .= True) else Nothing - , ("group" .=) <$> methodGroup + , "group" .=? methodGroup , if null methodExamples then Nothing else Just ("examples" .= methodExamples) - , ("input" .=) <$> methodInput + , "input" .=? methodInput ] -- | SYNAPSE-13: one worked call of a method — the params it sends and a @@ -322,10 +381,14 @@ , psVersion :: Text , psDescription :: Text , psLongDescription :: Maybe Text -- ^ Extended description (no word limit) + , psSelfHash :: Maybe PluginHash -- ^ Hash of this plugin's own methods, children aside (@self_hash@) , psHash :: PluginHash , psMethods :: [MethodSchema] , psChildren :: Maybe [ChildSummary] -- ^ Nothing = leaf, Just = parent activation , psDeprecation :: Maybe DeprecationInfo -- ^ Activation-level deprecation (IR-5) + , psRequest :: Maybe Value -- ^ JSON Schema of the activation's request type (@request@): each + -- property carries @x-plexus-source@ (cookie, header, query, peer); + -- Nothing when the activation declares none (CONTEXT-5) , psRoles :: Maybe (Map Text [Text]) -- ^ AUTH-3: the activation's default roles, each its grants , psView :: Maybe View -- ^ AUTH-4: which view this schema answers from } @@ -338,27 +401,38 @@ <*> o .:? "version" .!= "" <*> o .:? "description" .!= "" <*> o .:? "long_description" + <*> o .:? "self_hash" <*> o .:? "hash" .!= "" <*> o .:? "methods" .!= [] <*> o .:? "children" <*> o .:? "deprecation" + <*> o .:? "request" <*> (o .:? "roles" <|> pure Nothing) <*> (o .:? "view" <|> pure Nothing) +-- | Encodes as the Rust @PluginSchema@ serializes: an absent optional field +-- is omitted, not @null@. instance ToJSON PluginSchema where toJSON PluginSchema{..} = object $ [ "namespace" .= psNamespace , "version" .= psVersion , "description" .= psDescription - , "long_description" .= psLongDescription , "hash" .= psHash , "methods" .= psMethods - , "children" .= psChildren - , "deprecation" .= psDeprecation ] <> catMaybes - [ ("roles" .=) <$> psRoles - , ("view" .=) <$> psView + [ "long_description" .=? psLongDescription + , "self_hash" .=? psSelfHash + , "children" .=? psChildren + , "deprecation" .=? psDeprecation + , "request" .=? psRequest + , "roles" .=? psRoles + , "view" .=? psView ] + +-- | A key whose value is omitted when 'Nothing'. +(.=?) :: ToJSON v => Key -> Maybe v -> Maybe Pair +k .=? v = (k .=) <$> v +infixr 8 .=? -- | Result of a schema query - can be either a full plugin or just a method data SchemaResult diff --git a/src/Plexus/Transport.hs b/src/Plexus/Transport.hs --- a/src/Plexus/Transport.hs +++ b/src/Plexus/Transport.hs @@ -11,6 +11,7 @@ , rpcCallStreaming , invokeMethodStreaming , invokeMethodStreamingWith + , invokeMethodDuplex -- * Bidirectional Response , sendBidirectionalResponse @@ -28,6 +29,8 @@ -- * Routing a call elsewhere (SYNAPSE-28) , CallRoute , setCallRouter + , DuplexRoute + , setDuplexRouter ) where import Control.Exception (SomeException, IOException, catch, fromException) @@ -43,8 +46,10 @@ import qualified Network.Socket as NS import System.IO.Unsafe (unsafePerformIO) -import Plexus.Client (SubstrateConfig(..), LostConnection(..), connect, disconnect, substrateRpc, substrateRpcWith, defaultConfig) +import Plexus.Client (SubstrateConfig(..), LostConnection(..), connect, disconnect, substrateRpc, substrateRpcDuplex, defaultConfig) +import Plexus.Input (InputHalf) import Plexus.Client.Pool (ConnectionPool, createConnectionPool, withPooledConnection, defaultPlexusPoolConfig) +import Plexus.RemoteError (renderRemoteError) import Plexus.Types (PlexusStreamItem(..), TransportError(..), Response(..), StandardResponse) import Plexus.Schema.Recursive (PluginSchema, MethodSchema, SchemaResult(..), parsePluginSchema, parseSchemaResult) @@ -71,16 +76,31 @@ -- call), so everything above it reads its failures as before. type CallRoute = IO () -> Text -> Value -> (PlexusStreamItem -> IO ()) -> IO () +-- | BIDIR-18: a route that can also carry a call's input half +-- (plexus-wire spec/10): given 'Just' a half, it hands the half the call's +-- 'Plexus.Input.InputPort' once the subscription is known and its signals +-- as they come; given 'Nothing', it is a 'CallRoute'. +type DuplexRoute = Maybe InputHalf -> CallRoute + {-# NOINLINE routerRef #-} -routerRef :: IORef (SubstrateConfig -> Maybe CallRoute) +routerRef :: IORef (SubstrateConfig -> Maybe DuplexRoute) routerRef = unsafePerformIO (newIORef (const Nothing)) -- | SYNAPSE-28: route the calls whose config the router answers 'Just' -- for; the rest go through this process's pools, as before. Set once, at --- start (a program that never sets it is unchanged). +-- start (a program that never sets it is unchanged). A route set here +-- cannot carry an input half: a call with one fails on it, naming why +-- ('setDuplexRouter' sets one that can). setCallRouter :: (SubstrateConfig -> Maybe CallRoute) -> IO () -setCallRouter = writeIORef routerRef +setCallRouter f = writeIORef routerRef (fmap plainOnly . f) + where + plainOnly r Nothing = r + plainOnly _ (Just _) = \_ _ _ _ -> E.throwIO (userError "this call route cannot carry a call's input half") +-- | BIDIR-18: 'setCallRouter' with routes that carry an input half too. +setDuplexRouter :: (SubstrateConfig -> Maybe DuplexRoute) -> IO () +setDuplexRouter = writeIORef routerRef + -- | Low-level RPC call with default localhost config rpcCall :: Text -> Text -> Value -> IO (Either TransportError [PlexusStreamItem]) rpcCall backend = rpcCallWith (defaultConfig backend) @@ -135,7 +155,7 @@ case router cfg of Just route -> do acc <- newIORef [] - route (pure ()) method params (\i -> modifyIORef' acc (i :)) + route Nothing (pure ()) method params (\i -> modifyIORef' acc (i :)) reverse <$> readIORef acc Nothing -> freshIfUnsent $ do pool <- getOrCreatePool cfg @@ -161,14 +181,17 @@ doCallStreaming cfg = doCallStreamingWith cfg (pure ()) doCallStreamingWith :: SubstrateConfig -> IO () -> Text -> Value -> (PlexusStreamItem -> IO ()) -> IO () -doCallStreamingWith cfg onSubscribed method params onItem = do +doCallStreamingWith cfg = doCallDuplex cfg Nothing + +doCallDuplex :: SubstrateConfig -> Maybe InputHalf -> IO () -> Text -> Value -> (PlexusStreamItem -> IO ()) -> IO () +doCallDuplex cfg half onSubscribed method params onItem = do router <- readIORef routerRef case router cfg of - Just route -> route onSubscribed method params onItem + Just route -> route half onSubscribed method params onItem Nothing -> freshIfUnsent $ do pool <- getOrCreatePool cfg withPooledConnection pool $ \conn -> - S.mapM_ onItem $ substrateRpcWith conn onSubscribed method params + S.mapM_ onItem $ substrateRpcDuplex conn half (const onSubscribed) method params -- | Streaming method invocation invokeMethodStreaming :: SubstrateConfig -> [Text] -> Text -> Value -> (PlexusStreamItem -> IO ()) -> IO (Either TransportError ()) @@ -185,6 +208,20 @@ (Right <$> doCallStreamingWith cfg onSubscribed (backend <> ".call") callParams onItem) `catch` categorizeException cfg +-- | BIDIR-18: 'invokeMethodStreamingWith' for a method with an input half: +-- the half is handed its port once the server has taken the call (before +-- @onSubscribed@) and the callee's credit, acks and close as they come. +-- Nothing here sends the call twice: a call whose request went out and +-- whose connection went is 'ConnectionLost' with @sent@. +invokeMethodDuplex :: SubstrateConfig -> InputHalf -> IO () -> [Text] -> Text -> Value -> (PlexusStreamItem -> IO ()) -> IO (Either TransportError ()) +invokeMethodDuplex cfg half onSubscribed namespacePath method params onItem = do + let backend = substrateBackend cfg + let fullPath = if null namespacePath then [backend] else namespacePath + let dotPath = T.intercalate "." (fullPath ++ [method]) + let callParams = object ["method" .= dotPath, "params" .= params] + (Right <$> doCallDuplex cfg (Just half) onSubscribed (backend <> ".call") callParams onItem) + `catch` categorizeException cfg + -- | Fetch schema at a specific path -- Empty path = root (.schema) -- Non-empty path = child schema (e.g., ["solar", "earth"] -> solar.earth.schema) @@ -207,7 +244,7 @@ extractSchema items = case [dat | StreamData _ _ ct dat <- items, ".schema" `T.isSuffixOf` ct] of (dat:_) -> parsePluginSchema dat - [] -> case [err | StreamError _ _ err _ <- items] of + [] -> case [renderRemoteError err | StreamError _ _ err _ <- items] of (err:_) -> Left err [] -> Left "No schema in response" @@ -235,7 +272,7 @@ extractSchemaResult items = case [dat | StreamData _ _ ct dat <- items, ".schema" `T.isSuffixOf` ct] of (dat:_) -> parseSchemaResult dat - [] -> case [err | StreamError _ _ err _ <- items] of + [] -> case [renderRemoteError err | StreamError _ _ err _ <- items] of (err:_) -> Left err [] -> Left "No schema in response" @@ -267,6 +304,6 @@ result <- rpcCallWith cfg (backend <> ".respond") respondParams case result of Left transportErr -> pure $ Left transportErr - Right items -> case [err | StreamError _ _ err _ <- items] of + Right items -> case [renderRemoteError err | StreamError _ _ err _ <- items] of (err:_) -> pure $ Left $ ProtocolError err [] -> pure $ Right () diff --git a/src/Plexus/Types.hs b/src/Plexus/Types.hs --- a/src/Plexus/Types.hs +++ b/src/Plexus/Types.hs @@ -14,6 +14,7 @@ -- * Plexus Stream Types , PlexusStreamItem(.., StreamError) , itemRefusal + , itemErrorMessage , Refusal(..) , Provenance(..) , StreamMetadata(..) @@ -36,7 +37,6 @@ , getPlexusHash ) where -import Control.Applicative ((<|>)) import Data.Aeson import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (Parser) @@ -48,6 +48,10 @@ import GHC.Generics (Generic) import Plexus.Auth (Refusal(..), refusalFromObject) +-- Only the types: RemoteError's constructors share names with +-- 'GuidanceErrorType''s. +import qualified Plexus.RemoteError as RE +import Plexus.RemoteError (RemoteError) -- | Request ID for JSON-RPC calls newtype RequestId = RequestId { unRequestId :: Int } @@ -105,10 +109,26 @@ _ -> fail "Expected either 'result' or 'error' field" -- | JSON-RPC error object +-- +-- A Plexus rejection (plexus 0.7) keeps JSON-RPC's @code@ and @message@ +-- (the 'RemoteError''s one-line rendering) and carries the typed +-- 'RemoteError' in @data@: +-- +-- @ +-- {"code": -32601, "message": "method not found: tickets.frob", +-- "data": {"kind": "method_not_found", "activation": "tickets", "method": "frob"}} +-- @ +-- +-- 'errData' is 'Nothing' for a rejection that is not a Plexus call failure +-- and so carries no 'RemoteError': no @data@ (jsonrpsee's own +-- @"Method not found"@, a service's @{ns}.schema@ / @{ns}.respond@ refusals), or +-- a @data@ that is not a @kind@-tagged object (jsonrpsee's param-parse +-- rejection carries a string). A @kind@-tagged @data@ is decoded strictly: a +-- kind this library does not know is a decode error, as for an error frame. data RpcError = RpcErrorObj { errCode :: Int , errMessage :: Text - , errData :: Maybe Value + , errData :: Maybe RemoteError } deriving stock (Show, Eq, Generic) @@ -116,8 +136,18 @@ parseJSON = withObject "RpcError" $ \o -> RpcErrorObj <$> o .: "code" <*> o .: "message" - <*> o .:? "data" + <*> (o .:? "data" >>= traverse parseJSON . (>>= remoteErrorShaped)) + where + remoteErrorShaped :: Value -> Maybe Value + remoteErrorShaped v@(Object d) | KM.member "kind" d = Just v + remoteErrorShaped _ = Nothing +instance ToJSON RpcError where + toJSON RpcErrorObj{..} = object $ + [ "code" .= errCode + , "message" .= errMessage + ] <> catMaybes [("data" .=) <$> errData] + -- | Subscription notification from server -- This is what we receive for each stream item data SubscriptionNotification = SubscriptionNotification @@ -465,12 +495,25 @@ -- -- New format uses metadata wrapper: -- @{"type":"data","metadata":{...},"content_type":"...","content":{...}}@ +-- +-- plexus 0.7 frames: +-- +-- @ +-- {"type":"progress","metadata":{...},"content_type":"ns.method","content":

} +-- {"type":"error","metadata":{...},"recoverable":false,"error":} +-- @ +-- +-- A progress frame carries the method's declared progress type @P@ (the +-- schema's 'Plexus.Schema.Recursive.methodProgress'; for the default @Note@, +-- @{"message": …, "percentage": …}@). An error frame means the call itself +-- failed; an activation saying no is a 'StreamData' item whose content is +-- @{"err": …}@. data PlexusStreamItem = StreamProgress { itemPlexusHash :: Text , itemProvenance :: Provenance - , itemMessage :: Text - , itemPercentage :: Maybe Double + , itemContentType :: Text -- ^ The call's method, as on its data items (e.g. @"tickets.import"@) + , itemContent :: Value -- ^ The method's progress value @P@ } | StreamData { itemPlexusHash :: Text @@ -489,11 +532,18 @@ | StreamErrorWith { itemPlexusHash :: Text , itemProvenance :: Provenance - , itemError :: Text - , itemRecoverable :: Bool + , itemError :: RemoteError -- ^ Why the call failed, typed + , itemRecoverable :: Bool -- ^ Whether the operation can be retried , itemErrorRefusal :: Maybe Refusal - -- ^ AUTH-2: @error_kind: "forbidden"@ and what it names; Nothing - -- for every other error (and on every service without a gate) + -- ^ AUTH-2: the refusal's own fields (@error_kind: "forbidden"@, + -- @grant@, @scope@, @roles@, @held_on@) when the service sends them + -- beside the typed error; Nothing otherwise. 'itemRefusal' also + -- reads a refusal out of a typed @Forbidden (MissingGrant …)@. + , itemErrorBeside :: KM.KeyMap Value + -- ^ RETURNS-36: every other key the frame carried beside the typed + -- error (a merged service's @message@, @code@, @error_kind@ and + -- the refusal's fields), kept as sent and written back so; empty + -- for a frame built here. } | StreamRequest { itemPlexusHash :: Text @@ -508,21 +558,23 @@ } deriving stock (Show, Eq, Generic) --- | An error item as it was before AUTH-2: hash, provenance, message, --- recoverable. Matches every error (a refusal too); builds one with no --- refusal. 'StreamErrorWith' carries the typed refusal. -pattern StreamError :: Text -> Provenance -> Text -> Bool -> PlexusStreamItem -pattern StreamError hash prov err rec <- StreamErrorWith hash prov err rec _ - where StreamError hash prov err rec = StreamErrorWith hash prov err rec Nothing +-- | An error item: hash, provenance, the typed 'RemoteError', recoverable. +-- Matches every error (a refusal too); builds one with no refusal fields. +-- 'StreamErrorWith' carries AUTH-2's refusal fields when a service sends them. +pattern StreamError :: Text -> Provenance -> RemoteError -> Bool -> PlexusStreamItem +pattern StreamError hash prov err rec <- StreamErrorWith hash prov err rec _ _ + where StreamError hash prov err rec = StreamErrorWith hash prov err rec Nothing KM.empty {-# COMPLETE StreamProgress, StreamData, StreamGuidance, StreamError, StreamRequest, StreamDone #-} -- | AUTH-2: the refusal an item carries — an error item with --- @error_kind: "forbidden"@, or a data item whose content is one (an --- in-band error event naming the same fields). +-- @error_kind: "forbidden"@ (or whose typed error is a +-- @Forbidden (MissingGrant …)@, plexus 0.8), or a data item whose content is +-- one (an in-band error event naming the same fields). itemRefusal :: PlexusStreamItem -> Maybe Refusal itemRefusal = \case - StreamErrorWith _ _ _ _ r -> r + StreamErrorWith _ _ _ _ (Just r) _ -> Just r + StreamErrorWith _ _ err _ Nothing _ -> refusalOfRemote err StreamData _ _ _ (Object o) -> refusalFromObject o _ -> Nothing @@ -543,8 +595,8 @@ prov = metaProvenance meta case typ of "progress" -> StreamProgress hash prov - <$> o .: "message" - <*> o .:? "percentage" + <$> o .:? "content_type" .!= "" + <*> progressContent o "data" -> StreamData hash prov <$> o .: "content_type" <*> o .: "content" @@ -554,9 +606,10 @@ <*> o .:? "available_methods" <*> o .:? "method_schema" "error" -> StreamErrorWith hash prov - <$> o .: "message" - <*> o .:? "recoverable" .!= False + <$> typedError o + <*> o .: "recoverable" <*> pure (refusalFromObject o) + <*> pure (besideError o) "request" -> StreamRequest hash prov <$> o .: "request_id" <*> o .: "request" @@ -573,8 +626,8 @@ case typ of "progress" -> StreamProgress hash <$> o .: "provenance" - <*> o .: "message" - <*> o .:? "percentage" + <*> o .: "content_type" + <*> o .: "content" "data" -> StreamData hash <$> o .: "provenance" <*> o .: "content_type" @@ -587,9 +640,10 @@ <*> o .:? "method_schema" "error" -> StreamErrorWith hash <$> o .:? "provenance" .!= Provenance [] - <*> (o .: "error" <|> o .: "message") + <*> typedError o <*> o .:? "recoverable" .!= False <*> pure (refusalFromObject o) + <*> pure (besideError o) "request" -> StreamRequest hash <$> o .: "provenance" <*> o .: "request_id" @@ -600,11 +654,11 @@ _ -> fail $ "Unknown event type: " <> T.unpack typ instance ToJSON PlexusStreamItem where - toJSON (StreamProgress hash prov msg pct) = object + toJSON (StreamProgress hash prov ct content) = object [ "type" .= ("progress" :: Text) , "metadata" .= StreamMetadata prov hash 0 - , "message" .= msg - , "percentage" .= pct + , "content_type" .= ct + , "content" .= content ] toJSON (StreamData hash prov ct dat) = object [ "type" .= ("data" :: Text) @@ -621,14 +675,15 @@ [ ("available_methods" .=) <$> availMethods , ("method_schema" .=) <$> methodSchema ] - toJSON (StreamErrorWith hash prov err rec refusal) = object $ + toJSON (StreamErrorWith hash prov err rec refusal beside) = object $ [ "type" .= ("error" :: Text) , "metadata" .= StreamMetadata prov hash 0 - , "message" .= err , "recoverable" .= rec - ] <> refusalFields + , "error" .= err + ] <> (if KM.member "message" beside then [] else ["message" .= RE.renderRemoteError err]) + <> if KM.null beside then refusalFields else KM.toList beside where - -- the refusal's own fields, beside the message (as the service sent them) + -- a frame built here with a refusal: its own fields, beside the typed error refusalFields = case toJSON <$> refusal of Just (Object ro) -> [ (k, v) | (k, v) <- KM.toList ro, k /= "message" ] _ -> [] @@ -644,6 +699,50 @@ [ "type" .= ("done" :: Text) , "metadata" .= StreamMetadata prov hash 0 ] + +-- | RETURNS-36 review: the server's own line for an error frame — its +-- @message@, as plexus-core writes it on every error frame (and the 0.7.0 +-- line did) — when the frame came with one; 'Nothing' for a frame built +-- here or sent without it. A caller shows it, and reads it, as main did. +itemErrorMessage :: PlexusStreamItem -> Maybe Text +itemErrorMessage = \case + StreamErrorWith _ _ _ _ _ beside | Just (String m) <- KM.lookup "message" beside -> Just m + _ -> Nothing + +-- | An error frame's typed error: its @error@ (plexus 0.8), else — a frame +-- of the published 0.7.0 line — what its spec/05 fields say +-- ('RE.remoteErrorOfFields'; RETURNS-36). +typedError :: Object -> Parser RemoteError +typedError o = case KM.lookup "error" o of + Just v -> parseJSON v + Nothing -> pure (RE.remoteErrorOfFields o) + +-- | A progress frame's content: its @content@ (plexus 0.8), else — a 0.7.0 +-- frame — its @message@ and @percentage@ as the default progress type, +-- @Note@ (RETURNS-36, as plexus-core's child seam reads it). +progressContent :: Object -> Parser Value +progressContent o = case KM.lookup "content" o of + Just v -> pure v + Nothing -> pure $ Object $ KM.fromList $ + ("message", maybe (String "") id (KM.lookup "message" o)) + : [ ("percentage", p) | Just p <- [KM.lookup "percentage" o], p /= Null ] -- a null one left out, as spec05.rs + +-- | An error frame's keys beside the envelope and the typed error. +besideError :: Object -> KM.KeyMap Value +besideError = KM.filterWithKey (\k _ -> k `notElem` ["type", "metadata", "provenance", "plexus_hash", "recoverable", "error"]) + +-- | The AUTH-2 refusal a typed @Forbidden (MissingGrant …)@ names. +refusalOfRemote :: RemoteError -> Maybe Refusal +refusalOfRemote = \case + RE.Forbidden (RE.MissingGrant g sc roles held) -> Just Refusal + { refusalGrant = Just g + , refusalScope = Just sc + , refusalRoles = roles + , refusalHeldOn = held + , refusalCeiling = [] + , refusalMessage = if sc == "*" then "needs " <> g else "needs " <> g <> " on " <> sc + } + _ -> Nothing -- | Create a subscription request mkSubscribeRequest :: RequestId -> Text -> Value -> RpcRequest diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,723 @@ +-- | plexus-protocol 0.6 against plexus 0.7. +-- +-- The golden half reads RETURNS-7's conformance fixture by sibling path +-- (@../plexus-macros/fixtures/conformance/expected/@) and checks that every +-- schema, wire frame and error frame there parses into the Haskell types and +-- re-encodes to the same JSON (compared as parsed values, so key order does +-- not count; frame @timestamp@ normalized to 0 — the fixture README's +-- comparison rules). Its hashes are real since RETURNS-10: every frame's +-- @plexus_hash@ is the schema's @hash@. +-- +-- The rest pins the shapes the fixture does not exercise: every +-- 'RemoteError' variant against RETURNS-4's wire literals +-- (@plexus-client/tests/remote_error_wire_tests.rs@), the JSON-RPC +-- rejection's @data@, and the decode errors that replace 0.6's silent +-- defaults. +module Main (main) where + +import Control.Monad (forM_, unless) +import Data.Aeson +import Data.Aeson.Types (parseEither) +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KM +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Lazy as LBS +import Data.Foldable (toList) +import Data.List (isInfixOf, sort) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T +import System.Directory (doesDirectoryExist, listDirectory) +import System.FilePath (takeExtension, ()) +import Test.Hspec + +import Plexus.Auth (Refusal (..), View (..)) +import Plexus.RemoteError +import Plexus.Schema.Recursive +import Plexus.Types hiding (GuidanceErrorType (..)) + +-- ============================================================================ +-- The fixture +-- ============================================================================ + +fixtureDir :: FilePath +fixtureDir = ".." "plexus-macros" "fixtures" "conformance" "expected" + +readJson :: FilePath -> IO Value +readJson path = do + bytes <- LBS.readFile path + either (fail . ((path <> ": ") <>)) pure (eitherDecode bytes) + +-- | One JSON value per non-empty line. +readJsonl :: FilePath -> IO [Value] +readJsonl path = do + bytes <- BS.readFile path + let ls = filter (not . BS.null) (BS8.lines bytes) + sequence + [ either (\e -> fail (path <> ":" <> show n <> ": " <> e)) pure (eitherDecodeStrict l) + | (n, l) <- zip [1 :: Int ..] ls + ] + +-- | The wire files @calls.json@ names, and the @errors.jsonl@ lines it names. +data Calls = Calls + { callWireFiles :: Set.Set FilePath + , callErrorLines :: [Int] + } + +readCalls :: IO Calls +readCalls = do + v <- readJson (fixtureDir "calls.json") + calls <- either fail pure $ parseEither (withArray "calls" (mapM callFrames . toList)) v + pure Calls + { callWireFiles = Set.fromList [f | (f, Nothing) <- calls] + , callErrorLines = sort [n | ("errors.jsonl", Just n) <- calls] + } + where + callFrames = withObject "call" $ \o -> (,) <$> o .: "frames" <*> o .:? "line" + +-- ============================================================================ +-- Comparing (the fixture README's rules) +-- ============================================================================ + +-- | A frame's @metadata.timestamp@, set to 0. +normalizeFrame :: Value -> Value +normalizeFrame (Object o) = Object $ case KM.lookup "metadata" o of + Just m -> KM.insert "metadata" (zeroTimestamp m) o + Nothing -> o + where + zeroTimestamp (Object m) | KM.member "timestamp" m = Object (KM.insert "timestamp" (Number 0) m) + zeroTimestamp m = m +normalizeFrame v = v + +-- | @expected `matches` actual@: equal as parsed JSON. +matches :: Value -> Value -> Bool +matches (Object e) (Object a) = + sort (KM.keys e) == sort (KM.keys a) + && and [sub ve (KM.lookup k a) | (k, ve) <- KM.toList e] + where + sub ve (Just va) = matches ve va + sub _ Nothing = False +matches (Array e) (Array a) = length e == length a && and (zipWith matches (toList e) (toList a)) +matches e a = e == a + +-- | Parse @v@ as an @a@, re-encode it, and require the result to match @v@. +roundTrips :: forall a. (FromJSON a, ToJSON a) => (Value -> Value) -> Value -> IO a +roundTrips norm v = case parseEither parseJSON v of + Left err -> expectationFailure ("does not parse: " <> err <> "\n " <> encodeStr v) >> fail "unreachable" + Right (x :: a) -> do + let back = toJSON x + unless (norm v `matches` norm back) $ + expectationFailure $ "re-encodes differently\n expected: " <> encodeStr v <> "\n actual: " <> encodeStr back + pure x + +encodeStr :: Value -> String +encodeStr = BS8.unpack . LBS.toStrict . encode + +decodes :: FromJSON a => Value -> Either String a +decodes = parseEither parseJSON + +field :: Text -> Value -> Maybe Value +field k (Object o) = KM.lookup (Key.fromText k) o +field _ _ = Nothing + +title :: Value -> Maybe Value +title = field "title" + +-- | 16 lowercase hex characters: every Plexus hash's form (RETURNS-10). +isHash16 :: Text -> Bool +isHash16 h = T.length h == 16 && T.all (`elem` ("0123456789abcdef" :: String)) h + +-- | The fixture activation's hash, as @schema.json@ pins it. +fixtureHash :: IO Text +fixtureHash = do + v <- readJson (fixtureDir "schema.json") + either fail (pure . psHash) (decodes @PluginSchema v) + +-- ============================================================================ +-- Tests +-- ============================================================================ + +main :: IO () +main = do + present <- doesDirectoryExist fixtureDir + unless present $ + fail $ "conformance fixture not found at " <> fixtureDir + <> " (plexus-macros on returns/0.7 must be this repository's sibling)" + hspec spec + +spec :: Spec +spec = do + schemaSpec + wireSpec + errorsSpec + remoteErrorSpec + rejectionSpec + strictnessSpec + mergedSpec + +schemaSpec :: Spec +schemaSpec = describe "expected/schema.json" $ do + let load = readJson (fixtureDir "schema.json") + + it "parses as a PluginSchema and re-encodes to the same JSON" $ do + v <- load + schema <- roundTrips @PluginSchema id v + psNamespace schema `shouldBe` "conformance" + psVersion schema `shouldBe` "0.7.0" + fmap isHash16 (psSelfHash schema) `shouldBe` Just True + isHash16 (psHash schema) `shouldBe` True + forM_ (psMethods schema) $ \m -> (methodName m, isHash16 (methodHash m)) `shouldBe` (methodName m, True) + psChildren schema `shouldBe` Nothing + map methodName (psMethods schema) `shouldBe` ["ping", "lookup", "count", "scan", "load", "warm", "schema"] + + it "carries an activation's request schema as psRequest (CONTEXT-5) and omits it when absent" $ do + v <- load + plain <- either fail pure (decodes @PluginSchema v) + psRequest plain `shouldBe` Nothing + let req = object + [ "type" .= ("object" :: Text) + , "properties" .= object + [ "auth_token" .= object [ "type" .= ("string" :: Text), "x-plexus-source" .= object [ "from" .= ("cookie" :: Text), "name" .= ("access_token" :: Text) ] ] ] + ] + withReq = case v of + Object o -> Object (KM.insert "request" req o) + other -> other + schema <- roundTrips @PluginSchema id withReq + psRequest schema `shouldBe` Just req + toJSON plain `shouldBe` v + + it "parses as a SchemaResult (a plugin) and re-encodes to the same JSON" $ do + v <- load + result <- roundTrips @SchemaResult id v + case result of + SchemaPlugin _ -> pure () + SchemaMethod _ -> expectationFailure "a plugin schema parsed as a method" + + it "each method alone parses as a MethodSchema and as a SchemaResult (a method)" $ do + v <- load + methods <- maybe (fail "no methods") (pure . toList) $ case field "methods" v of + Just (Array ms) -> Just ms + _ -> Nothing + length methods `shouldBe` 7 + forM_ methods $ \m -> do + _ <- roundTrips @MethodSchema id m + result <- roundTrips @SchemaResult id m + case result of + SchemaMethod _ -> pure () + SchemaPlugin _ -> expectationFailure "a method schema parsed as a plugin" + + it "reads each method's returns, error, progress and cardinality" $ do + schema <- load >>= either fail pure . decodes @PluginSchema + let shape m = + ( methodName m + , title (methodReturns m) + , title =<< methodError m + , title =<< methodProgress m + , methodCardinality m + ) + map shape (psMethods schema) `shouldBe` + [ ("ping", Just "Pong", Nothing, Nothing, CardinalityOne) + , ("lookup", Just "Thing", Just "LookupError", Nothing, CardinalityOne) + , ("count", Just "Tick", Nothing, Nothing, CardinalityMany) + , ("scan", Just "Row", Just "ScanError", Nothing, CardinalityMany) + , ("load", Just "Loaded", Just "LoadError", Just "LoadStep", CardinalityMany) + , ("warm", Just "Warmed", Nothing, Just "Note", CardinalityMany) + , ("schema", Just "SchemaResult", Nothing, Nothing, CardinalityOne) -- the macro-generated method (RETURNS-26: a PluginSchema, or one MethodSchema) + ] + forM_ (psMethods schema) $ \m -> do + methodHttpMethod m `shouldBe` "POST" + methodRole m `shouldBe` MethodRoleRpc + methodBidirectional m `shouldBe` False + +wireSpec :: Spec +wireSpec = describe "expected/wire/*.jsonl" $ do + let wireDir = fixtureDir "wire" + frames f = readJsonl (wireDir f) + parsed f = frames f >>= mapM (either fail pure . decodes @PlexusStreamItem) + + it "holds exactly the wire files calls.json names" $ do + files <- filter ((== ".jsonl") . takeExtension) <$> listDirectory wireDir + calls <- readCalls + Set.fromList (map ("wire" ) files) `shouldBe` callWireFiles calls + + it "every frame of every call parses and re-encodes to the same JSON" $ do + hash <- fixtureHash + files <- sort . filter ((== ".jsonl") . takeExtension) <$> listDirectory wireDir + length files `shouldBe` 7 + forM_ files $ \f -> do + vs <- frames f + items <- mapM (roundTrips @PlexusStreamItem normalizeFrame) vs + -- each call ends in its one done + [() | StreamDone{} <- items] `shouldBe` [()] + case last items of + StreamDone{} -> pure () + other -> expectationFailure (f <> " does not end in done: " <> show other) + forM_ items $ \item -> do + itemProvenance item `shouldBe` Provenance ["conformance"] + itemPlexusHash item `shouldBe` hash + + it "load: two typed progress frames (LoadStep), then its {ok} item" $ do + items <- parsed "load.jsonl" + [ (ct, c) | StreamProgress _ _ ct c <- items ] `shouldBe` + [ ("conformance.load", object ["type" .= ("batch" :: Text), "done" .= (1 :: Int), "of" .= (2 :: Int)]) + , ("conformance.load", object ["type" .= ("batch" :: Text), "done" .= (2 :: Int), "of" .= (2 :: Int)]) + ] + [ (ct, c) | StreamData _ _ ct c <- items ] `shouldBe` + [ ("conformance.load", object ["ok" .= object ["items" .= (2 :: Int)]]) ] + + it "warm: two Note progress frames, the second with a percentage" $ do + items <- parsed "warm.jsonl" + [ c | StreamProgress _ _ "conformance.warm" c <- items ] `shouldBe` + [ object ["message" .= ("cache cold" :: Text)] + , object ["message" .= ("cache warming" :: Text), "percentage" .= (50.0 :: Double)] + ] + + it "scan: an {err} item between two {ok} items, the stream carrying on" $ do + items <- parsed "scan.jsonl" + [ c | StreamData _ _ "conformance.scan" c <- items ] `shouldBe` + [ object ["ok" .= object ["key" .= ("a1" :: Text)]] + , object ["err" .= object ["type" .= ("unreadable" :: Text), "key" .= ("a2" :: Text)]] + , object ["ok" .= object ["key" .= ("a3" :: Text)]] + ] + + it "plain-T methods carry their item unwrapped" $ do + ping <- parsed "ping.jsonl" + [ c | StreamData _ _ _ c <- ping ] `shouldBe` [object ["message" .= ("pong" :: Text)]] + count <- parsed "count.jsonl" + [ c | StreamData _ _ _ c <- count ] `shouldBe` [object ["n" .= n] | n <- [1 :: Int, 2, 3]] + +errorsSpec :: Spec +errorsSpec = describe "expected/errors.jsonl" $ do + let load = readJsonl (fixtureDir "errors.jsonl") + + it "holds exactly the lines calls.json names" $ do + vs <- load + calls <- readCalls + callErrorLines calls `shouldBe` [1 .. length vs] + + it "every error frame parses and re-encodes to the same JSON" $ do + hash <- fixtureHash + vs <- load + items <- mapM (roundTrips @PlexusStreamItem normalizeFrame) vs + length items `shouldBe` 3 + forM_ items $ \item -> itemPlexusHash item `shouldBe` hash + + it "carries a typed RemoteError, not recoverable" $ do + items <- load >>= mapM (either fail pure . decodes @PlexusStreamItem) + [ (e, r) | StreamError _ _ e r <- items ] `shouldBe` + [ (MethodNotFound "conformance" "frob", False) + , (InvalidParams (Just "id") Missing, False) + , (InvalidParams (Just "to") (Malformed "invalid type: string \"three\", expected u32"), False) + ] + [ renderRemoteError e | StreamError _ _ e _ <- items ] `shouldBe` + [ "method not found: conformance.frob" + , "invalid params: missing `id`" + , "invalid params: malformed `to`: invalid type: string \"three\", expected u32" + ] + +-- | RETURNS-4's wire literals, variant by variant. +wireLiterals :: [(RemoteError, Value)] +wireLiterals = + [ ( ActivationNotFound "tickets" + , object ["kind" .= s "activation_not_found", "activation" .= s "tickets"] ) + , ( MethodNotFound "tickets" "frob" + , object ["kind" .= s "method_not_found", "activation" .= s "tickets", "method" .= s "frob"] ) + , ( InvalidParams (Just "id") Missing + , object ["kind" .= s "invalid_params", "param" .= s "id", "problem" .= s "missing"] ) + , ( InvalidParams (Just "limit") (Malformed "invalid type: string \"ten\", expected u32") + , object [ "kind" .= s "invalid_params", "param" .= s "limit", "problem" .= s "malformed" + , "detail" .= s "invalid type: string \"ten\", expected u32" ] ) + , ( InvalidParams Nothing (Malformed "params must be an object") + , object ["kind" .= s "invalid_params", "problem" .= s "malformed", "detail" .= s "params must be an object"] ) + , ( InvalidParams Nothing Missing + , object ["kind" .= s "invalid_params", "problem" .= s "missing"] ) + , ( Unauthenticated + , object ["kind" .= s "unauthenticated"] ) + , ( Forbidden (MissingScope "tickets:write") + , object ["kind" .= s "forbidden", "reason" .= s "missing_scope", "scope" .= s "tickets:write"] ) + , ( Forbidden TenantBoundary + , object ["kind" .= s "forbidden", "reason" .= s "tenant_boundary"] ) + , ( Forbidden NotAccepted + , object ["kind" .= s "forbidden", "reason" .= s "not_accepted"] ) + , ( HandleNotSupported "tickets" + , object ["kind" .= s "handle_not_supported", "activation" .= s "tickets"] ) + , ( Execution "database is locked" + , object ["kind" .= s "execution", "message" .= s "database is locked"] ) + -- main's refusals in the vocabulary (RETURNS-36; plexus-client's remote_error.rs) + , ( Forbidden (MissingGrant "tickets.create" "*" ["editor", "admin"] []) + , object [ "kind" .= s "forbidden", "reason" .= s "missing_grant", "grant" .= s "tickets.create", "scope" .= s "*" + , "roles" .= [s "editor", s "admin"], "held_on" .= ([] :: [Text]) ] ) + , ( TooManyCalls 8 Nothing + , object ["kind" .= s "too_many_calls", "max" .= (8 :: Int)] ) + , ( TooManyCalls 4 (Just "echo") + , object ["kind" .= s "too_many_calls", "max" .= (4 :: Int), "child" .= s "echo"] ) + , ( ChildUnavailable "echo" "the connection has closed" + , object ["kind" .= s "child_unavailable", "child" .= s "echo", "reason" .= s "the connection has closed"] ) + , ( ChildTimeout "echo" 5000 + , object ["kind" .= s "child_timeout", "child" .= s "echo", "timeout_ms" .= (5000 :: Int)] ) + ] + +s :: Text -> Text +s = id + +remoteErrorSpec :: Spec +remoteErrorSpec = describe "RemoteError (RETURNS-4 wire literals)" $ do + forM_ wireLiterals $ \(err, wire) -> + it ("round-trips " <> encodeStr wire) $ do + toJSON err `shouldBe` wire + decodes wire `shouldBe` Right err + eitherDecode (encode wire) `shouldBe` Right err + + it "an invalid_params param of null decodes as Nothing" $ + decodes (object ["kind" .= s "invalid_params", "param" .= Null, "problem" .= s "missing"]) + `shouldBe` Right (InvalidParams Nothing Missing) + + -- RETURNS-36 (the Rust side's review #4, plexus-client's remote_error.rs): + -- a kind this build does not know is RemoteError's open variant, its kind + -- and every other field kept and written back exactly as they came; a + -- known kind that does not fit (a reason or problem it does not know) is + -- still a decode error + it "an unknown kind is kept with every field and written back as it came" $ + forM_ + [ object ["kind" .= s "too_many_connections", "max" .= (64 :: Int)] + , object ["kind" .= s "too_many_writes", "retry_after_ms" .= (250 :: Int), "message" .= s "slow down"] + ] $ \wire -> do + e <- either fail pure (decodes @RemoteError wire) + toJSON e `shouldBe` wire + case e of + Other k _ -> Just k `shouldBe` (field "kind" wire >>= \case { String t -> Just t; _ -> Nothing }) + _ -> expectationFailure ("not the open variant: " <> show e) + + it "an unknown kind renders as its kind and message, as the Rust Display" $ do + e <- either fail pure (decodes @RemoteError (object ["kind" .= s "too_many_writes", "retry_after_ms" .= (250 :: Int), "message" .= s "slow down"])) + renderRemoteError e `shouldBe` "too_many_writes: slow down" + c <- either fail pure (decodes @RemoteError (object ["kind" .= s "too_many_connections", "max" .= (64 :: Int)])) + renderRemoteError c `shouldBe` "too_many_connections" + + it "a known kind is not the open one" $ + decodes @RemoteError (object ["kind" .= s "unauthenticated"]) `shouldBe` Right Unauthenticated + + it "a reason or problem it does not know is a decode error, naming it" $ + forM_ + [ (object ["kind" .= s "forbidden", "reason" .= s "too_tall"], "too_tall") + , (object ["kind" .= s "invalid_params", "param" .= s "id", "problem" .= s "smelly"], "smelly") + ] $ \(wire, name) -> case decodes @RemoteError wire of + Right e -> expectationFailure ("decoded " <> show e <> " from " <> encodeStr wire) + Left msg -> msg `shouldSatisfy` (name `isInfixOf`) + + it "a required field that is absent is a decode error" $ + forM_ + [ object ["kind" .= s "method_not_found", "activation" .= s "tickets"] + , object ["kind" .= s "invalid_params", "param" .= s "id"] + , object ["kind" .= s "invalid_params", "problem" .= s "malformed"] + , object ["kind" .= s "forbidden"] + , object ["kind" .= s "forbidden", "reason" .= s "missing_scope"] + , object ["activation" .= s "tickets"] + ] $ \wire -> decodes @RemoteError wire `shouldSatisfy` isLeft + + it "renders the same one line as the Rust Display" $ + map (renderRemoteError . fst) wireLiterals `shouldBe` + [ "activation not found: tickets" + , "method not found: tickets.frob" + , "invalid params: missing `id`" + , "invalid params: malformed `limit`: invalid type: string \"ten\", expected u32" + , "invalid params: malformed: params must be an object" + , "invalid params: a required parameter is missing" + , "unauthenticated: credentials required" + , "forbidden: missing required scope `tickets:write`" + , "forbidden: tenant boundary" + , "forbidden: call not accepted" + , "handle resolution not supported by activation: tickets" + , "execution failed: database is locked" + , "forbidden: needs `tickets.create`" + , "too many calls open (at most 8): close one, or call again later" + , "too many calls open on child echo (at most 4): close one, or call again later" + , "child echo is unavailable: the connection has closed" + , "child echo did not open the call in 5000 ms" + ] + + it "folds line breaks in server text so the line stays one line" $ + renderRemoteError (Execution "panicked at src/lib.rs:1:1:\nboom\r\nagain") + `shouldBe` "execution failed: panicked at src/lib.rs:1:1: boom again" + +rejectionSpec :: Spec +rejectionSpec = describe "JSON-RPC rejection" $ do + let rejection = object + [ "code" .= (-32601 :: Int) + , "message" .= s "method not found: tickets.frob" + , "data" .= object ["kind" .= s "method_not_found", "activation" .= s "tickets", "method" .= s "frob"] + ] + + it "reads data as a RemoteError and re-encodes to the same JSON" $ do + e <- roundTrips @RpcError id rejection + e `shouldBe` RpcErrorObj (-32601) "method not found: tickets.frob" (Just (MethodNotFound "tickets" "frob")) + + it "a response carrying it is an RpcError" $ + decodes (object ["jsonrpc" .= s "2.0", "id" .= (7 :: Int), "error" .= rejection]) + `shouldBe` Right (RpcError (RequestId 7) (RpcErrorObj (-32601) "method not found: tickets.frob" (Just (MethodNotFound "tickets" "frob")))) + + it "a rejection without data (not a Plexus call failure) has no RemoteError" $ do + e <- roundTrips @RpcError id (object ["code" .= (-32601 :: Int), "message" .= s "Method not found"]) + errData e `shouldBe` Nothing + decodes (object ["code" .= (-32602 :: Int), "message" .= s "Method 'x' not found", "data" .= Null]) + `shouldBe` Right (RpcErrorObj (-32602) "Method 'x' not found" Nothing) + + it "jsonrpsee's own param rejection (string data) has no RemoteError" $ + decodes (object ["code" .= (-32602 :: Int), "message" .= s "Invalid params", "data" .= s "missing field `method`"]) + `shouldBe` Right (RpcErrorObj (-32602) "Invalid params" Nothing) + + it "a kind-tagged data of an unknown kind is the open variant" $ + fmap errData (decodes @RpcError (object ["code" .= (-32000 :: Int), "message" .= s "x", "data" .= object ["kind" .= s "rate_limited"]])) + `shouldBe` Right (Just (Other "rate_limited" mempty)) + +strictnessSpec :: Spec +strictnessSpec = describe "0.7 shapes are required, not defaulted" $ do + let method extra = object $ + [ "name" .= s "get", "description" .= s "d", "hash" .= s "h" ] <> extra + returns = "returns" .= object [] + returns' = "returns" .= object ["type" .= s "string"] + + it "Cardinality is \"one\" or \"many\"" $ do + toJSON CardinalityOne `shouldBe` String "one" + toJSON CardinalityMany `shouldBe` String "many" + decodes (String "one") `shouldBe` Right CardinalityOne + decodes (String "many") `shouldBe` Right CardinalityMany + decodes @Cardinality (String "some") `shouldSatisfy` isLeft + + it "a method with neither cardinality nor streaming does not parse" $ + decodes @MethodSchema (method [returns]) `shouldSatisfy` isLeft + + it "a method without returns does not parse" $ + decodes @MethodSchema (method ["cardinality" .= s "one"]) `shouldSatisfy` isLeft + + it "a minimal 0.7 method parses with the Rust defaults" $ do + m <- either fail pure $ decodes @MethodSchema (method [returns, "cardinality" .= s "many"]) + methodCardinality m `shouldBe` CardinalityMany + methodError m `shouldBe` Nothing + methodProgress m `shouldBe` Nothing + methodHttpMethod m `shouldBe` "POST" + methodRole m `shouldBe` MethodRoleRpc + toJSON m `shouldBe` method + [ returns, "cardinality" .= s "many", "bidirectional" .= False + , "http_method" .= s "POST", "role" .= object ["kind" .= s "rpc"] ] + + let meta = "metadata" .= object + ["provenance" .= [s "tickets"], "plexus_hash" .= s "h", "timestamp" .= (0 :: Int)] + + -- RETURNS-36 (the coordinator's decision): synapse 4.0 reads the + -- published 0.7.0 line too, as plexus-core's child seam does + -- (remote_child/peer.rs) — from what the peer itself declared, never + -- guessing; a 0.8 schema is read strictly, as above. + it "a 0.7.0 method: its cardinality is its streaming flag, its missing returns {}" $ do + many <- either fail pure $ decodes @MethodSchema (method ["streaming" .= True]) + methodCardinality many `shouldBe` CardinalityMany + methodReturns many `shouldBe` object [] + one <- either fail pure $ decodes @MethodSchema (method [returns', "streaming" .= False]) + methodCardinality one `shouldBe` CardinalityOne + methodReturns one `shouldBe` object ["type" .= s "string"] + -- written back in 0.8's shape + toJSON many `shouldBe` method + [ returns, "cardinality" .= s "many", "bidirectional" .= False + , "http_method" .= s "POST", "role" .= object ["kind" .= s "rpc"] ] + + it "a 0.8 method's cardinality wins over a streaming flag beside it" $ do + m <- either fail pure $ decodes @MethodSchema (method [returns, "cardinality" .= s "one", "streaming" .= True]) + methodCardinality m `shouldBe` CardinalityOne + + it "a 0.7.0 progress frame (message, percentage) reads as the default progress type, Note" $ do + item <- either fail pure $ decodes @PlexusStreamItem + (object ["type" .= s "progress", meta, "message" .= s "half", "percentage" .= (50 :: Int)]) + case item of + StreamProgress _ _ _ c -> c `shouldBe` object ["message" .= s "half", "percentage" .= (50 :: Int)] + other -> expectationFailure (show other) + + it "a 0.7.0 progress frame's null percentage is left out, as spec05.rs reads it" $ do + item <- either fail pure $ decodes @PlexusStreamItem + (object ["type" .= s "progress", meta, "message" .= s "started", "percentage" .= Null]) + case item of + StreamProgress _ _ _ c -> c `shouldBe` object ["message" .= s "started"] + other -> expectationFailure (show other) + + it "a 0.7.0 error frame (message, code) reads typed from its fields, and keeps them" $ do + let wire = object ["type" .= s "error", meta, "message" .= s "boom", "code" .= s "-32000", "recoverable" .= False] + item <- either fail pure $ decodes @PlexusStreamItem wire + itemError item `shouldBe` Execution "boom" + toJSON item `shouldBe` object + [ "type" .= s "error", meta, "message" .= s "boom", "code" .= s "-32000", "recoverable" .= False + , "error" .= object ["kind" .= s "execution", "message" .= s "boom"] ] + + it "a 0.7.0 error frame: error_kind first, else code, as peer.rs reads it" $ do + let frame extra = object (["type" .= s "error", meta, "recoverable" .= False] <> extra) + typed extra = either error itemError (decodes @PlexusStreamItem (frame extra)) + typed [ "message" .= s "needs tickets.set_status on IDENTITY", "code" .= s "-32003", "error_kind" .= s "forbidden" + , "grant" .= s "tickets.set_status", "scope" .= s "IDENTITY" + , "roles" .= [s "editor", s "admin"], "held_on" .= [s "DOCS"] ] + `shouldBe` Forbidden (MissingGrant "tickets.set_status" "IDENTITY" ["editor", "admin"] ["DOCS"]) + typed ["message" .= s "x", "code" .= s "-32003"] `shouldBe` Forbidden (MissingGrant "" "" [] []) + typed ["message" .= s "x", "error_kind" .= s "forbidden", "reason" .= s "missing_scope", "scope" .= s "t:w"] + `shouldBe` Forbidden (MissingScope "t:w") + typed ["message" .= s "bad", "code" .= s "-32602"] `shouldBe` InvalidParams Nothing (Malformed "bad") + typed ["message" .= s "bad", "error_kind" .= s "invalid_params"] `shouldBe` InvalidParams Nothing (Malformed "bad") + typed ["message" .= s "sign in", "code" .= (-32001 :: Int)] `shouldBe` Unauthenticated + typed ["message" .= s "busy", "error_kind" .= s "too_many_calls", "max" .= (8 :: Int)] `shouldBe` TooManyCalls 8 Nothing + typed ["error_kind" .= s "child_unavailable", "child" .= s "echo", "reason" .= s "closed"] `shouldBe` ChildUnavailable "echo" "closed" + typed ["error_kind" .= s "child_timeout", "child" .= s "echo", "timeout_ms" .= (5000 :: Int)] `shouldBe` ChildTimeout "echo" 5000 + -- spec/05: -32601 is an activation or method not found, its message naming which + typed ["message" .= s "Method not found: tickets.nosuch", "code" .= s "-32601"] `shouldBe` MethodNotFound "tickets" "nosuch" + typed ["message" .= s "Activation not found: nosuch", "code" .= s "-32601"] `shouldBe` ActivationNotFound "nosuch" + typed ["message" .= s "Method not found: tickets.inputs.nosuch", "code" .= s "-32601"] `shouldBe` MethodNotFound "tickets.inputs" "nosuch" + -- as plexus-client's spec05.rs reads it: no dot, the method alone + typed ["message" .= s "Method not found: nosuch", "code" .= s "-32601"] `shouldBe` MethodNotFound "" "nosuch" + itemRefusal (either error id (decodes @PlexusStreamItem (frame + [ "message" .= s "needs x", "error_kind" .= s "forbidden", "grant" .= s "tickets.get", "scope" .= s "*" ]))) + `shouldSatisfy` maybe False ((== Just "tickets.get") . refusalGrant) + + it "an error frame must say whether it is recoverable" $ + decodes @PlexusStreamItem + (object ["type" .= s "error", meta, "error" .= object ["kind" .= s "unauthenticated"]]) + `shouldSatisfy` isLeft + +isLeft :: Either a b -> Bool +isLeft = either (const True) (const False) + +-- | RETURNS-36: what main brought beside 0.7 — AUTH-2's refusal on a typed +-- error frame, AUTH-3/4's schema fields, SYNAPSE-13's and SYNAPSE-CC-8's. +mergedSpec :: Spec +mergedSpec = describe "0.7 merged with main's auth (RETURNS-36)" $ do + let meta = "metadata" .= object + ["provenance" .= [s "tickets"], "plexus_hash" .= s "h", "timestamp" .= (0 :: Int)] + grantWire = object + [ "kind" .= s "forbidden", "reason" .= s "missing_grant", "grant" .= s "tickets.set_status" + , "scope" .= s "IDENTITY", "roles" .= [s "editor", s "admin"], "held_on" .= [s "DOCS"] ] + grantErr = Forbidden (MissingGrant "tickets.set_status" "IDENTITY" ["editor", "admin"] ["DOCS"]) + refusal = Refusal + { refusalGrant = Just "tickets.set_status", refusalScope = Just "IDENTITY" + , refusalRoles = ["editor", "admin"], refusalHeldOn = ["DOCS"], refusalCeiling = [] + , refusalMessage = "needs tickets.set_status on IDENTITY" } + + it "a missing grant is a forbidden RemoteError, and round-trips" $ do + decodes grantWire `shouldBe` Right grantErr + toJSON grantErr `shouldBe` grantWire + -- the Rust Display's line (plexus-client's remote_error.rs) + renderRemoteError grantErr `shouldBe` "forbidden: needs `tickets.set_status` on `IDENTITY`" + renderRemoteError (Forbidden (MissingGrant "auth.role_set" "*" [] [])) + `shouldBe` "forbidden: needs `auth.role_set`" + + it "an error frame whose typed error is a missing grant names its refusal" $ do + item <- roundTrips @PlexusStreamItem id + (object ["type" .= s "error", meta, "recoverable" .= False, "error" .= grantWire + , "message" .= s "needs tickets.set_status on IDENTITY"]) + itemError item `shouldBe` grantErr + itemErrorRefusal item `shouldBe` Nothing + itemRefusal item `shouldBe` Just refusal + + it "AUTH-2's refusal fields beside the typed error are kept and re-encoded" $ do + let wire = object + [ "type" .= s "error", meta, "recoverable" .= False, "error" .= grantWire + , "message" .= s "needs tickets.set_status on IDENTITY", "code" .= s "-32003" + , "error_kind" .= s "forbidden", "grant" .= s "tickets.set_status", "scope" .= s "IDENTITY" + , "roles" .= [s "editor", s "admin"], "held_on" .= [s "DOCS"] ] + item <- roundTrips @PlexusStreamItem id wire + itemErrorRefusal item `shouldBe` Just refusal + itemRefusal item `shouldBe` Just refusal + + it "main's message, code and error_kind beside the typed error are kept as sent" $ do + item <- roundTrips @PlexusStreamItem id $ object + [ "type" .= s "error", meta, "recoverable" .= False + , "error" .= object ["kind" .= s "invalid_params", "param" .= s "id", "problem" .= s "missing"] + , "message" .= s "Invalid params: missing field: id", "code" .= s "-32602", "error_kind" .= s "invalid_params" ] + itemError item `shouldBe` InvalidParams (Just "id") Missing + itemRefusal item `shouldBe` Nothing + + -- the review (RETURNS-36 #1): the frames plexus-core 0.8 writes + -- (PlexusStreamItem::from_plexus_error: message, code, the typed error and + -- spec/05's fields), and the server's message as callers read it + it "a signed-out session's frame, as plexus-core 0.8 writes it: unauthenticated, the server's message kept" $ do + item <- roundTrips @PlexusStreamItem id $ object + [ "type" .= s "error", meta, "recoverable" .= False + , "message" .= s "Authentication required: you have signed out: sign in again", "code" .= s "-32001" + , "error" .= object ["kind" .= s "unauthenticated"], "error_kind" .= s "unauthenticated" ] + itemError item `shouldBe` Unauthenticated + itemErrorMessage item `shouldBe` Just "Authentication required: you have signed out: sign in again" + + it "a missing param's frame, as plexus-core 0.8 writes it" $ do + item <- roundTrips @PlexusStreamItem id $ object + [ "type" .= s "error", meta, "recoverable" .= False + , "message" .= s "Invalid params: missing field: id", "code" .= s "-32602" + , "error" .= object ["kind" .= s "invalid_params", "param" .= s "id", "problem" .= s "missing"] + , "error_kind" .= s "invalid_params" ] + itemError item `shouldBe` InvalidParams (Just "id") Missing + itemErrorMessage item `shouldBe` Just "Invalid params: missing field: id" + + it "a 0.7.0 frame's message is the server's too" $ do + item <- either fail pure $ decodes @PlexusStreamItem + (object ["type" .= s "error", meta, "message" .= s "your sign-in has expired: sign in again", "code" .= s "-32001", "recoverable" .= False]) + itemError item `shouldBe` Unauthenticated + itemErrorMessage item `shouldBe` Just "your sign-in has expired: sign in again" + + -- review §4: an error frame written here carries message, so plexus-core + -- (whose frame requires it) reads it + it "an error frame built here is written with its message" $ do + let item = StreamError "h" (Provenance ["tickets"]) (Execution "boom") False + field "message" (toJSON item) `shouldBe` Just (String "execution failed: boom") + itemErrorMessage item `shouldBe` Nothing + fmap itemError (decodes @PlexusStreamItem (toJSON item)) `shouldBe` Right (Execution "boom") + + -- the Rust side's review: a frame's message is optional on reading + -- (plexus-core always writes it); without it a caller renders the typed error + it "an error frame without message reads; written back with one" $ do + item <- either fail pure $ decodes @PlexusStreamItem + (object ["type" .= s "error", meta, "recoverable" .= False, "error" .= object ["kind" .= s "unauthenticated"]]) + itemError item `shouldBe` Unauthenticated + itemErrorMessage item `shouldBe` Nothing + field "message" (toJSON item) `shouldBe` Just (String "unauthenticated: credentials required") + + it "an error frame whose typed error is an unknown kind round-trips" $ do + item <- roundTrips @PlexusStreamItem id $ object + [ "type" .= s "error", meta, "recoverable" .= False, "message" .= s "too_many_writes: slow down", "code" .= s "too_many_writes" + , "error" .= object ["kind" .= s "too_many_writes", "retry_after_ms" .= (250 :: Int), "message" .= s "slow down"] + , "error_kind" .= s "too_many_writes", "retry_after_ms" .= (250 :: Int) ] + renderRemoteError (itemError item) `shouldBe` "too_many_writes: slow down" + + it "a 0.7.0 frame with an unknown error_kind is that kind, its fields kept (peer.rs)" $ do + item <- either fail pure $ decodes @PlexusStreamItem $ object + [ "type" .= s "error", meta, "recoverable" .= False, "code" .= s "too_many_writes" + , "error_kind" .= s "too_many_writes", "retry_after_ms" .= (250 :: Int), "message" .= s "slow down" ] + toJSON (itemError item) `shouldBe` object ["kind" .= s "too_many_writes", "retry_after_ms" .= (250 :: Int), "message" .= s "slow down"] + + it "any other typed error has no refusal" $ do + item <- either fail pure $ decodes @PlexusStreamItem + (object ["type" .= s "error", meta, "recoverable" .= False, "error" .= object ["kind" .= s "unauthenticated"]]) + itemRefusal item `shouldBe` Nothing + + it "a method keeps main's auth, group, examples and input beside 0.7's contract" $ do + let wire = object + [ "name" .= s "set_status", "description" .= s "d", "hash" .= s "h" + , "returns" .= object [], "error" .= object ["title" .= s "SetStatusError"] + , "cardinality" .= s "one", "bidirectional" .= False, "http_method" .= s "POST" + , "role" .= object ["kind" .= s "rpc"] + , "long_description" .= s "long", "grant" .= s "tickets.set_status", "target" .= s "id" + , "held_on" .= [s "*"], "public" .= True, "group" .= s "write" + , "examples" .= [object ["params" .= object ["id" .= s "A-1"], "note" .= s "one"]] + , "input" .= object ["type" .= s "string"] ] + m <- roundTrips @MethodSchema id wire + methodGrant m `shouldBe` Just "tickets.set_status" + methodGroup m `shouldBe` Just "write" + methodCardinality m `shouldBe` CardinalityOne + + it "a plugin keeps main's roles and view beside 0.7's self_hash and CONTEXT-5's request" $ do + let wire = object + [ "namespace" .= s "tickets", "version" .= s "1", "description" .= s "d", "hash" .= s "h" + , "self_hash" .= s "sh", "methods" .= ([] :: [Value]) + , "request" .= object ["type" .= s "object"] + , "roles" .= object ["viewer" .= [s "tickets.get"]], "view" .= s "caller" ] + p <- roundTrips @PluginSchema id wire + psView p `shouldBe` Just Caller + psSelfHash p `shouldBe` Just "sh" + + it "an anonymous view's plugin may omit its hash, version and description (AUTH-4)" $ do + p <- either fail pure $ decodes @PluginSchema + (object ["namespace" .= s "menger", "methods" .= ([] :: [Value]), "view" .= s "anonymous"]) + psHash p `shouldBe` "" + psView p `shouldBe` Just Anonymous