diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -48,6 +48,7 @@ import Synapse.IR.Types (IR, irMethods, MethodDef) import qualified Data.Map.Strict as Map import qualified Synapse.CLI.Template as TemplateIR +import Synapse.Deprecation (emitActivationWarning, emitMethodWarning) import Synapse.Transport import Synapse.Bidir (BidirMode(..), parseBidirMode, detectBidirMode, handleBidirRequest) import Plexus.Types (Response(..)) @@ -84,6 +85,7 @@ , soLogSubsystems :: [Text] -- ^ Filter logs by subsystems (empty = all) , soToken :: Maybe Text -- ^ JWT sent as Cookie: access_token= , soTokenFile :: Maybe Text -- ^ Path to token file (overridden by --token) + , soNoDeprecationWarnings :: Bool -- ^ Suppress invocation-time deprecation warnings (IR-15) } deriving Show @@ -409,6 +411,28 @@ ViewMethod method path -> do let fullPath = T.intercalate "." path + -- IR-15: emit stderr deprecation warnings right before any + -- real invocation. Dedupe is per-process-lifetime, so this + -- action is idempotent on repeat calls. We bind it as a + -- local SynapseM action and invoke it at both invocation + -- sites below (fast path and slow path). --help, --dry-run, + -- --schema, and --emit-ir do not invoke, and intentionally + -- do not fire these warnings. + let fireDeprecationWarnings :: SynapseM () + fireDeprecationWarnings = do + liftIO $ emitMethodWarning + soNoDeprecationWarnings + fullPath + (methodDeprecation method) + let namespacePath = init path + when (not (null namespacePath)) $ do + let activationNs = T.intercalate "." namespacePath + parentPlugin <- fetchSchemaAt namespacePath + liftIO $ emitActivationWarning + soNoDeprecationWarnings + activationNs + (psDeprecation parentPlugin) + -- Optimization: Skip IR construction for parameter-less methods -- IR is only needed for: -- 1. Help rendering (--help flag) @@ -420,7 +444,7 @@ -- Fast path: parameter-less method with no help requested if not needsIR - then invokeMethod path (object []) + then fireDeprecationWarnings >> invokeMethod path (object []) else do -- Build IR for this method's namespace ir <- buildIR soGeneratorInfo (init path) @@ -477,7 +501,8 @@ Nothing -> -- Fallback: method not in IR, use basic info liftIO $ TIO.putStrLn $ T.intercalate "." path <> " - " <> methodDescription method - else invokeMethod path params + -- IR-15: fire stderr deprecation warnings before real invocation. + else fireDeprecationWarnings >> invokeMethod path params where handleRespondCommand :: [(Text, Text)] -> SynapseM () handleRespondCommand params = do @@ -966,4 +991,7 @@ soTokenFile <- optional $ T.pack <$> strOption ( long "token-file" <> metavar "PATH" <> help "Path to token file (default lookup: ~/.plexus/tokens/)" ) + soNoDeprecationWarnings <- switch + ( long "no-deprecation-warnings" + <> help "Suppress invocation-time deprecation warnings on stderr (IR-15)" ) pure SynapseOpts{..} diff --git a/plexus-synapse.cabal b/plexus-synapse.cabal --- a/plexus-synapse.cabal +++ b/plexus-synapse.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: plexus-synapse -version: 3.10.1 +version: 3.13.0 synopsis: Schema-driven CLI for Plexus RPC servers license: MIT author: @@ -24,6 +24,7 @@ Synapse.Algebra.Recursion Synapse.Transport Synapse.Cache + Synapse.Deprecation Synapse.Renderer Synapse.IR.Types Synapse.IR.Builder @@ -192,7 +193,8 @@ containers >= 0.6 && < 0.8, hspec >= 2.10 && < 2.12, aeson >= 2.2 && < 2.3, - bytestring >= 0.11 && < 0.13 + bytestring >= 0.11 && < 0.13, + katip >= 0.8 && < 0.9 hs-source-dirs: test default-language: GHC2021 default-extensions: @@ -288,7 +290,8 @@ plexus-synapse, text >= 2.0 && < 2.2, containers >= 0.6 && < 0.8, - hspec >= 2.10 && < 2.12 + hspec >= 2.10 && < 2.12, + katip >= 0.8 && < 0.9 hs-source-dirs: test default-language: GHC2021 default-extensions: @@ -303,6 +306,40 @@ base >= 4.17 && < 5, plexus-synapse, text >= 2.0 && < 2.2, + aeson >= 2.2 && < 2.3, + bytestring >= 0.11 && < 0.13, + hspec >= 2.10 && < 2.12 + hs-source-dirs: test + default-language: GHC2021 + default-extensions: + OverloadedStrings + ghc-options: -threaded + +test-suite deprecation-test + type: exitcode-stdio-1.0 + main-is: DeprecationSpec.hs + build-depends: + base >= 4.17 && < 5, + plexus-protocol, + plexus-synapse, + text >= 2.0 && < 2.2, + aeson >= 2.0 && < 2.3, + containers >= 0.6 && < 0.8, + directory >= 1.3 && < 1.4, + hspec >= 2.10 && < 2.12 + hs-source-dirs: test + default-language: GHC2021 + default-extensions: + OverloadedStrings + ghc-options: -threaded + +test-suite ir12-method-role-test + type: exitcode-stdio-1.0 + main-is: IR12MethodRoleSpec.hs + build-depends: + base >= 4.17 && < 5, + plexus-protocol, + plexus-synapse, aeson >= 2.2 && < 2.3, bytestring >= 0.11 && < 0.13, hspec >= 2.10 && < 2.12 diff --git a/src/Synapse/Algebra/Render.hs b/src/Synapse/Algebra/Render.hs --- a/src/Synapse/Algebra/Render.hs +++ b/src/Synapse/Algebra/Render.hs @@ -12,6 +12,10 @@ , RenderStyle(..) , defaultStyle , compactStyle + + -- * Deprecation Rendering (IR-6) + , deprecationMarker + , formatDeprecationLine ) where import Data.Text (Text) @@ -24,6 +28,7 @@ import Prettyprinter.Render.Text (renderStrict) import Synapse.Schema.Types +import Plexus.Schema.Recursive (DeprecationInfo(..), ParamSchema(..)) -- | Rendering style configuration data RenderStyle = RenderStyle @@ -54,16 +59,39 @@ -- | Render with custom style renderSchemaWith :: RenderStyle -> PluginSchema -> Text renderSchemaWith _style PluginSchema{..} - | null psMethods && maybe True null psChildren = headerText + | null psMethods && maybe True null psChildren = deprecationBanner <> headerText | otherwise = renderStrict $ layoutPretty layoutOpts doc where layoutOpts = LayoutOptions (AvailablePerLine 80 1.0) + -- Activation-level deprecation banner (plain-text, rendered ahead + -- of the compact header variant used for trivial schemas). + deprecationBanner = case psDeprecation of + Just di -> deprecationMarker <> " " <> formatDeprecationLine di <> "\n" + Nothing -> "" + headerText = psNamespace <> " v" <> psVersion <> "\n" <> psDescription <> "\n" + -- Name line; decorated with the warning marker when the activation + -- carries Just DeprecationInfo. + namespaceHeading = case psDeprecation of + Just _ -> pretty (deprecationMarker <> " " <> psNamespace) + <+> pretty ("v" <> psVersion) + Nothing -> pretty psNamespace <+> pretty ("v" <> psVersion) + + -- Full deprecation notice rendered immediately below the heading + -- when relevant, before the description block. + deprecationNoticeDoc = case psDeprecation of + Just di -> vsep + [ emptyDoc + , indent 2 $ pretty (formatDeprecationLine di) + ] + Nothing -> emptyDoc + doc :: Doc ann doc = vsep - [ pretty psNamespace <+> pretty ("v" <> psVersion) + [ namespaceHeading + , deprecationNoticeDoc , emptyDoc , indent 2 $ align $ fillSep $ map pretty $ T.words psDescription , emptyDoc @@ -92,10 +120,16 @@ renderChildDoc child = fillBreak 12 (pretty $ csNamespace child) <+> align (fillSep $ map pretty $ T.words $ csDescription child) - renderMethodDoc method = vsep $ - [ fillBreak 12 (pretty $ methodName method) - <+> align (fillSep $ map pretty $ T.words $ methodDescription method) - ] ++ paramsDocs (methodParams method) + renderMethodDoc method = + let nameText = case methodDeprecation method of + Just _ -> deprecationMarker <> " " <> methodName method + Nothing -> methodName method + nameLine = fillBreak 12 (pretty nameText) + <+> align (fillSep $ map pretty $ T.words $ methodDescription method) + depLines = case methodDeprecation method of + Just di -> [indent 12 $ pretty (formatDeprecationLine di)] + Nothing -> [] + in vsep $ [nameLine] ++ depLines ++ paramsDocs (methodParams method) paramsDocs Nothing = [] paramsDocs (Just (Object o)) = case KM.lookup "properties" o of @@ -130,7 +164,12 @@ " " <> padRight 16 (methodName m) <> methodDescription m <> if rsShowTypes then renderParams (methodParams m) else "" --- | Render a method (full form with all params) +-- | Render a method (full form with all params). +-- +-- IR-14: per-parameter deprecation info carried on @methodParamSchemas@ +-- is threaded into the param rendering so each deprecated parameter +-- receives the ⚠ marker and the formatted @DEPRECATED since …@ line. +-- Non-deprecated parameters render exactly as before. renderMethodFull :: MethodSchema -> Text renderMethodFull m = T.unlines $ [ methodName m <> " - " <> methodDescription m @@ -139,7 +178,7 @@ where paramLines = case methodParams m of Nothing -> [" (no parameters)"] - Just schema -> renderParamsFull schema + Just schema -> renderParamsFull (methodParamSchemas m) schema -- | Render a child summary renderChild :: ChildSummary -> Text @@ -171,26 +210,53 @@ reqMarker = if isReq then "" else "?" in " --" <> flagName <> " <" <> typ <> ">" <> reqMarker <> " " <> desc --- | Render parameters in full (for method help) -renderParamsFull :: Value -> [Text] -renderParamsFull (Object o) = case KM.lookup "properties" o of +-- | Render parameters in full (for method help). +-- +-- IR-14: the first argument carries optional per-parameter metadata +-- ('ParamSchema') advertised by IR-5 producers. Any parameter whose +-- 'paramDeprecation' is @Just@ is decorated with the ⚠ marker and a +-- trailing @DEPRECATED since … removed in … — …@ line. Parameters +-- without a matching entry render identically to pre-ticket output. +renderParamsFull :: Maybe [ParamSchema] -> Value -> [Text] +renderParamsFull paramSchemas (Object o) = case KM.lookup "properties" o of Just (Object props) -> let reqList = case KM.lookup "required" o of Just (Array arr) -> [t | String t <- foldr (:) [] arr] _ -> [] propList = KM.toList props sorted = sortOn (\(k, _) -> (K.toText k `notElem` reqList, K.toText k)) propList - in map (renderParamFull reqList) sorted + in map (renderParamFull paramSchemas reqList) sorted _ -> [] -renderParamsFull _ = [] +renderParamsFull _ _ = [] -renderParamFull :: [Text] -> (K.Key, Value) -> Text -renderParamFull required (name, propSchema) = +-- | Look up per-parameter deprecation info by name, scanning the +-- optional ParamSchema list attached to the method. +lookupParamDeprecation :: Maybe [ParamSchema] -> Text -> Maybe DeprecationInfo +lookupParamDeprecation Nothing _ = Nothing +lookupParamDeprecation (Just pss) pname = + case filter ((== pname) . paramName) pss of + (ps:_) -> paramDeprecation ps + [] -> Nothing + +renderParamFull :: Maybe [ParamSchema] -> [Text] -> (K.Key, Value) -> Text +renderParamFull paramSchemas required (name, propSchema) = let nameText = K.toText name isReq = nameText `elem` required (typ, desc) = extractTypeDesc propSchema reqText = if isReq then " (required)" else " (optional)" - in " --" <> nameText <> " <" <> typ <> ">" <> reqText <> "\n " <> desc + -- IR-14: deprecation decoration. Marker prepended to the flag + -- name, detail line appended after the description. Pre-ticket + -- non-deprecated output is preserved exactly when depInfo is + -- Nothing. + depInfo = lookupParamDeprecation paramSchemas nameText + decoratedName = case depInfo of + Just _ -> deprecationMarker <> " --" <> nameText + Nothing -> "--" <> nameText + depLine = case depInfo of + Just di -> "\n " <> formatDeprecationLine di + Nothing -> "" + in " " <> decoratedName <> " <" <> typ <> ">" <> reqText + <> "\n " <> desc <> depLine -- | Extract type and description from property schema extractTypeDesc :: Value -> (Text, Text) @@ -205,3 +271,23 @@ padRight n t | T.length t >= n = t <> " " | otherwise = t <> T.replicate (n - T.length t) " " + +-- ============================================================================ +-- Deprecation Rendering (IR-6) +-- ============================================================================ + +-- | Visible marker for deprecated surfaces. +-- +-- Plain UTF-8 — a TTY/color-aware renderer lives at the CLI boundary; +-- this module only emits text markers. +deprecationMarker :: Text +deprecationMarker = "\x26A0" -- ⚠ + +-- | Format the one-line deprecation detail, e.g. +-- @DEPRECATED since 0.5, removed in 0.7 — use move_doc@. +formatDeprecationLine :: DeprecationInfo -> Text +formatDeprecationLine di = + "DEPRECATED since " <> depSince di + <> ", removed in " <> depRemovedIn di + <> " \x2014 " <> depMessage di -- em-dash + diff --git a/src/Synapse/CLI/Help.hs b/src/Synapse/CLI/Help.hs --- a/src/Synapse/CLI/Help.hs +++ b/src/Synapse/CLI/Help.hs @@ -64,6 +64,7 @@ import qualified Data.Text as T import Synapse.IR.Types +import Synapse.Algebra.Render (deprecationMarker, formatDeprecationLine) -- ============================================================================ -- Configuration @@ -118,14 +119,25 @@ ["Parameters:"] ++ concatMap (renderParamBlock style ir) (mdParams method) --- | Render a parameter as a block (may be multi-line for complex types) +-- | Render a parameter as a block (may be multi-line for complex types). +-- +-- IR-14: when @pdDeprecation param@ is @Just DeprecationInfo@ the +-- warning marker (⚠) is prepended to the parameter's flag name and the +-- formatted @DEPRECATED since … removed in … — …@ line is appended +-- (indented one level below the header). Non-deprecated parameters are +-- rendered exactly as before. renderParamBlock :: HelpStyle -> IR -> ParamDef -> [Text] renderParamBlock style ir param = let indent' = T.replicate (hsIndent style) " " indent2 = T.replicate (hsIndent style * 2) " " - -- Parameter header line - flagName = "--" <> T.replace "_" "-" (pdName param) -- Display as kebab-case + -- Parameter header line (optionally prefixed with the deprecation + -- marker; see IR-14). The marker sits before the flag so callers + -- who grep for '--name' still match a deprecated flag line. + rawFlag = "--" <> T.replace "_" "-" (pdName param) -- Display as kebab-case + flagName = case pdDeprecation param of + Just _ -> deprecationMarker <> " " <> rawFlag + Nothing -> rawFlag typeStr = renderTypeRef ir (pdType param) reqText = if pdRequired param then "(required)" else "(optional)" headerLine = indent' <> flagName <> " <" <> typeStr <> "> " <> reqText @@ -135,12 +147,18 @@ Just desc -> [indent2 <> desc] Nothing -> [] + -- Deprecation detail line (IR-14). Indented one level beyond the + -- header to match the description block's indentation. + deprecationLines = case pdDeprecation param of + Just di -> [indent2 <> formatDeprecationLine di] + Nothing -> [] + -- Type expansion (for enums/unions) expansionLines = if hsExpandEnums style then map (indent2 <>) (expandType ir (pdName param) (pdType param)) else [] - in [""] ++ [headerLine] ++ descLines ++ expansionLines + in [""] ++ [headerLine] ++ descLines ++ deprecationLines ++ expansionLines -- ============================================================================ -- Parameter Help diff --git a/src/Synapse/CLI/Parse.hs b/src/Synapse/CLI/Parse.hs --- a/src/Synapse/CLI/Parse.hs +++ b/src/Synapse/CLI/Parse.hs @@ -242,7 +242,7 @@ KindAlias target -> -- Follow the alias - buildParamValue ir ParamDef{pdName = paramName, pdType = target, pdDescription = Nothing, pdRequired = True, pdDefault = Nothing} kvs + buildParamValue ir ParamDef{pdName = paramName, pdType = target, pdDescription = Nothing, pdRequired = True, pdDefault = Nothing, pdDeprecation = Nothing} kvs KindStringEnum allowedValues -> -- Expect single string value from allowed set diff --git a/src/Synapse/Deprecation.hs b/src/Synapse/Deprecation.hs new file mode 100644 --- /dev/null +++ b/src/Synapse/Deprecation.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Invocation-time deprecation warnings (IR-15). +-- +-- IR-6 landed tree-rendering markers for deprecated activations and methods. +-- IR-15 closes the gap for users who never browse the tree — they run a +-- method directly (often from a script). This module emits a one-line +-- notice to 'stderr' at the moment of invocation. +-- +-- = Contract +-- +-- * Warning text is emitted to 'stderr' only. 'stdout' is untouched so +-- pipe consumers see the same bytes they saw before. +-- * The warning line format is built from IR-6's 'deprecationMarker' and +-- 'formatDeprecationLine' helpers (re-exported from 'Synapse.Algebra.Render') +-- so tree rendering and invocation warnings match byte-for-byte after the +-- key/path prefix. +-- * A per-process 'IORef' dedupes warnings by key. Method-level keys are the +-- full dotted path (e.g. @"docs.move_doc"@); activation-level keys are the +-- activation's namespace (e.g. @"docs"@). Keyspaces are disjoint by +-- construction (methods always carry a dot; activation namespaces never +-- carry one in the key we emit below). +-- * A boolean "suppressed" flag short-circuits both emission functions. The +-- CLI wires this flag to the @--no-deprecation-warnings@ option. +-- +-- = Implementation +-- +-- The dedupe 'IORef' is a top-level, 'NOINLINE' global because "per session" +-- in the ticket means "per process lifetime". Embedding the set in +-- 'Synapse.Monad.SynapseEnv' would also work but would force every call site +-- that currently runs in 'IO' (e.g. bidir callbacks) to thread the env around. +-- The IORef approach keeps the API callable from plain 'IO'. +module Synapse.Deprecation + ( -- * Emission + emitMethodWarning + , emitActivationWarning + + -- * Testing Support + , resetDeprecationStateForTesting + , formatMethodWarningLine + , formatActivationWarningLine + ) where + +import Control.Monad (when) +import Data.IORef (IORef, atomicModifyIORef', newIORef, writeIORef) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import System.IO (hFlush, stderr) +import System.IO.Unsafe (unsafePerformIO) + +import Plexus.Schema.Recursive (DeprecationInfo) +import Synapse.Algebra.Render (deprecationMarker, formatDeprecationLine) + +-- ============================================================================ +-- Dedupe State +-- ============================================================================ + +-- | Process-wide set of keys already warned-about. Keys follow the scheme +-- documented at the top of this module (method full-path, or activation +-- namespace). The same 'IORef' serves both keyspaces; collisions are +-- prevented by the dotted-path vs. plain-namespace distinction. +-- +-- NOINLINE is load-bearing: GHC must share a single 'IORef' across every +-- call site, otherwise each call would get its own empty set and dedupe +-- would silently break. +warnedKeys :: IORef (Set Text) +warnedKeys = unsafePerformIO (newIORef Set.empty) +{-# NOINLINE warnedKeys #-} + +-- | Try to claim a key for first-time emission. Returns 'True' when the +-- caller is the first to claim it (warning should fire), 'False' when +-- the key was already present (caller must stay silent). +-- +-- 'atomicModifyIORef'' makes this safe under the IO concurrency we care +-- about here (streaming RPC callback threads, bidir handlers). There is +-- no correctness problem if two threads lose the race and both see the +-- key as "already present" — the semantics we promise are "fires at +-- least once per session", and 'atomicModifyIORef'' gives us exactly +-- "fires exactly once per session" under any interleaving. +claimKey :: Text -> IO Bool +claimKey k = atomicModifyIORef' warnedKeys $ \s -> + if Set.member k s + then (s, False) + else (Set.insert k s, True) + +-- | Reset the dedupe set. Exported only for tests that drive multiple +-- simulated "sessions" inside a single 'hspec' process. Production code +-- should never call this. +resetDeprecationStateForTesting :: IO () +resetDeprecationStateForTesting = writeIORef warnedKeys Set.empty + +-- ============================================================================ +-- Line Formatting +-- ============================================================================ + +-- | Format the stderr line for a deprecated method invocation. The visible +-- shape is: +-- +-- @⚠ . is DEPRECATED since , removed in — @ +-- +-- The trailing DEPRECATED clause is delegated to 'formatDeprecationLine' +-- so the wording matches IR-6's tree rendering verbatim. +formatMethodWarningLine :: Text -> DeprecationInfo -> Text +formatMethodWarningLine fullPath di = + deprecationMarker + <> " " <> fullPath + <> " is " <> formatDeprecationLine di + +-- | Format the stderr line for an invocation on a deprecated activation. +-- Shape: +-- +-- @⚠ activation '' is DEPRECATED since , removed in — @ +-- +-- Uses 'formatDeprecationLine' for the DEPRECATED clause. +formatActivationWarningLine :: Text -> DeprecationInfo -> Text +formatActivationWarningLine namespace di = + deprecationMarker + <> " activation '" <> namespace <> "' is " + <> formatDeprecationLine di + +-- ============================================================================ +-- Emission +-- ============================================================================ + +-- | Emit a one-line stderr warning for a deprecated method invocation if +-- (a) warnings aren't globally suppressed, and (b) this method hasn't +-- already been warned about in the current session. +-- +-- No-ops silently when the method isn't deprecated, so call sites can +-- hand over the raw 'Maybe DeprecationInfo' without pre-checking. +emitMethodWarning + :: Bool -- ^ suppress all warnings (e.g. @--no-deprecation-warnings@) + -> Text -- ^ full dotted method path (e.g. @"docs.move_doc"@) + -> Maybe DeprecationInfo -- ^ deprecation metadata from IR / MethodSchema + -> IO () +emitMethodWarning _ _ Nothing = pure () +emitMethodWarning True _ _ = pure () +emitMethodWarning False fullPath (Just di) = do + first <- claimKey fullPath + when first $ do + TIO.hPutStrLn stderr (formatMethodWarningLine fullPath di) + hFlush stderr + +-- | Emit a one-line stderr warning for invoking any method on a deprecated +-- activation. Dedupe key is the activation namespace so subsequent +-- invocations on the same activation stay silent. +-- +-- No-ops when the activation isn't deprecated. +emitActivationWarning + :: Bool -- ^ suppress all warnings + -> Text -- ^ activation namespace (e.g. @"docs"@) + -> Maybe DeprecationInfo -- ^ deprecation metadata from the parent PluginSchema + -> IO () +emitActivationWarning _ _ Nothing = pure () +emitActivationWarning True _ _ = pure () +emitActivationWarning False namespace (Just di) = do + -- Guard against accidentally colliding with the method keyspace. + -- Method keys always contain at least one '.'; activation namespaces + -- may also, but the 'activation:' prefix keeps the two families + -- unambiguously separated regardless of dot count. + let key = "activation:" <> namespace + first <- claimKey key + when first $ do + TIO.hPutStrLn stderr (formatActivationWarningLine namespace di) + hFlush stderr diff --git a/src/Synapse/IR/Builder.hs b/src/Synapse/IR/Builder.hs --- a/src/Synapse/IR/Builder.hs +++ b/src/Synapse/IR/Builder.hs @@ -40,6 +40,7 @@ import Synapse.Monad import Synapse.IR.Types hiding (QualifiedName(..), qualifiedNameFull) import Synapse.IR.Types (QualifiedName(..), qualifiedNameFull, synapseVersion) +import Plexus.Schema.Recursive (DeprecationInfo, ParamSchema(..)) -- ============================================================================ -- Building IR @@ -267,6 +268,7 @@ , mdBidirType = fmap (updateTypeRef redirects) (mdBidirType md) , mdBidirResponseType = mdBidirResponseType md -- Preserve as-is , mdBidirResponseSchema = mdBidirResponseSchema md -- Preserve as-is + -- mdRole: left unchanged via record-update syntax } -- | Update type references in a parameter @@ -338,8 +340,12 @@ then namespace <> "." <> name else pathPrefix <> "." <> name - -- Extract types from params (namespace-qualified) - (paramTypes, params) = extractParams namespace (methodParams method) + -- Extract types from params (namespace-qualified). + -- Also pass methodParamSchemas so per-param deprecation info + -- (IR-14) flows from ParamSchema.paramDeprecation onto the IR + -- ParamDef.pdDeprecation. + (paramTypes, params) = + extractParams namespace (methodParams method) (methodParamSchemas method) -- Extract types from returns (namespace-qualified) (returnTypes, returnRef, streaming) = extractReturns namespace name (methodReturns method) @@ -377,6 +383,12 @@ , mdBidirType = bidirTypeRef , mdBidirResponseType = Nothing -- TODO: could extract from response_type title , mdBidirResponseSchema = bidirResponseSchema + , mdRole = methodRole method + -- IR-12: lift MethodSchema.role onto the IR so hub-codegen's + -- typed-handle codegen (IR-9) sees DynamicChild/StaticChild + -- tags. plexus-protocol defaults this to MethodRoleRpc when + -- the upstream schema omits the field, so pre-IR servers + -- continue to work with no change in behaviour. } in (allTypes, mdef) @@ -408,16 +420,30 @@ -- Parameter Extraction -- ============================================================================ --- | Extract types and param defs from method params schema --- Types are namespace-qualified to avoid collisions -extractParams :: Text -> Maybe Value -> (Map Text TypeDef, [ParamDef]) -extractParams _ Nothing = (Map.empty, []) -extractParams namespace (Just val) = case val of - Object o -> extractParamsFromObject namespace o +-- | Extract types and param defs from method params schema. +-- +-- The third argument carries optional per-parameter metadata +-- ('ParamSchema') emitted by IR-5 producers. When present, each entry's +-- 'paramDeprecation' is lifted onto the resulting 'ParamDef.pdDeprecation' +-- by matching parameter name. Absent entries (pre-IR-5 producers, or +-- non-deprecated params) leave 'pdDeprecation' as 'Nothing'. +-- Types are namespace-qualified to avoid collisions. +extractParams + :: Text + -> Maybe Value + -> Maybe [ParamSchema] + -> (Map Text TypeDef, [ParamDef]) +extractParams _ Nothing _ = (Map.empty, []) +extractParams namespace (Just val) paramSchemas = case val of + Object o -> extractParamsFromObject namespace o paramSchemas _ -> (Map.empty, []) -extractParamsFromObject :: Text -> KM.KeyMap Value -> (Map Text TypeDef, [ParamDef]) -extractParamsFromObject namespace o = +extractParamsFromObject + :: Text + -> KM.KeyMap Value + -> Maybe [ParamSchema] + -> (Map Text TypeDef, [ParamDef]) +extractParamsFromObject namespace o paramSchemas = let -- Extract $defs (namespace-qualified) defs = extractDefs namespace o @@ -431,6 +457,16 @@ Just (Array arr) -> [t | String t <- V.toList arr] _ -> [] + -- Look up per-parameter deprecation by name from the structured + -- ParamSchema list (IR-5). 'Nothing' when either the list is absent + -- or the named parameter isn't in it. + lookupDeprecation :: Text -> Maybe DeprecationInfo + lookupDeprecation pname = case paramSchemas of + Nothing -> Nothing + Just xs -> case filter ((== pname) . paramName) xs of + (ps:_) -> paramDeprecation ps + [] -> Nothing + -- Build param defs params = [ ParamDef @@ -439,6 +475,7 @@ , pdDescription = extractDescription v , pdRequired = K.toText k `elem` required , pdDefault = extractDefault v + , pdDeprecation = lookupDeprecation (K.toText k) } | (k, v) <- props ] diff --git a/src/Synapse/IR/Types.hs b/src/Synapse/IR/Types.hs --- a/src/Synapse/IR/Types.hs +++ b/src/Synapse/IR/Types.hs @@ -46,6 +46,7 @@ -- * Method Definitions , MethodDef(..) + , MethodRole(..) , ParamDef(..) -- * Type References @@ -67,6 +68,8 @@ import qualified Data.Text as T import GHC.Generics (Generic) +import Plexus.Schema.Recursive (DeprecationInfo(..), MethodRole(..)) + -- ============================================================================ -- Version Information -- ============================================================================ @@ -262,20 +265,91 @@ -- Cached from MethodSchema.response_type so synapse can include it -- in bidir_request output. Synapse controls whether to print this -- (e.g., first request, --bidir-schemas flag, etc.) + , mdRole :: MethodRole + -- ^ Structural role of this method in the activation graph + -- (IR-12). Mirrors 'Plexus.Schema.Recursive.MethodRole' / + -- 'plexus_core::MethodRole'. Defaults to 'MethodRoleRpc' when the + -- upstream schema omits @role@ (pre-IR servers). + -- + -- Consumed by hub-codegen (Rust field @md_role@, JSON key @mdRole@) + -- to emit typed-handle clients for @DynamicChild@ methods. } deriving stock (Show, Eq, Generic) - deriving anyclass (ToJSON, FromJSON) +-- | Manual JSON instances so @mdRole@ defaults to 'MethodRoleRpc' when +-- deserializing pre-IR-12 IR JSON (same back-compat posture as the +-- Rust @#[serde(default)]@ on @MethodDef.md_role@ in hub-codegen). +-- +-- All other fields preserve the generic derivation defaults (field +-- names used verbatim as JSON keys; @Maybe@ fields omitted when +-- @Nothing@ to match aeson's legacy behaviour). +instance ToJSON MethodDef where + toJSON MethodDef{..} = object + [ "mdName" .= mdName + , "mdFullPath" .= mdFullPath + , "mdNamespace" .= mdNamespace + , "mdDescription" .= mdDescription + , "mdStreaming" .= mdStreaming + , "mdParams" .= mdParams + , "mdReturns" .= mdReturns + , "mdBidirType" .= mdBidirType + , "mdBidirResponseType" .= mdBidirResponseType + , "mdBidirResponseSchema" .= mdBidirResponseSchema + , "mdRole" .= mdRole + ] + +instance FromJSON MethodDef where + parseJSON = withObject "MethodDef" $ \o -> MethodDef + <$> o .: "mdName" + <*> o .: "mdFullPath" + <*> o .: "mdNamespace" + <*> o .:? "mdDescription" + <*> o .: "mdStreaming" + <*> o .: "mdParams" + <*> o .: "mdReturns" + <*> o .:? "mdBidirType" + <*> o .:? "mdBidirResponseType" + <*> o .:? "mdBidirResponseSchema" + <*> o .:? "mdRole" .!= MethodRoleRpc + -- | A parameter definition data ParamDef = ParamDef - { pdName :: Text -- ^ Parameter name - , pdType :: TypeRef -- ^ Parameter type - , pdDescription :: Maybe Text -- ^ Documentation - , pdRequired :: Bool -- ^ Is this required? - , pdDefault :: Maybe Value -- ^ Default value if any + { pdName :: Text -- ^ Parameter name + , pdType :: TypeRef -- ^ Parameter type + , pdDescription :: Maybe Text -- ^ Documentation + , pdRequired :: Bool -- ^ Is this required? + , pdDefault :: Maybe Value -- ^ Default value if any + , pdDeprecation :: Maybe DeprecationInfo + -- ^ Per-parameter deprecation info (IR-14). + -- Populated from 'Plexus.Schema.Recursive.ParamSchema.paramDeprecation' + -- when the upstream schema advertises it (via @param_schemas@). + -- Defaults to 'Nothing' when the schema lacks @param_schemas@, so + -- pre-IR-5 producers and non-deprecated parameters are indistinguishable + -- at the rendering layer. } deriving stock (Show, Eq, Generic) - deriving anyclass (ToJSON, FromJSON) + +-- | Manual JSON instances so @pdDeprecation@ defaults to 'Nothing' when +-- deserializing IR JSON that predates IR-14. +-- All other fields preserve the derivation defaults. +instance ToJSON ParamDef where + toJSON ParamDef{..} = object + [ "pdName" .= pdName + , "pdType" .= pdType + , "pdDescription" .= pdDescription + , "pdRequired" .= pdRequired + , "pdDefault" .= pdDefault + , "pdDeprecation" .= pdDeprecation + ] + +instance FromJSON ParamDef where + parseJSON = withObject "ParamDef" $ \o -> ParamDef + <$> o .: "pdName" + <*> o .: "pdType" + <*> o .:? "pdDescription" + <*> o .: "pdRequired" + <*> o .:? "pdDefault" + <*> o .:? "pdDeprecation" -- ============================================================================ -- Type References diff --git a/test/BidirIntegrationSpec.hs b/test/BidirIntegrationSpec.hs --- a/test/BidirIntegrationSpec.hs +++ b/test/BidirIntegrationSpec.hs @@ -25,6 +25,8 @@ import Synapse.IR.Types import Synapse.IR.Builder (buildIR) import Synapse.Monad +import qualified Synapse.Log as Log +import qualified Katip main :: IO () main = do @@ -42,7 +44,8 @@ putStrLn $ "(backend: " <> T.unpack backend <> ")" -- Initialize environment - env <- initEnv "127.0.0.1" port backend + logger <- Log.makeLogger Katip.ErrorS + env <- initEnv "127.0.0.1" port backend logger Nothing -- Build IR once for all tests irResult <- runSynapseM env (buildIR [] []) diff --git a/test/DeprecationSpec.hs b/test/DeprecationSpec.hs new file mode 100644 --- /dev/null +++ b/test/DeprecationSpec.hs @@ -0,0 +1,450 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Unit tests for IR-6, IR-14 deprecation rendering, and IR-15 +-- invocation-time stderr deprecation warnings. +-- +-- IR-6: per-method and per-activation decoration in 'renderSchema'. +-- IR-14: per-parameter decoration in both 'renderMethodFull' (reads +-- 'methodParamSchemas' directly) and 'renderMethodHelpWith' +-- (reads 'ParamDef.pdDeprecation' after the IR builder has +-- lifted the info across). +-- IR-15: stderr warnings emitted at invocation time from +-- 'Synapse.Deprecation', reusing IR-6's 'deprecationMarker' and +-- 'formatDeprecationLine' for line wording. Per-session dedupe, +-- disjoint method/activation keyspaces, and the +-- @--no-deprecation-warnings@ suppression toggle. +module Main where + +import Control.Exception (finally) +import Data.Aeson (object, (.=), Value) +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import GHC.IO.Handle (hDuplicate, hDuplicateTo) +import System.Directory (getTemporaryDirectory, removeFile) +import System.IO (hClose, hFlush, openTempFile, stderr) +import Test.Hspec + +import Plexus.Schema.Recursive + ( DeprecationInfo(..) + , MethodRole(..) + , MethodSchema(..) + , ParamSchema(..) + , PluginSchema(..) + ) +import Synapse.Algebra.Render + ( deprecationMarker + , formatDeprecationLine + , renderMethodFull + , renderSchema + ) +import Synapse.CLI.Help (renderMethodHelp) +import Synapse.Deprecation + ( emitActivationWarning + , emitMethodWarning + , formatActivationWarningLine + , formatMethodWarningLine + , resetDeprecationStateForTesting + ) +import Synapse.IR.Builder (extractMethodDef) +import Synapse.IR.Types (IR(..), emptyIR) + +-- --------------------------------------------------------------------------- +-- Fixtures +-- --------------------------------------------------------------------------- + +baseMethod :: MethodSchema +baseMethod = MethodSchema + { methodName = "move_doc" + , methodDescription = "Relocate a document." + , methodHash = "hash-move-doc" + , methodParams = Nothing + , methodReturns = Nothing + , methodStreaming = False + , methodBidirectional = False + , methodRequestType = Nothing + , methodResponseType = Nothing + , methodDeprecation = Nothing + , methodParamSchemas = Nothing + , methodRole = MethodRoleRpc + } + +deprecatedMethod :: MethodSchema +deprecatedMethod = baseMethod + { methodDeprecation = Just DeprecationInfo + { depSince = "0.5" + , depRemovedIn = "0.7" + , depMessage = "use move_doc" + } + } + +plainMethod :: MethodSchema +plainMethod = baseMethod { methodName = "list_docs" } + +basePlugin :: PluginSchema +basePlugin = PluginSchema + { psNamespace = "docs" + , psVersion = "1.0" + , psDescription = "Document activation" + , psLongDescription = Nothing + , psHash = "hash-docs" + , psMethods = [deprecatedMethod, plainMethod] + , psChildren = Nothing + , psDeprecation = Nothing + } + +deprecatedPlugin :: PluginSchema +deprecatedPlugin = basePlugin + { psDeprecation = Just DeprecationInfo + { depSince = "0.4" + , depRemovedIn = "0.8" + , depMessage = "use docs_v2" + } + } + +-- --------------------------------------------------------------------------- +-- IR-14 Fixtures: param-level deprecation +-- --------------------------------------------------------------------------- + +-- | JSON Schema for a method with two parameters: 'path' (deprecated, the +-- one IR-14 decorates) and 'target' (not deprecated, the control). +-- +-- This matches the minimum shape 'renderParamsFull' / 'extractParams' +-- actually inspect: an object with @properties@ and @required@. +paramsSchemaJSON :: Value +paramsSchemaJSON = object + [ "type" .= ("object" :: T.Text) + , "properties" .= object + [ "path" .= object + [ "type" .= ("string" :: T.Text) + , "description" .= ("Old document path (deprecated)." :: T.Text) + ] + , "target" .= object + [ "type" .= ("string" :: T.Text) + , "description" .= ("Destination identifier." :: T.Text) + ] + ] + , "required" .= (["path", "target"] :: [T.Text]) + ] + +-- | ParamSchema list carrying the per-param deprecation info for 'path' +-- and leaving 'target' clean. This is the IR-5 wire-level payload. +paramSchemas :: [ParamSchema] +paramSchemas = + [ ParamSchema + { paramName = "path" + , paramDescription = Just "Old document path (deprecated)." + , paramRequired = True + , paramDeprecation = Just DeprecationInfo + { depSince = "0.5" + , depRemovedIn = "0.7" + , depMessage = "use target" + } + } + , ParamSchema + { paramName = "target" + , paramDescription = Just "Destination identifier." + , paramRequired = True + , paramDeprecation = Nothing + } + ] + +-- | Method with a deprecated parameter. Used to drive both +-- 'renderMethodFull' (Render.hs) and 'renderMethodHelp' (Help.hs). +methodWithDeprecatedParam :: MethodSchema +methodWithDeprecatedParam = baseMethod + { methodName = "relocate" + , methodDescription = "Relocate a document." + , methodHash = "hash-relocate" + , methodParams = Just paramsSchemaJSON + , methodParamSchemas = Just paramSchemas + } + +-- | Build a minimal IR containing just this method, so we can exercise +-- 'renderMethodHelp' which consumes the IR 'MethodDef' (where +-- 'pdDeprecation' lives, lifted there by 'extractMethodDef'). +helpFixture :: (IR, T.Text) +helpFixture = + let (_types, mdef) = extractMethodDef "docs" "docs" methodWithDeprecatedParam + fullPath = "docs.relocate" + ir = emptyIR { irMethods = Map.singleton fullPath mdef } + in (ir, renderMethodHelp ir mdef) + +-- --------------------------------------------------------------------------- +-- IR-15 Fixtures: invocation-time deprecation warnings +-- --------------------------------------------------------------------------- + +-- | Method-level deprecation info used by IR-15 invocation tests. +-- Shaped identically to the IR-6 fixture so both the marker and the +-- 'formatDeprecationLine' byte sequence line up verbatim, which is +-- the whole point of IR-15 reusing those helpers. +methodDep :: DeprecationInfo +methodDep = DeprecationInfo + { depSince = "0.5" + , depRemovedIn = "0.7" + , depMessage = "use move_doc" + } + +-- | Activation-level deprecation info. Distinct @since@ from 'methodDep' +-- so tests that emit both can tell them apart in captured stderr. +activationDep :: DeprecationInfo +activationDep = DeprecationInfo + { depSince = "0.4" + , depRemovedIn = "0.8" + , depMessage = "use docs_v2" + } + +-- --------------------------------------------------------------------------- +-- IR-15 Helpers: stderr capture +-- --------------------------------------------------------------------------- + +-- | Run an action with 'stderr' swapped for a fresh temporary file; +-- return the captured text alongside the action's result. +-- +-- The swap uses 'hDuplicate' / 'hDuplicateTo' so 'System.IO.stderr' +-- itself (the global handle 'Data.Text.IO.hPutStrLn' writes to inside +-- 'Synapse.Deprecation') is redirected — not just a local 'Handle'. +-- Using 'finally' for cleanup keeps the tempfile path removed even if +-- a test assertion throws. +captureStderr :: IO a -> IO (a, T.Text) +captureStderr action = do + tmpDir <- getTemporaryDirectory + (path, h) <- openTempFile tmpDir "synapse-deprecation-stderr.txt" + (do + originalStderr <- hDuplicate stderr + hDuplicateTo h stderr + hClose h + result <- action + hFlush stderr + hDuplicateTo originalStderr stderr + hClose originalStderr + captured <- TIO.readFile path + pure (result, captured)) + `finally` removeFile path + +-- | Count occurrences of a substring. Distinguishes "fires once" from +-- "fires twice" in dedupe tests. +countOccurrences :: T.Text -> T.Text -> Int +countOccurrences needle haystack + | T.null needle = 0 + | otherwise = length (T.breakOnAll needle haystack) + +main :: IO () +main = hspec $ do + describe "renderSchema (IR-6 method-level deprecation)" $ do + it "prepends the warning marker to deprecated method names" $ do + let rendered = renderSchema basePlugin + rendered `shouldSatisfy` T.isInfixOf deprecationMarker + + it "emits the full DEPRECATED detail line for deprecated methods" $ do + let rendered = renderSchema basePlugin + rendered `shouldSatisfy` T.isInfixOf "DEPRECATED since 0.5" + rendered `shouldSatisfy` T.isInfixOf "removed in 0.7" + rendered `shouldSatisfy` T.isInfixOf "use move_doc" + + it "leaves non-deprecated methods unchanged (no marker on their name line)" $ do + let rendered = renderSchema basePlugin + ls = T.lines rendered + -- Lines containing list_docs must NOT contain the marker. + listDocLines = filter (T.isInfixOf "list_docs") ls + all (not . T.isInfixOf deprecationMarker) listDocLines + `shouldBe` True + + it "emits no deprecation markers for plugins whose methods all lack deprecation" $ do + let cleanPlugin = basePlugin { psMethods = [plainMethod] } + rendered = renderSchema cleanPlugin + rendered `shouldSatisfy` (not . T.isInfixOf deprecationMarker) + rendered `shouldSatisfy` (not . T.isInfixOf "DEPRECATED") + + describe "renderSchema (IR-6 activation-level deprecation)" $ do + it "renders a warning marker on the activation heading" $ do + let rendered = renderSchema deprecatedPlugin + ls = T.lines rendered + -- Some early line must contain both the namespace and the marker. + decoratedHeading = + any (\l -> T.isInfixOf "docs" l && T.isInfixOf deprecationMarker l) + (take 3 ls) + decoratedHeading `shouldBe` True + + it "includes the activation-level deprecation detail string" $ do + let rendered = renderSchema deprecatedPlugin + rendered `shouldSatisfy` T.isInfixOf "DEPRECATED since 0.4" + rendered `shouldSatisfy` T.isInfixOf "removed in 0.8" + rendered `shouldSatisfy` T.isInfixOf "use docs_v2" + + it "keeps activation rendering unchanged when psDeprecation is Nothing" $ do + let rendered = renderSchema (basePlugin { psMethods = [plainMethod] }) + rendered `shouldSatisfy` (not . T.isInfixOf "use docs_v2") + + describe "renderMethodFull (IR-14 per-parameter deprecation in Render.hs)" $ do + it "prepends the warning marker on the deprecated parameter's flag line" $ do + let rendered = renderMethodFull methodWithDeprecatedParam + ls = T.lines rendered + -- Line that mentions --path must carry the marker. + pathLines = filter (T.isInfixOf "--path") ls + pathLines `shouldSatisfy` (not . null) + all (T.isInfixOf deprecationMarker) pathLines `shouldBe` True + + it "emits the DEPRECATED detail line for the deprecated parameter" $ do + let rendered = renderMethodFull methodWithDeprecatedParam + rendered `shouldSatisfy` T.isInfixOf "DEPRECATED since 0.5" + rendered `shouldSatisfy` T.isInfixOf "removed in 0.7" + rendered `shouldSatisfy` T.isInfixOf "use target" + + it "leaves non-deprecated sibling parameter undecorated" $ do + let rendered = renderMethodFull methodWithDeprecatedParam + ls = T.lines rendered + -- Lines mentioning --target must NOT carry the marker. We also + -- filter out lines that happen to contain 'use target' (the + -- deprecation detail line for --path), since that substring + -- would false-match. + targetLines = + [ l | l <- ls + , T.isInfixOf "--target" l + , not (T.isInfixOf "use target" l) + ] + targetLines `shouldSatisfy` (not . null) + all (not . T.isInfixOf deprecationMarker) targetLines `shouldBe` True + + describe "renderMethodHelp (IR-14 per-parameter deprecation in Help.hs)" $ do + it "prepends the warning marker on the deprecated parameter's flag line" $ do + let (_, rendered) = helpFixture + ls = T.lines rendered + pathLines = filter (T.isInfixOf "--path") ls + pathLines `shouldSatisfy` (not . null) + all (T.isInfixOf deprecationMarker) pathLines `shouldBe` True + + it "emits the DEPRECATED detail line for the deprecated parameter" $ do + let (_, rendered) = helpFixture + rendered `shouldSatisfy` T.isInfixOf "DEPRECATED since 0.5" + rendered `shouldSatisfy` T.isInfixOf "removed in 0.7" + rendered `shouldSatisfy` T.isInfixOf "use target" + + it "leaves non-deprecated sibling parameter undecorated" $ do + let (_, rendered) = helpFixture + ls = T.lines rendered + targetLines = + [ l | l <- ls + , T.isInfixOf "--target" l + , not (T.isInfixOf "use target" l) + ] + targetLines `shouldSatisfy` (not . null) + all (not . T.isInfixOf deprecationMarker) targetLines `shouldBe` True + + -- ========================================================================= + -- IR-15: invocation-time stderr deprecation warnings + -- ========================================================================= + + describe "formatMethodWarningLine / formatActivationWarningLine (IR-15 reuses IR-6 helpers)" $ do + it "method line carries the IR-6 deprecationMarker and the IR-6 formatDeprecationLine verbatim" $ do + let line = formatMethodWarningLine "docs.move_doc" methodDep + line `shouldSatisfy` T.isInfixOf deprecationMarker + line `shouldSatisfy` T.isInfixOf "docs.move_doc" + line `shouldSatisfy` T.isInfixOf (formatDeprecationLine methodDep) + + it "method line matches the ticket-spec shape for since / removed_in / message" $ do + let line = formatMethodWarningLine "docs.move_doc" methodDep + line `shouldSatisfy` T.isInfixOf "DEPRECATED since 0.5" + line `shouldSatisfy` T.isInfixOf "removed in 0.7" + line `shouldSatisfy` T.isInfixOf "use move_doc" + + it "activation line names the namespace and embeds the IR-6 DEPRECATED clause" $ do + let line = formatActivationWarningLine "docs" activationDep + line `shouldSatisfy` T.isInfixOf deprecationMarker + line `shouldSatisfy` T.isInfixOf "'docs'" + line `shouldSatisfy` T.isInfixOf (formatDeprecationLine activationDep) + + it "activation line mentions 'activation' so consumers can grep it apart from method lines" $ do + let line = formatActivationWarningLine "docs" activationDep + line `shouldSatisfy` T.isInfixOf "activation" + + -- Every IR-15 emission test resets the global dedupe IORef in a + -- 'before_' hook so IORef leakage across tests is impossible. + before_ resetDeprecationStateForTesting $ do + describe "emitMethodWarning (IR-15 method-level invocation warning)" $ do + it "(AC 2 / a) fires on the first invocation of a deprecated method" $ do + ((), captured) <- captureStderr $ + emitMethodWarning False "docs.move_doc" (Just methodDep) + captured `shouldSatisfy` T.isInfixOf "docs.move_doc" + captured `shouldSatisfy` T.isInfixOf "DEPRECATED since 0.5" + + it "(AC 3 / b) suppresses on the second invocation of the same method in the same session" $ do + ((), captured) <- captureStderr $ do + emitMethodWarning False "docs.move_doc" (Just methodDep) + emitMethodWarning False "docs.move_doc" (Just methodDep) + emitMethodWarning False "docs.move_doc" (Just methodDep) + countOccurrences "DEPRECATED since 0.5" captured `shouldBe` 1 + + it "fires once for each distinct deprecated method (dedupe is per full-path key)" $ do + ((), captured) <- captureStderr $ do + emitMethodWarning False "docs.move_doc" (Just methodDep) + emitMethodWarning False "docs.retire_doc" + (Just methodDep { depMessage = "use retire_doc_v2" }) + captured `shouldSatisfy` T.isInfixOf "docs.move_doc" + captured `shouldSatisfy` T.isInfixOf "docs.retire_doc" + + it "stays silent when the method is not deprecated" $ do + ((), captured) <- captureStderr $ + emitMethodWarning False "docs.list" Nothing + captured `shouldBe` "" + + describe "emitActivationWarning (IR-15 activation-level invocation warning)" $ do + it "(AC 4 / c) fires once per session on a deprecated activation, across multiple invocations" $ do + ((), captured) <- captureStderr $ do + -- Simulate three calls to *different methods* on the same + -- deprecated activation. The per-session dedupe must collapse + -- these to a single line. + emitActivationWarning False "docs" (Just activationDep) + emitActivationWarning False "docs" (Just activationDep) + emitActivationWarning False "docs" (Just activationDep) + countOccurrences "activation" captured `shouldBe` 1 + countOccurrences "'docs'" captured `shouldBe` 1 + + it "keeps method and activation keyspaces disjoint (same string key does not collide)" $ do + -- An activation called @docs@ and a method whose full path is + -- literally @docs@ must dedupe independently: firing one must + -- not silence the other. + ((), captured) <- captureStderr $ do + emitActivationWarning False "docs" (Just activationDep) + emitMethodWarning False "docs" (Just methodDep) + countOccurrences "activation" captured `shouldBe` 1 + countOccurrences "DEPRECATED since 0.5" captured `shouldBe` 1 -- method + countOccurrences "DEPRECATED since 0.4" captured `shouldBe` 1 -- activation + + it "stays silent when the activation is not deprecated" $ do + ((), captured) <- captureStderr $ + emitActivationWarning False "docs" Nothing + captured `shouldBe` "" + + describe "--no-deprecation-warnings suppression (IR-15 (AC 5 / d))" $ do + it "suppresses method-level warning when flag is on" $ do + ((), captured) <- captureStderr $ + emitMethodWarning True "docs.move_doc" (Just methodDep) + captured `shouldBe` "" + + it "suppresses activation-level warning when flag is on" $ do + ((), captured) <- captureStderr $ + emitActivationWarning True "docs" (Just activationDep) + captured `shouldBe` "" + + it "a suppressed call does NOT claim the dedupe key (next unsuppressed call still fires)" $ do + -- Behavioural contract: toggling the flag on must not poison + -- the dedupe set for future unsuppressed calls. If it did, + -- scripts that toggle the flag between calls would silently + -- hide real warnings. + ((), captured) <- captureStderr $ do + emitMethodWarning True "docs.move_doc" (Just methodDep) -- suppressed + emitMethodWarning False "docs.move_doc" (Just methodDep) -- should fire + countOccurrences "DEPRECATED since 0.5" captured `shouldBe` 1 + + describe "(AC 6 / e) exit codes are not the concern of the emission layer" $ do + -- The emission functions return (), so they cannot alter exit codes + -- by construction. This is asserted here as a contract rather than + -- a runtime check. The end-to-end exit-code guarantee belongs to + -- the CLI integration suite (driven against a live backend). + it "emitMethodWarning returns unit (:: IO ())" $ + let _ = emitMethodWarning :: Bool -> T.Text -> Maybe DeprecationInfo -> IO () + in True `shouldBe` True + it "emitActivationWarning returns unit (:: IO ())" $ + let _ = emitActivationWarning :: Bool -> T.Text -> Maybe DeprecationInfo -> IO () + in True `shouldBe` True diff --git a/test/IR12MethodRoleSpec.hs b/test/IR12MethodRoleSpec.hs new file mode 100644 --- /dev/null +++ b/test/IR12MethodRoleSpec.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | IR-12 regression tests: 'MethodRole' round-trips through the +-- Plexus RPC wire format and into synapse's IR output. +-- +-- Acceptance criteria covered: +-- +-- * A JSON @MethodSchema@ with +-- @role: {"kind": "dynamic_child", "list_method": "planet_names", +-- "search_method": null}@ decodes to 'MethodRoleDynamicChild' with +-- the matching fields. +-- +-- * A pre-IR @MethodSchema@ (no @role@ key) decodes to +-- 'MethodRoleRpc' — the wire-level back-compat guarantee for +-- pre-IR servers. +-- +-- * A synthesised 'MethodDef' whose 'mdRole' is 'MethodRoleDynamicChild' +-- round-trips through JSON and emits the exact @kind@/@list_method@ +-- shape consumed by hub-codegen (whose Rust @MethodRole@ enum uses +-- @#[serde(tag = \"kind\", rename_all = \"snake_case\")]@). +module Main where + +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson (Value(..), (.=), eitherDecode, encode, object) +import Test.Hspec + +import Plexus.Schema.Recursive + ( MethodRole(..) + , MethodSchema(..) + ) + +import Synapse.IR.Types + ( MethodDef(..) + , TypeRef(..) + ) + +-- | Baseline 'MethodDef' used by the round-trip tests. +baseMethodDef :: MethodDef +baseMethodDef = MethodDef + { mdName = "planet" + , mdFullPath = "solar.planet" + , mdNamespace = "solar" + , mdDescription = Just "Fetch a planet child by name." + , mdStreaming = False + , mdParams = [] + , mdReturns = RefAny + , mdBidirType = Nothing + , mdBidirResponseType = Nothing + , mdBidirResponseSchema = Nothing + , mdRole = MethodRoleRpc + } + +-- | Build a JSON @MethodSchema@ with an optional @role@ key. Passing +-- 'Nothing' produces the pre-IR shape (no @role@ key at all). +methodSchemaJson :: Maybe Value -> Value +methodSchemaJson mRole = + let base = + [ "name" .= ("planet" :: String) + , "description" .= ("Fetch a planet child by name." :: String) + , "hash" .= ("h-planet" :: String) + ] + in object $ case mRole of + Nothing -> base + Just role -> ("role" .= role) : base + +-- | A hand-written pre-IR-12 MethodDef JSON blob: same field names as +-- the generic derivation produces, minus @mdRole@. Exercising the +-- back-compat path of synapse's manual @FromJSON MethodDef@ instance. +preIrMethodDefJson :: Value +preIrMethodDefJson = object + [ "mdName" .= ("planet" :: String) + , "mdFullPath" .= ("solar.planet" :: String) + , "mdNamespace" .= ("solar" :: String) + , "mdDescription" .= Aeson.Null + , "mdStreaming" .= False + , "mdParams" .= ([] :: [Value]) + , "mdReturns" .= object [ "tag" .= ("RefAny" :: String) ] + ] + +main :: IO () +main = hspec $ do + describe "IR-12: MethodRole wire round-trip via MethodSchema" $ do + it "decodes DynamicChild with list_method and a null search_method" $ do + let j = methodSchemaJson $ Just $ object + [ "kind" .= ("dynamic_child" :: String) + , "list_method" .= ("planet_names" :: String) + , "search_method" .= Aeson.Null + ] + case Aeson.fromJSON j :: Aeson.Result MethodSchema of + Aeson.Error e -> expectationFailure $ "decode failed: " <> e + Aeson.Success ms -> + methodRole ms `shouldBe` + MethodRoleDynamicChild + { listMethod = Just "planet_names" + , searchMethod = Nothing + } + + it "decodes StaticChild" $ do + let j = methodSchemaJson $ Just $ object + [ "kind" .= ("static_child" :: String) ] + case Aeson.fromJSON j :: Aeson.Result MethodSchema of + Aeson.Error e -> expectationFailure $ "decode failed: " <> e + Aeson.Success ms -> methodRole ms `shouldBe` MethodRoleStaticChild + + it "decodes explicit Rpc variant" $ do + let j = methodSchemaJson $ Just $ object [ "kind" .= ("rpc" :: String) ] + case Aeson.fromJSON j :: Aeson.Result MethodSchema of + Aeson.Error e -> expectationFailure $ "decode failed: " <> e + Aeson.Success ms -> methodRole ms `shouldBe` MethodRoleRpc + + it "defaults to Rpc when role is absent (pre-IR wire shape)" $ do + case Aeson.fromJSON (methodSchemaJson Nothing) :: Aeson.Result MethodSchema of + Aeson.Error e -> expectationFailure $ "decode failed: " <> e + Aeson.Success ms -> methodRole ms `shouldBe` MethodRoleRpc + + it "serialises DynamicChild back to the exact Rust-compatible tag shape" $ do + let role = MethodRoleDynamicChild + { listMethod = Just "planet_names" + , searchMethod = Nothing + } + encoded = Aeson.toJSON role + case encoded of + Object o -> do + KM.lookup "kind" o + `shouldBe` Just (String "dynamic_child") + KM.lookup "list_method" o + `shouldBe` Just (String "planet_names") + -- Matches the Rust #[serde(skip_serializing_if = "Option::is_none")] + -- behaviour on search_method, so the encoded object never + -- carries an explicit null for the absent field. + KM.lookup "search_method" o `shouldBe` Nothing + _ -> expectationFailure $ + "expected JSON Object, got: " <> show encoded + + describe "IR-12: MethodDef mdRole is emitted in synapse's IR JSON" $ do + it "includes mdRole in the serialised IR method" $ do + let md = baseMethodDef + { mdRole = MethodRoleDynamicChild + { listMethod = Just "planet_names" + , searchMethod = Nothing + } + } + encoded = Aeson.toJSON md + case encoded of + Object o -> + KM.lookup "mdRole" o `shouldBe` Just + (object + [ "kind" .= ("dynamic_child" :: String) + , "list_method" .= ("planet_names" :: String) + ]) + _ -> expectationFailure $ + "expected JSON Object, got: " <> show encoded + + it "round-trips DynamicChild through encode >>> decode" $ do + let original = baseMethodDef + { mdRole = MethodRoleDynamicChild + { listMethod = Just "planet_names" + , searchMethod = Just "search_planets" + } + } + case eitherDecode (encode original) :: Either String MethodDef of + Left e -> expectationFailure $ "decode failed: " <> e + Right md -> mdRole md `shouldBe` mdRole original + + it "pre-IR-12 MethodDef JSON (no mdRole) decodes with default Rpc" $ do + -- Matches hub-codegen's Rust-side #[serde(default)] posture. + case eitherDecode (encode preIrMethodDefJson) :: Either String MethodDef of + Left e -> expectationFailure $ "decode failed: " <> e + Right md -> mdRole md `shouldBe` MethodRoleRpc diff --git a/test/IRSpec.hs b/test/IRSpec.hs --- a/test/IRSpec.hs +++ b/test/IRSpec.hs @@ -38,6 +38,8 @@ import Synapse.CLI.Support (SupportLevel(..), methodSupport) import Synapse.Monad import Synapse.Backend.Discovery (Backend(..), BackendDiscovery(..), registryDiscovery) +import qualified Synapse.Log as Log +import qualified Katip main :: IO () main = do @@ -45,7 +47,8 @@ (backend, host, port) <- resolveBackend args putStrLn $ "Running IR integration tests against " <> T.unpack host <> ":" <> show port <> " (backend: " <> T.unpack backend <> ")" - env <- initEnv host port backend + logger <- Log.makeLogger Katip.ErrorS + env <- initEnv host port backend logger Nothing -- Build IR once for all tests irResult <- runSynapseM env (buildIR [] []) diff --git a/test/ParseSpec.hs b/test/ParseSpec.hs --- a/test/ParseSpec.hs +++ b/test/ParseSpec.hs @@ -48,6 +48,7 @@ , pdDescription = Nothing , pdRequired = True , pdDefault = Nothing + , pdDeprecation = Nothing } let kvs = [("", "backend"), ("", "critical"), ("", "urgent")] let expected = Right $ Array $ V.fromList [String "backend", String "critical", String "urgent"] @@ -60,6 +61,7 @@ , pdDescription = Nothing , pdRequired = True , pdDefault = Nothing + , pdDeprecation = Nothing } let kvs = [("", "1"), ("", "2"), ("", "3")] let expected = Right $ Array $ V.fromList [Number 1, Number 2, Number 3] @@ -72,6 +74,7 @@ , pdDescription = Nothing , pdRequired = True , pdDefault = Nothing + , pdDeprecation = Nothing } let kvs = [] buildParamValue emptyIR param kvs `shouldSatisfy` isLeft