pms-infra-watch 0.0.5.0 → 0.0.6.0
raw patch · 5 files changed
+218/−21 lines, 5 filesdep +temporarydep −unixPVP ok
version bump matches the API change (PVP)
Dependencies added: temporary
Dependencies removed: unix
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- pms-infra-watch.cabal +5/−2
- src/PMS/Infra/Watch/DM/Type.hs +9/−1
- src/PMS/Infra/Watch/DS/Core.hs +4/−11
- test/PMS/Infra/Watch/App/ControlSpec.hs +196/−7
CHANGELOG.md view
@@ -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.
pms-infra-watch.cabal view
@@ -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
src/PMS/Infra/Watch/DM/Type.hs view
@@ -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
src/PMS/Infra/Watch/DS/Core.hs view
@@ -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
test/PMS/Infra/Watch/App/ControlSpec.hs view
@@ -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)