diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for pms-infra-watch +## 0.0.6.0 -- 2026-07-05 + +* Reduced unnecessary output to stderr. + ## 0.0.5.0 -- 2025-07-20 * Added proc tool. diff --git a/pms-infra-watch.cabal b/pms-infra-watch.cabal --- a/pms-infra-watch.cabal +++ b/pms-infra-watch.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.5.0 +version: 0.0.6.0 -- A short (one-line) description of the package. synopsis: pms-infra-watch @@ -130,8 +130,11 @@ stm, monad-logger, async, - unix, lens, + directory, + filepath, + temporary, + bytestring, pms-domain-model, pms-infra-watch diff --git a/src/PMS/Infra/Watch/DM/Type.hs b/src/PMS/Infra/Watch/DM/Type.hs --- a/src/PMS/Infra/Watch/DM/Type.hs +++ b/src/PMS/Infra/Watch/DM/Type.hs @@ -8,6 +8,7 @@ import Control.Lens import Data.Default import Data.Aeson.TH +import System.IO (hPutStrLn, stderr) import qualified System.FSNotify as F import qualified Control.Concurrent.STM as STM @@ -23,7 +24,14 @@ defaultAppData :: IO AppData defaultAppData = do - mgr <- F.startManagerConf F.defaultConfig + -- Redirect fsnotify handler exceptions to stderr to prevent stdout corruption + -- of the MCP JSON-RPC stream. The default confOnHandlerException uses putStrLn + -- which writes to stdout. + let cfg = F.defaultConfig + { F.confOnHandlerException = \e -> + hPutStrLn stderr ("fsnotify: handler threw exception: " <> show e) + } + mgr <- F.startManagerConf cfg mgrVar <- STM.newTMVarIO mgr return AppData { _watchManagerAppData = mgrVar diff --git a/src/PMS/Infra/Watch/DS/Core.hs b/src/PMS/Infra/Watch/DS/Core.hs --- a/src/PMS/Infra/Watch/DS/Core.hs +++ b/src/PMS/Infra/Watch/DS/Core.hs @@ -19,8 +19,7 @@ import System.FilePath import qualified Control.Exception.Safe as E import qualified System.FSNotify as S -import qualified Data.Text.IO as T -import qualified Data.Text.Encoding as TE + import qualified Data.ByteString.Lazy as BL @@ -170,9 +169,7 @@ onToolsListUpdated e = hPutStrLn stderr $ "[INFO] PMS.Infra.Watch.DS.Core.toolsListWatchTask ignore event: " ++ show e readToolsList :: FilePath -> IO BL.ByteString - readToolsList path = do - cont <- T.readFile path - return $ BL.fromStrict $ TE.encodeUtf8 cont + readToolsList = BL.readFile response :: String -> IO () response toolFile = do @@ -231,9 +228,7 @@ onPromptsListUpdated e = hPutStrLn stderr $ "[INFO] PMS.Infra.Watch.DS.Core.promptsListWatchTask ignore event: " ++ show e readPromptsList :: FilePath -> IO BL.ByteString - readPromptsList path = do - cont <- T.readFile path - return $ BL.fromStrict $ TE.encodeUtf8 cont + readPromptsList = BL.readFile response :: String -> IO () response updateFile = do @@ -295,9 +290,7 @@ onResourcesListUpdated e = hPutStrLn stderr $ "[INFO] PMS.Infra.Watch.DS.Core.resourcesListWatchTask ignore event: " ++ show e readResourcesList :: FilePath -> IO BL.ByteString - readResourcesList path = do - cont <- T.readFile path - return $ BL.fromStrict $ TE.encodeUtf8 cont + readResourcesList = BL.readFile response :: String -> IO () response updateFile = do diff --git a/test/PMS/Infra/Watch/App/ControlSpec.hs b/test/PMS/Infra/Watch/App/ControlSpec.hs --- a/test/PMS/Infra/Watch/App/ControlSpec.hs +++ b/test/PMS/Infra/Watch/App/ControlSpec.hs @@ -1,13 +1,23 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module PMS.Infra.Watch.App.ControlSpec (spec) where import Test.Hspec +import Control.Concurrent (threadDelay) import Control.Concurrent.Async +import Control.Exception (finally) import qualified Control.Concurrent.STM as STM import Control.Lens import Data.Default +import Data.List (isPrefixOf) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (()) +import System.IO +import GHC.IO.Handle (hDuplicate, hDuplicateTo) +import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) +import qualified Data.ByteString.Lazy as BL import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Infra.Watch.App.Control as SUT @@ -36,9 +46,9 @@ spec :: Spec spec = do runIO $ putStrLn "Start Spec." - beforeAll setUpOnce $ - afterAll tearDownOnce . - beforeWith setUp . + beforeAll setUpOnce $ + afterAll tearDownOnce . + beforeWith setUp . after tearDown $ run -- | @@ -59,7 +69,6 @@ setUp :: SpecContext -> IO SpecContext setUp ctx = do putStrLn "[INFO] EXECUTED BEFORE EACH TEST STARTS." - domDat <- DM.defaultDomainData appDat <- SUT.defaultAppData return ctx { @@ -78,18 +87,19 @@ run :: SpecWith SpecContext run = do describe "runWithAppData" $ do + context "when echo command issued." $ do - it "should call callback" $ \ctx -> do + it "should call callback" $ \ctx -> do putStrLn "[INFO] EXECUTING THE FIRST TEST." let domDat = ctx^.domainDataSpecContext appDat = ctx^.appDataSpecContext cmdQ = domDat^.DM.watchQueueDomainData - notiQ = domDat^.DM.notificationQueueDomainData + notiQ = domDat^.DM.notificationQueueDomainData expect = "abc" argDat = DM.EchoWatchCommandData def expect args = DM.EchoWatchCommand argDat - + thId <- async $ SUT.runWithAppData appDat domDat STM.atomically $ STM.writeTQueue cmdQ args @@ -100,3 +110,182 @@ actual `shouldBe` expect cancel thId + + -- TC-CR01: Verify that fsnotify internal log messages do NOT leak to stdout + -- when a PromptsListWatchCommand is issued. + -- On Windows, F.defaultConfig causes the WatchManager to write "fsnotify: h..." + -- to stdout, which corrupts the MCP JSON-RPC stream. + -- This test reproduces the defect and serves as a regression guard after the fix. + context "when PromptsListWatchCommand issued." $ do + it "should NOT leak fsnotify log messages to stdout" $ \ctx -> + withSystemTempDirectory "pms-watch-spec" $ \tmpDir -> do + putStrLn "[INFO] EXECUTING TC-CR01: fsnotify stdout leak test." + + -- Prepare a temporary prompts directory with an empty prompts-list.json + let promptsDir = tmpDir "prompts" + promptsListFile = promptsDir "prompts-list.json" + + createDirectoryIfMissing True promptsDir + writeFile promptsListFile "[]" + + -- Override promptsDir in DomainData to point at the temp directory + let domDat0 = ctx^.domainDataSpecContext + domDat = domDat0 { DM._promptsDirDomainData = promptsDir } + appDat = ctx^.appDataSpecContext + cmdQ = domDat^.DM.watchQueueDomainData + + -- Redirect stdout to a temp file and capture any fsnotify leakage + capturedLines <- withCapturedStdout $ do + + thId <- async $ SUT.runWithAppData appDat domDat + + -- Issue PromptsListWatchCommand to trigger watchTree startup + let argDat = DM.PromptsListWatchCommandData {} + args = DM.PromptsListWatchCommand argDat + STM.atomically $ STM.writeTQueue cmdQ args + + -- Wait for watchTree to start and for fsnotify internals to settle + threadDelay (2 * 1000 * 1000) + + cancel thId + + hPutStrLn stderr $ "[INFO] TC-CR01: captured stdout lines: " ++ show capturedLines + + -- Assert that no "fsnotify:" prefixed lines appeared on stdout + let leaked = filter ("fsnotify:" `isPrefixOf`) capturedLines + leaked `shouldBe` [] + + -- TC-CR05-01: Verify that notifications/tools/list_changed is successfully delivered + -- when tools-list.json (UTF-8) is updated by ToolsListWatchCommand. + -- BL.readFile prevents systemLocale decode exceptions from being thrown. + context "when ToolsListWatchCommand issued and tools-list.json updated." $ do + it "should deliver McpToolsListChangedNotification (TC-CR05-01)" $ \ctx -> + tcCR05Tools ctx + + -- TC-CR05-02: Verify that notifications/prompts/list_changed is successfully delivered + -- when prompts-list.json (UTF-8) is updated by PromptsListWatchCommand. + context "when PromptsListWatchCommand issued and prompts-list.json updated." $ do + it "should deliver McpPromptsListChangedNotification (TC-CR05-02)" $ \ctx -> + tcCR05Prompts ctx + + +-- | +-- Redirect stdout to a temporary file for the duration of the action, +-- then return the captured output as a list of lines. +withCapturedStdout :: IO () -> IO [String] +withCapturedStdout action = + withSystemTempFile "captured-stdout" $ \tmpPath tmpHandle -> do + -- Save the original stdout handle + origStdout <- hDuplicate stdout + -- Redirect stdout to the temp file + hDuplicateTo tmpHandle stdout + hSetBuffering stdout LineBuffering + + -- Run the action, then restore stdout + action `finally` do + hFlush stdout + hDuplicateTo origStdout stdout + hClose origStdout + hClose tmpHandle + + -- Read back the captured content + content <- readFile tmpPath + return (lines content) + + +-- | +-- TC-CR05-01: Verify that notifications/tools/list_changed is successfully delivered +-- when tools-list.json (UTF-8) is updated by ToolsListWatchCommand. +-- Also verify that no fsnotify handler exceptions are output as noise (adopting BL.readFile +-- prevents systemLocale decode exceptions from being thrown). +tcCR05Tools :: SpecContext -> IO () +tcCR05Tools ctx = + withSystemTempDirectory "pms-watch-cr05-tools" $ \tmpDir -> do + putStrLn "[INFO] EXECUTING TC-CR05-01: toolsList UTF-8 read test." + + -- Prepare temp tools directory with a minimal tools-list.json (UTF-8) + let toolsDir = tmpDir "tools" + toolsListFile = toolsDir "tools-list.json" + toolsContent = "[{\"name\":\"pms_echo\",\"description\":\"echo\",\"inputSchema\":{\"type\":\"object\"}}]" + + createDirectoryIfMissing True toolsDir + BL.writeFile toolsListFile (BL.pack (map (fromIntegral . fromEnum) toolsContent)) + + let domDat0 = ctx^.domainDataSpecContext + domDat = domDat0 { DM._toolsDirDomainData = toolsDir } + appDat = ctx^.appDataSpecContext + cmdQ = domDat^.DM.watchQueueDomainData + notiQ = domDat^.DM.notificationQueueDomainData + + thId <- async $ SUT.runWithAppData appDat domDat + + -- Issue ToolsListWatchCommand to register watchTree + let argDat = DM.ToolsListWatchCommandData {} + args = DM.ToolsListWatchCommand argDat + STM.atomically $ STM.writeTQueue cmdQ args + + -- Wait for watchTree to start + threadDelay (1 * 1000 * 1000) + + -- Overwrite tools-list.json to trigger the file-change event + let toolsContent2 = "[{\"name\":\"pms_echo2\",\"description\":\"echo2\",\"inputSchema\":{\"type\":\"object\"}}]" + BL.writeFile toolsListFile (BL.pack (map (fromIntegral . fromEnum) toolsContent2)) + + -- Wait for fsnotify event and notification delivery + threadDelay (2 * 1000 * 1000) + + cancel thId + + -- Assert that at least one McpToolsListChangedNotification was enqueued + notifications <- STM.atomically $ STM.flushTQueue notiQ + let toolsNoti = [ n | n@(DM.McpToolsListChangedNotification _) <- notifications ] + hPutStrLn stderr $ "[INFO] TC-CR05-01: tools notifications received: " ++ show (length toolsNoti) + length toolsNoti `shouldSatisfy` (>= 1) + + +-- | +-- TC-CR05-02: Verify that notifications/prompts/list_changed is successfully delivered +-- when prompts-list.json (UTF-8) is updated by PromptsListWatchCommand. +tcCR05Prompts :: SpecContext -> IO () +tcCR05Prompts ctx = + withSystemTempDirectory "pms-watch-cr05-prompts" $ \tmpDir -> do + putStrLn "[INFO] EXECUTING TC-CR05-02: promptsList UTF-8 read test." + + -- Prepare temp prompts directory with a minimal prompts-list.json (UTF-8) + let promptsDir = tmpDir "prompts" + promptsListFile = promptsDir "prompts-list.json" + promptsContent = "[{\"name\":\"skill_echo\",\"description\":\"echo skill\"}]" + + createDirectoryIfMissing True promptsDir + BL.writeFile promptsListFile (BL.pack (map (fromIntegral . fromEnum) promptsContent)) + + let domDat0 = ctx^.domainDataSpecContext + domDat = domDat0 { DM._promptsDirDomainData = promptsDir } + appDat = ctx^.appDataSpecContext + cmdQ = domDat^.DM.watchQueueDomainData + notiQ = domDat^.DM.notificationQueueDomainData + + thId <- async $ SUT.runWithAppData appDat domDat + + -- Issue PromptsListWatchCommand to register watchTree + let argDat = DM.PromptsListWatchCommandData {} + args = DM.PromptsListWatchCommand argDat + STM.atomically $ STM.writeTQueue cmdQ args + + -- Wait for watchTree to start + threadDelay (1 * 1000 * 1000) + + -- Overwrite prompts-list.json to trigger the file-change event + let promptsContent2 = "[{\"name\":\"skill_echo2\",\"description\":\"echo2 skill\"}]" + BL.writeFile promptsListFile (BL.pack (map (fromIntegral . fromEnum) promptsContent2)) + + -- Wait for fsnotify event and notification delivery + threadDelay (2 * 1000 * 1000) + + cancel thId + + -- Assert that at least one McpPromptsListChangedNotification was enqueued + notifications <- STM.atomically $ STM.flushTQueue notiQ + let promptsNoti = [ n | n@(DM.McpPromptsListChangedNotification _) <- notifications ] + hPutStrLn stderr $ "[INFO] TC-CR05-02: prompts notifications received: " ++ show (length promptsNoti) + length promptsNoti `shouldSatisfy` (>= 1)