packages feed

pms-domain-model 0.1.7.0 → 0.1.8.0

raw patch · 5 files changed

+581/−8 lines, 5 filesdep +base16-bytestringdep +iproutedep +network

Dependencies added: base16-bytestring, iproute, network, regex-tdfa

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for pms-domain-model +## 0.1.8.0 -- 2026-05-31++* Added pms-infra-agent-socket, pms-infra-agent-serial.+ ## 0.1.7.0 -- 2026-05-15  * Add file system tools.
pms-domain-model.cabal view
@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.1.7.0+version:            0.1.8.0  -- A short (one-line) description of the package. synopsis:           pms-domain-model@@ -85,7 +85,11 @@                       stm,                       async,                       strip-ansi-escape,-                      safe-exceptions+                      safe-exceptions,+                      base16-bytestring,+                      regex-tdfa,+                      iproute,+                      network                          -- Directories containing source files.     hs-source-dirs:   src@@ -126,6 +130,7 @@                       async,                       lens,                       aeson,+                      bytestring,                       pms-domain-model                            build-tool-depends:
src/PMS/Domain/Model/DM/Type.hs view
@@ -1501,6 +1501,294 @@ -------------------------------------------------------------------------------- -- | --+data AgentSocketEchoCommandData =+  AgentSocketEchoCommandData {+    _jsonrpcAgentSocketEchoCommandData :: JsonRpcRequest+  , _valueAgentSocketEchoCommandData   :: String+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketEchoCommandData", omitNothingFields = True} ''AgentSocketEchoCommandData)+makeLenses ''AgentSocketEchoCommandData++instance Default AgentSocketEchoCommandData where+  def = AgentSocketEchoCommandData {+        _jsonrpcAgentSocketEchoCommandData = def+      , _valueAgentSocketEchoCommandData   = def+      }++-- |+--+data AgentSocketOpenCommandData =+  AgentSocketOpenCommandData {+    _jsonrpcAgentSocketOpenCommandData   :: JsonRpcRequest+  , _nameAgentSocketOpenCommandData      :: String+  , _argumentsAgentSocketOpenCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketOpenCommandData", omitNothingFields = True} ''AgentSocketOpenCommandData)+makeLenses ''AgentSocketOpenCommandData++instance Default AgentSocketOpenCommandData where+  def = AgentSocketOpenCommandData {+        _jsonrpcAgentSocketOpenCommandData   = def+      , _nameAgentSocketOpenCommandData      = def+      , _argumentsAgentSocketOpenCommandData = def+      }++-- |+--+data AgentSocketCloseCommandData =+  AgentSocketCloseCommandData {+    _jsonrpcAgentSocketCloseCommandData :: JsonRpcRequest+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketCloseCommandData", omitNothingFields = True} ''AgentSocketCloseCommandData)+makeLenses ''AgentSocketCloseCommandData++instance Default AgentSocketCloseCommandData where+  def = AgentSocketCloseCommandData {+        _jsonrpcAgentSocketCloseCommandData = def+      }++-- |+--+data AgentSocketReadCommandData =+  AgentSocketReadCommandData {+    _jsonrpcAgentSocketReadCommandData   :: JsonRpcRequest+  , _argumentsAgentSocketReadCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketReadCommandData", omitNothingFields = True} ''AgentSocketReadCommandData)+makeLenses ''AgentSocketReadCommandData++instance Default AgentSocketReadCommandData where+  def = AgentSocketReadCommandData {+        _jsonrpcAgentSocketReadCommandData   = def+      , _argumentsAgentSocketReadCommandData = def+      }++-- |+--+data AgentSocketWriteCommandData =+  AgentSocketWriteCommandData {+    _jsonrpcAgentSocketWriteCommandData   :: JsonRpcRequest+  , _argumentsAgentSocketWriteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketWriteCommandData", omitNothingFields = True} ''AgentSocketWriteCommandData)+makeLenses ''AgentSocketWriteCommandData++instance Default AgentSocketWriteCommandData where+  def = AgentSocketWriteCommandData {+        _jsonrpcAgentSocketWriteCommandData   = def+      , _argumentsAgentSocketWriteCommandData = def+      }++-- |+--+data AgentSocketReadByteCommandData =+  AgentSocketReadByteCommandData {+    _jsonrpcAgentSocketReadByteCommandData   :: JsonRpcRequest+  , _argumentsAgentSocketReadByteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketReadByteCommandData", omitNothingFields = True} ''AgentSocketReadByteCommandData)+makeLenses ''AgentSocketReadByteCommandData++instance Default AgentSocketReadByteCommandData where+  def = AgentSocketReadByteCommandData {+        _jsonrpcAgentSocketReadByteCommandData   = def+      , _argumentsAgentSocketReadByteCommandData = def+      }++-- |+--+data AgentSocketWriteByteCommandData =+  AgentSocketWriteByteCommandData {+    _jsonrpcAgentSocketWriteByteCommandData   :: JsonRpcRequest+  , _argumentsAgentSocketWriteByteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSocketWriteByteCommandData", omitNothingFields = True} ''AgentSocketWriteByteCommandData)+makeLenses ''AgentSocketWriteByteCommandData++instance Default AgentSocketWriteByteCommandData where+  def = AgentSocketWriteByteCommandData {+        _jsonrpcAgentSocketWriteByteCommandData   = def+      , _argumentsAgentSocketWriteByteCommandData = def+      }++-- |+--+data AgentSocketCommand =+    AgentSocketEchoCommand      AgentSocketEchoCommandData+  | AgentSocketOpenCommand      AgentSocketOpenCommandData+  | AgentSocketCloseCommand     AgentSocketCloseCommandData+  | AgentSocketReadCommand      AgentSocketReadCommandData+  | AgentSocketWriteCommand     AgentSocketWriteCommandData+  | AgentSocketReadByteCommand  AgentSocketReadByteCommandData+  | AgentSocketWriteByteCommand AgentSocketWriteByteCommandData+  deriving (Show, Read, Eq)++-- |+--+getJsonRpcAgentSocketCommand :: AgentSocketCommand -> JsonRpcRequest+getJsonRpcAgentSocketCommand (AgentSocketEchoCommand      d) = d^.jsonrpcAgentSocketEchoCommandData+getJsonRpcAgentSocketCommand (AgentSocketOpenCommand      d) = d^.jsonrpcAgentSocketOpenCommandData+getJsonRpcAgentSocketCommand (AgentSocketCloseCommand     d) = d^.jsonrpcAgentSocketCloseCommandData+getJsonRpcAgentSocketCommand (AgentSocketReadCommand      d) = d^.jsonrpcAgentSocketReadCommandData+getJsonRpcAgentSocketCommand (AgentSocketWriteCommand     d) = d^.jsonrpcAgentSocketWriteCommandData+getJsonRpcAgentSocketCommand (AgentSocketReadByteCommand  d) = d^.jsonrpcAgentSocketReadByteCommandData+getJsonRpcAgentSocketCommand (AgentSocketWriteByteCommand d) = d^.jsonrpcAgentSocketWriteByteCommandData+++--------------------------------------------------------------------------------+-- |+--+data AgentSerialEchoCommandData =+  AgentSerialEchoCommandData {+    _jsonrpcAgentSerialEchoCommandData :: JsonRpcRequest+  , _valueAgentSerialEchoCommandData   :: String+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialEchoCommandData", omitNothingFields = True} ''AgentSerialEchoCommandData)+makeLenses ''AgentSerialEchoCommandData++instance Default AgentSerialEchoCommandData where+  def = AgentSerialEchoCommandData {+        _jsonrpcAgentSerialEchoCommandData = def+      , _valueAgentSerialEchoCommandData   = def+      }++-- |+--+data AgentSerialOpenCommandData =+  AgentSerialOpenCommandData {+    _jsonrpcAgentSerialOpenCommandData   :: JsonRpcRequest+  , _nameAgentSerialOpenCommandData      :: String+  , _argumentsAgentSerialOpenCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialOpenCommandData", omitNothingFields = True} ''AgentSerialOpenCommandData)+makeLenses ''AgentSerialOpenCommandData++instance Default AgentSerialOpenCommandData where+  def = AgentSerialOpenCommandData {+        _jsonrpcAgentSerialOpenCommandData   = def+      , _nameAgentSerialOpenCommandData      = def+      , _argumentsAgentSerialOpenCommandData = def+      }++-- |+--+data AgentSerialCloseCommandData =+  AgentSerialCloseCommandData {+    _jsonrpcAgentSerialCloseCommandData :: JsonRpcRequest+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialCloseCommandData", omitNothingFields = True} ''AgentSerialCloseCommandData)+makeLenses ''AgentSerialCloseCommandData++instance Default AgentSerialCloseCommandData where+  def = AgentSerialCloseCommandData {+        _jsonrpcAgentSerialCloseCommandData = def+      }++-- |+--+data AgentSerialReadCommandData =+  AgentSerialReadCommandData {+    _jsonrpcAgentSerialReadCommandData   :: JsonRpcRequest+  , _argumentsAgentSerialReadCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialReadCommandData", omitNothingFields = True} ''AgentSerialReadCommandData)+makeLenses ''AgentSerialReadCommandData++instance Default AgentSerialReadCommandData where+  def = AgentSerialReadCommandData {+        _jsonrpcAgentSerialReadCommandData   = def+      , _argumentsAgentSerialReadCommandData = def+      }++-- |+--+data AgentSerialWriteCommandData =+  AgentSerialWriteCommandData {+    _jsonrpcAgentSerialWriteCommandData   :: JsonRpcRequest+  , _argumentsAgentSerialWriteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialWriteCommandData", omitNothingFields = True} ''AgentSerialWriteCommandData)+makeLenses ''AgentSerialWriteCommandData++instance Default AgentSerialWriteCommandData where+  def = AgentSerialWriteCommandData {+        _jsonrpcAgentSerialWriteCommandData   = def+      , _argumentsAgentSerialWriteCommandData = def+      }++-- |+--+data AgentSerialReadByteCommandData =+  AgentSerialReadByteCommandData {+    _jsonrpcAgentSerialReadByteCommandData   :: JsonRpcRequest+  , _argumentsAgentSerialReadByteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialReadByteCommandData", omitNothingFields = True} ''AgentSerialReadByteCommandData)+makeLenses ''AgentSerialReadByteCommandData++instance Default AgentSerialReadByteCommandData where+  def = AgentSerialReadByteCommandData {+        _jsonrpcAgentSerialReadByteCommandData   = def+      , _argumentsAgentSerialReadByteCommandData = def+      }++-- |+--+data AgentSerialWriteByteCommandData =+  AgentSerialWriteByteCommandData {+    _jsonrpcAgentSerialWriteByteCommandData   :: JsonRpcRequest+  , _argumentsAgentSerialWriteByteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentSerialWriteByteCommandData", omitNothingFields = True} ''AgentSerialWriteByteCommandData)+makeLenses ''AgentSerialWriteByteCommandData++instance Default AgentSerialWriteByteCommandData where+  def = AgentSerialWriteByteCommandData {+        _jsonrpcAgentSerialWriteByteCommandData   = def+      , _argumentsAgentSerialWriteByteCommandData = def+      }++-- |+--+data AgentSerialCommand =+    AgentSerialEchoCommand      AgentSerialEchoCommandData+  | AgentSerialOpenCommand      AgentSerialOpenCommandData+  | AgentSerialCloseCommand     AgentSerialCloseCommandData+  | AgentSerialReadCommand      AgentSerialReadCommandData+  | AgentSerialWriteCommand     AgentSerialWriteCommandData+  | AgentSerialReadByteCommand  AgentSerialReadByteCommandData+  | AgentSerialWriteByteCommand AgentSerialWriteByteCommandData+  deriving (Show, Read, Eq)++-- |+--+getJsonRpcAgentSerialCommand :: AgentSerialCommand -> JsonRpcRequest+getJsonRpcAgentSerialCommand (AgentSerialEchoCommand      d) = d^.jsonrpcAgentSerialEchoCommandData+getJsonRpcAgentSerialCommand (AgentSerialOpenCommand      d) = d^.jsonrpcAgentSerialOpenCommandData+getJsonRpcAgentSerialCommand (AgentSerialCloseCommand     d) = d^.jsonrpcAgentSerialCloseCommandData+getJsonRpcAgentSerialCommand (AgentSerialReadCommand      d) = d^.jsonrpcAgentSerialReadCommandData+getJsonRpcAgentSerialCommand (AgentSerialWriteCommand     d) = d^.jsonrpcAgentSerialWriteCommandData+getJsonRpcAgentSerialCommand (AgentSerialReadByteCommand  d) = d^.jsonrpcAgentSerialReadByteCommandData+getJsonRpcAgentSerialCommand (AgentSerialWriteByteCommand d) = d^.jsonrpcAgentSerialWriteByteCommandData+++--------------------------------------------------------------------------------+-- |+-- data SocketEchoCommandData =   SocketEchoCommandData {     _jsonrpcSocketEchoCommandData :: JsonRpcRequest@@ -1700,12 +1988,16 @@   , _watchQueueDomainData          :: TQueue WatchCommand   , _procspawnQueueDomainData      :: TQueue ProcSpawnCommand   , _agentProcessQueueDomainData   :: TQueue AgentProcessCommand+  , _agentSocketQueueDomainData    :: TQueue AgentSocketCommand+  , _agentSerialQueueDomainData    :: TQueue AgentSerialCommand   , _socketQueueDomainData         :: TQueue SocketCommand   , _serialQueueDomainData         :: TQueue SerialCommand   , _promptsDomainData             :: [String]   , _invalidCharsDomainData        :: [String]   , _invalidCmdsDomainData         :: [String]   , _allowedAgentCmdsDomainData    :: [String]   -- ^ whitelist for agent-proc-run; empty means deny all+  , _sandboxNetworksDomainData     :: [String]   -- ^ CIDR list for agent-socket-open; empty = deny all+  , _invalidPatternsDomainData     :: [String]   -- ^ regex blacklist for write commands; empty = allow all   , _timeoutMicrosecDomainData     :: Int   } @@ -1731,6 +2023,8 @@   watchQ       <- newTQueueIO   procQ        <- newTQueueIO   agentProcQ   <- newTQueueIO+  agentSocketQ <- newTQueueIO+  agentSerialQ <- newTQueueIO   socketQ      <- newTQueueIO   serialQ      <- newTQueueIO   return DomainData {@@ -1749,12 +2043,16 @@          , _watchQueueDomainData        = watchQ          , _procspawnQueueDomainData    = procQ          , _agentProcessQueueDomainData = agentProcQ+         , _agentSocketQueueDomainData  = agentSocketQ+         , _agentSerialQueueDomainData  = agentSerialQ          , _socketQueueDomainData       = socketQ          , _serialQueueDomainData       = serialQ          , _promptsDomainData           = def          , _invalidCharsDomainData      = def          , _invalidCmdsDomainData       = def          , _allowedAgentCmdsDomainData  = def     -- deny all by default+         , _sandboxNetworksDomainData   = def      -- deny all by default+         , _invalidPatternsDomainData   = def      -- allow all by default          , _timeoutMicrosecDomainData   = 30 * 1000 * 1000          }
src/PMS/Domain/Model/DS/Utility.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE CPP #-}  module PMS.Domain.Model.DS.Utility where @@ -22,6 +21,14 @@ import qualified Control.Concurrent.STM as STM import System.IO import Data.List+import qualified Data.ByteString as BSS+import qualified Data.ByteString.Base16 as B16+import System.Exit (ExitCode(..))+import Text.Regex.TDFA ((=~))+import Data.IP (AddrRange, IPv4, IP(..), isMatchedTo, fromSockAddr)+import Network.Socket (getAddrInfo, defaultHints, addrAddress, HostName, SockAddr)+import Data.Maybe (mapMaybe)+import Text.Read (readMaybe)  import PMS.Domain.Model.DM.Type import PMS.Domain.Model.DM.Constant@@ -227,3 +234,122 @@     hdlExcept acc e = do       let accText = TE.decodeUtf8With TEE.lenientDecode acc       E.throwString $ show e ++ "\nAccumulated input so far:\n" ++ T.unpack accText+++--------------------------------------------------------------------------------+-- CR-11: Handle I/O common utilities+--------------------------------------------------------------------------------++-- | Read from a Handle with a timeout. tout is in milliseconds.+-- Returns an empty ByteString on timeout (not an error).+-- Consolidates readProc (agent-process) and readSocket (agent-socket) patterns.+readHandle :: Handle -> Int -> Int -> IO BSS.ByteString+readHandle hdl tout size = do+  ready <- hWaitForInput hdl tout+  if ready+    then BSS.hGetSome hdl size+    else return BSS.empty++-- | Write a ByteString to a Handle and flush.+writeHandle :: Handle -> BSS.ByteString -> IO ()+writeHandle hdl bs = do+  BSS.hPut hdl bs+  hFlush hdl++-- | Convert a ByteString to an uppercase hex string (e.g. "000A1BFF").+bytesToHex :: BSS.ByteString -> String+bytesToHex = map toUpper . BS.unpack . B16.encode++-- | Encode a String to a UTF-8 encoded ByteString.+str2bsUTF8 :: String -> BSS.ByteString+str2bsUTF8 = TE.encodeUtf8 . T.pack++-- | Decode a ByteString to a String using UTF-8 lenient decoding (no ANSI strip).+-- For raw socket or binary data.+bs2strUTF8 :: BSS.ByteString -> String+bs2strUTF8 = T.unpack . TE.decodeUtf8With TEE.lenientDecode++-- | Decode a ByteString to a String using UTF-8 lenient decoding and strip ANSI escapes.+-- For process output (pty / pipe output).+bs2strUTF8Strip :: BSS.ByteString -> String+bs2strUTF8Strip = T.unpack . ANSI.stripAnsiEscapeCodes . TE.decodeUtf8With TEE.lenientDecode++-- | Write a McpResponse to the TQueue.+-- Consolidated here because it depends only on domain-model types.+toolsCallResponse :: STM.TQueue McpResponse+                  -> JsonRpcRequest+                  -> ExitCode+                  -> String+                  -> String+                  -> IO ()+toolsCallResponse resQ jsonRpc code outStr errStr = do+  let content = [ McpToolsCallResponseResultContent "text" outStr+                , McpToolsCallResponseResultContent "text" errStr+                ]+      result = McpToolsCallResponseResult {+                  _contentMcpToolsCallResponseResult  = content+                , _isErrorMcpToolsCallResponseResult  = (ExitSuccess /= code)+                }+      resDat = McpToolsCallResponseData jsonRpc result+      res    = McpToolsCallResponse resDat+  STM.atomically $ STM.writeTQueue resQ res+++-- | Append a newline character ('\n') to the string.+-- Simple unconditional append; no escape expansion, no duplicate check.+-- Called only when appendNewline is True (or omitted = default True).+-- write-byte variants (binary) must NOT use this function.+appendCRLF :: String -> String+appendCRLF str = str ++ lineEnding+  where+    lineEnding :: String+    lineEnding = case nativeNewline of+      CRLF -> _CRLF+      LF   -> _LF++--------------------------------------------------------------------------------+-- CR-12: Security check functions+--------------------------------------------------------------------------------++-- | Check input against a list of regex patterns (invalidPatterns).+-- Returns the first matching pattern as Just, or Nothing if no match (allow).+-- An empty pattern list means allow all.+checkInvalidPatterns :: [String] -> String -> Maybe String+checkInvalidPatterns patterns input =+  find (\pat -> (input =~ pat) :: Bool) patterns++-- | Check a hostname against a list of CIDR ranges (sandboxNetworks).+-- Returns Right () if the resolved IP matches any range, Left error otherwise.+-- An empty CIDR list means deny all hosts.+-- Unix Domain Socket connections should NOT call this function.+checkSandboxNetworks :: [String] -> HostName -> IO (Either String ())+checkSandboxNetworks [] host =+  return . Left $+    "agent-socket-open: connection refused. host " ++ host+    ++ " is outside sandboxNetworks (sandboxNetworks is empty; all hosts denied)."+checkSandboxNetworks cidrs host = do+  let ranges = mapMaybe readMaybe cidrs :: [AddrRange IPv4]+  addrs <- getAddrInfo (Just defaultHints) (Just host) Nothing+  -- Case B: classify each resolved address; IPv6 is explicitly rejected.+  let classified = map (classifyAddr . addrAddress) addrs+  case sequence classified of+    Left errMsg -> return (Left errMsg)+    Right ipv4s ->+      if any (\ip -> any (ip `isMatchedTo`) ranges) ipv4s+        then return (Right ())+        else return . Left $+               "agent-socket-open: connection refused. host " ++ host+               ++ " is outside sandboxNetworks (allowed: " ++ show cidrs ++ ")."++-- | Classify a SockAddr as IPv4 (Right) or unsupported (Left error message).+-- IPv6 addresses are explicitly rejected with a descriptive error (Case B).+-- Non-IP addresses should never reach this function (Unix Domain Socket is exempt).+classifyAddr :: SockAddr -> Either String IPv4+classifyAddr sa = case fromSockAddr sa of+  Just (IPv4 v4, _) -> Right v4+  Just (IPv6 v6, _) -> Left $+    "agent-socket-open: IPv6 is not supported in sandboxNetworks. "+    ++ "resolved address: " ++ show v6+    ++ " (use an IPv4 host or IPv4 CIDR ranges)."+  _ -> Left+    "agent-socket-open: unsupported address type returned by DNS resolution."
test/PMS/Domain/Model/DS/UtilitySpec.hs view
@@ -1,18 +1,17 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE MultilineStrings #-}  module PMS.Domain.Model.DS.UtilitySpec (spec) where  import Test.Hspec import Control.Lens import Data.Aeson-+import System.Exit (ExitCode(..))+import System.IO+import qualified Control.Concurrent.STM as STM+import qualified Data.ByteString as BS import qualified PMS.Domain.Model.DS.Utility as SUT import qualified PMS.Domain.Model.DM.Type as SUT----- | -- data SpecContext = SpecContext {} @@ -74,5 +73,146 @@          actual `shouldBe` expect +  -- CR-11: Handle I/O common utility tests +  describe "bytesToHex" $ do+    -- TC-DM-04+    context "bytes [0x00, 0x0A, 0x1B, 0xFF]" $ do+      it "should return '000A1BFF'" $ \_ -> do+        let input  = BS.pack [0x00, 0x0A, 0x1B, 0xFF]+            actual = SUT.bytesToHex input+        actual `shouldBe` "000A1BFF"++  describe "str2bsUTF8" $ do+    -- TC-DM-05+    context "hello" $ do+      it "should encode to UTF-8 ByteString" $ \_ -> do+        let actual = SUT.str2bsUTF8 "hello"+        actual `shouldBe` BS.pack [0x68, 0x65, 0x6C, 0x6C, 0x6F]++  describe "bs2strUTF8" $ do+    -- TC-DM-06: no ANSI stripping+    context "UTF-8 ByteString without ANSI" $ do+      it "should decode to String" $ \_ -> do+        let input  = BS.pack [0x68, 0x65, 0x6C, 0x6C, 0x6F]+            actual = SUT.bs2strUTF8 input+        actual `shouldBe` "hello"+    context "UTF-8 ByteString with ANSI escape" $ do+      it "should decode without stripping ANSI" $ \_ -> do+        -- ESC[31m = red color escape sequence+        let input  = BS.pack [0x1B, 0x5B, 0x33, 0x31, 0x6D, 0x68, 0x69]+            actual = SUT.bs2strUTF8 input+        actual `shouldBe` "\ESC[31mhi"++  describe "bs2strUTF8Strip" $ do+    -- TC-DM-07: ANSI stripped+    context "UTF-8 ByteString with ANSI escape" $ do+      it "should decode and strip ANSI sequences" $ \_ -> do+        let input  = BS.pack [0x1B, 0x5B, 0x33, 0x31, 0x6D, 0x68, 0x69]+            actual = SUT.bs2strUTF8Strip input+        actual `shouldBe` "hi"++  describe "toolsCallResponse" $ do+    -- TC-DM-08+    context "ExitSuccess" $ do+      it "should write McpToolsCallResponse with isError=False to TQueue" $ \_ -> do+        let jsonRpc = SUT.JsonRpcRequest+              { SUT._jsonrpcJsonRpcRequest = "2.0"+              , SUT._idJsonRpcRequest      = Just 1+              , SUT._methodJsonRpcRequest  = "tools/call"+              , SUT._paramsJsonRpcRequest  = Nothing+              }+        resQ <- STM.newTQueueIO+        SUT.toolsCallResponse resQ jsonRpc ExitSuccess "out" "err"+        res <- STM.atomically $ STM.readTQueue resQ+        case res of+          SUT.McpToolsCallResponse dat ->+            SUT._isErrorMcpToolsCallResponseResult+              (SUT._resultMcpToolsCallResponseData dat) `shouldBe` False+          _ -> expectationFailure "unexpected McpResponse variant"+    -- TC-DM-09+    context "ExitFailure" $ do+      it "should write McpToolsCallResponse with isError=True to TQueue" $ \_ -> do+        let jsonRpc = SUT.JsonRpcRequest+              { SUT._jsonrpcJsonRpcRequest = "2.0"+              , SUT._idJsonRpcRequest      = Just 1+              , SUT._methodJsonRpcRequest  = "tools/call"+              , SUT._paramsJsonRpcRequest  = Nothing+              }+        resQ <- STM.newTQueueIO+        SUT.toolsCallResponse resQ jsonRpc (ExitFailure 1) "" "error"+        res <- STM.atomically $ STM.readTQueue resQ+        case res of+          SUT.McpToolsCallResponse dat ->+            SUT._isErrorMcpToolsCallResponseResult+              (SUT._resultMcpToolsCallResponseData dat) `shouldBe` True+          _ -> expectationFailure "unexpected McpResponse variant"++++  -- CR-12: Security check function tests++  describe "checkInvalidPatterns" $ do++    -- TC-DM-10: match exists -> Just pattern+    context "TC-DM-10: input matches a literal pattern" $ do+      it "should return Just the matched pattern" $ \_ -> do+        let patterns = ["rm", "shutdown"]+            input    = "rm -rf /"+            actual   = SUT.checkInvalidPatterns patterns input+        actual `shouldBe` Just "rm"++    -- TC-DM-11: no match -> Nothing+    context "TC-DM-11: input does not match any pattern" $ do+      it "should return Nothing" $ \_ -> do+        let patterns = ["rm", "shutdown"]+            input    = "echo hello"+            actual   = SUT.checkInvalidPatterns patterns input+        actual `shouldBe` Nothing++    -- TC-DM-12: empty pattern list -> Nothing (allow all)+    context "TC-DM-12: empty pattern list" $ do+      it "should return Nothing (allow all)" $ \_ -> do+        let patterns = [] :: [String]+            input    = "rm -rf /"+            actual   = SUT.checkInvalidPatterns patterns input+        actual `shouldBe` Nothing++    -- TC-DM-13: regex pattern ".*ssh.*" matches+    context "TC-DM-13: regex pattern '.*ssh.*' matches ssh command" $ do+      it "should return Just \".*ssh.*\"" $ \_ -> do+        let patterns = [".*ssh.*"]+            input    = "ssh user@host"+            actual   = SUT.checkInvalidPatterns patterns input+        actual `shouldBe` Just ".*ssh.*"++  describe "checkSandboxNetworks" $ do++    -- TC-DM-14: empty CIDR list -> Left (deny all)+    context "TC-DM-14: empty CIDR list" $ do+      it "should return Left (deny all hosts)" $ \_ -> do+        result <- SUT.checkSandboxNetworks [] "127.0.0.1"+        case result of+          Left msg -> msg `shouldContain` "sandboxNetworks is empty"+          Right () -> expectationFailure "Expected Left but got Right"++    -- TC-DM-15: host IP within range -> Right ()+    context "TC-DM-15: loopback IP within 127.0.0.0/8" $ do+      it "should return Right ()" $ \_ -> do+        result <- SUT.checkSandboxNetworks ["127.0.0.0/8"] "127.0.0.1"+        result `shouldBe` Right ()++    -- TC-DM-16: host IP outside all ranges -> Left+    context "TC-DM-16: IP outside all CIDR ranges" $ do+      it "should return Left with error message containing 'outside sandboxNetworks'" $ \_ -> do+        result <- SUT.checkSandboxNetworks ["10.0.0.0/8"] "127.0.0.1"+        case result of+          Left msg -> msg `shouldContain` "outside sandboxNetworks"+          Right () -> expectationFailure "Expected Left but got Right"++    -- TC-DM-17: multiple CIDRs, IP matches one -> Right ()+    context "TC-DM-17: IP matches second of multiple CIDR ranges" $ do+      it "should return Right ()" $ \_ -> do+        result <- SUT.checkSandboxNetworks ["10.0.0.0/8", "127.0.0.0/8"] "127.0.0.1"+        result `shouldBe` Right ()