diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for pms-domain-model +## 0.1.9.0 -- 2026-06-15 + +* Added pms-infra-agent-server: TCP server listen/accept functionality for AI agents. + ## 0.1.8.0 -- 2026-05-31 * Added pms-infra-agent-socket, pms-infra-agent-serial. diff --git a/pms-domain-model.cabal b/pms-domain-model.cabal --- a/pms-domain-model.cabal +++ b/pms-domain-model.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.8.0 +version: 0.1.9.0 -- A short (one-line) description of the package. synopsis: pms-domain-model diff --git a/src/PMS/Domain/Model/DM/Type.hs b/src/PMS/Domain/Model/DM/Type.hs --- a/src/PMS/Domain/Model/DM/Type.hs +++ b/src/PMS/Domain/Model/DM/Type.hs @@ -1789,6 +1789,190 @@ -------------------------------------------------------------------------------- -- | -- +data AgentServerListenCommandData = + AgentServerListenCommandData { + _jsonrpcAgentServerListenCommandData :: JsonRpcRequest + , _argumentsAgentServerListenCommandData :: RawJsonByteString + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerListenCommandData", omitNothingFields = True} ''AgentServerListenCommandData) +makeLenses ''AgentServerListenCommandData + +instance Default AgentServerListenCommandData where + def = AgentServerListenCommandData { + _jsonrpcAgentServerListenCommandData = def + , _argumentsAgentServerListenCommandData = def + } + +-- | +-- +data AgentServerCloseCommandData = + AgentServerCloseCommandData { + _jsonrpcAgentServerCloseCommandData :: JsonRpcRequest + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerCloseCommandData", omitNothingFields = True} ''AgentServerCloseCommandData) +makeLenses ''AgentServerCloseCommandData + +instance Default AgentServerCloseCommandData where + def = AgentServerCloseCommandData { + _jsonrpcAgentServerCloseCommandData = def + } + +-- | +-- +data AgentServerStatusCommandData = + AgentServerStatusCommandData { + _jsonrpcAgentServerStatusCommandData :: JsonRpcRequest + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerStatusCommandData", omitNothingFields = True} ''AgentServerStatusCommandData) +makeLenses ''AgentServerStatusCommandData + +instance Default AgentServerStatusCommandData where + def = AgentServerStatusCommandData { + _jsonrpcAgentServerStatusCommandData = def + } + +-- | +-- +data AgentServerEventsCommandData = + AgentServerEventsCommandData { + _jsonrpcAgentServerEventsCommandData :: JsonRpcRequest + , _argumentsAgentServerEventsCommandData :: RawJsonByteString + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerEventsCommandData", omitNothingFields = True} ''AgentServerEventsCommandData) +makeLenses ''AgentServerEventsCommandData + +instance Default AgentServerEventsCommandData where + def = AgentServerEventsCommandData { + _jsonrpcAgentServerEventsCommandData = def + , _argumentsAgentServerEventsCommandData = def + } + +-- | +-- +data AgentServerReadCommandData = + AgentServerReadCommandData { + _jsonrpcAgentServerReadCommandData :: JsonRpcRequest + , _argumentsAgentServerReadCommandData :: RawJsonByteString + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerReadCommandData", omitNothingFields = True} ''AgentServerReadCommandData) +makeLenses ''AgentServerReadCommandData + +instance Default AgentServerReadCommandData where + def = AgentServerReadCommandData { + _jsonrpcAgentServerReadCommandData = def + , _argumentsAgentServerReadCommandData = def + } + +-- | +-- +data AgentServerWriteCommandData = + AgentServerWriteCommandData { + _jsonrpcAgentServerWriteCommandData :: JsonRpcRequest + , _argumentsAgentServerWriteCommandData :: RawJsonByteString + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerWriteCommandData", omitNothingFields = True} ''AgentServerWriteCommandData) +makeLenses ''AgentServerWriteCommandData + +instance Default AgentServerWriteCommandData where + def = AgentServerWriteCommandData { + _jsonrpcAgentServerWriteCommandData = def + , _argumentsAgentServerWriteCommandData = def + } + +-- | +-- +data AgentServerReadByteCommandData = + AgentServerReadByteCommandData { + _jsonrpcAgentServerReadByteCommandData :: JsonRpcRequest + , _argumentsAgentServerReadByteCommandData :: RawJsonByteString + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerReadByteCommandData", omitNothingFields = True} ''AgentServerReadByteCommandData) +makeLenses ''AgentServerReadByteCommandData + +instance Default AgentServerReadByteCommandData where + def = AgentServerReadByteCommandData { + _jsonrpcAgentServerReadByteCommandData = def + , _argumentsAgentServerReadByteCommandData = def + } + +-- | +-- +data AgentServerWriteByteCommandData = + AgentServerWriteByteCommandData { + _jsonrpcAgentServerWriteByteCommandData :: JsonRpcRequest + , _argumentsAgentServerWriteByteCommandData :: RawJsonByteString + } deriving (Show, Read, Eq) + +$(deriveJSON defaultOptions {fieldLabelModifier = dropDataName "AgentServerWriteByteCommandData", omitNothingFields = True} ''AgentServerWriteByteCommandData) +makeLenses ''AgentServerWriteByteCommandData + +instance Default AgentServerWriteByteCommandData where + def = AgentServerWriteByteCommandData { + _jsonrpcAgentServerWriteByteCommandData = def + , _argumentsAgentServerWriteByteCommandData = def + } + +-- | +-- +-- | +-- Internal event command data: client connected notification from acceptLoop. +data AgentServerInternalClientConnectedCommandData = + AgentServerInternalClientConnectedCommandData + { _handleNameAgentServerInternalClientConnectedCommandData :: String + , _remoteAddrAgentServerInternalClientConnectedCommandData :: String + } deriving (Show, Read, Eq) + +makeLenses ''AgentServerInternalClientConnectedCommandData + +-- | +-- Internal event command data: client disconnected notification from recvLoop. +data AgentServerInternalClientDisconnectedCommandData = + AgentServerInternalClientDisconnectedCommandData + { _handleNameAgentServerInternalClientDisconnectedCommandData :: String + } deriving (Show, Read, Eq) + +makeLenses ''AgentServerInternalClientDisconnectedCommandData + +-- | +-- +data AgentServerCommand = + AgentServerListenCommand AgentServerListenCommandData + | AgentServerCloseCommand AgentServerCloseCommandData + | AgentServerStatusCommand AgentServerStatusCommandData + | AgentServerEventsCommand AgentServerEventsCommandData + | AgentServerReadCommand AgentServerReadCommandData + | AgentServerWriteCommand AgentServerWriteCommandData + | AgentServerReadByteCommand AgentServerReadByteCommandData + | AgentServerWriteByteCommand AgentServerWriteByteCommandData + | AgentServerInternalClientConnectedCommand AgentServerInternalClientConnectedCommandData + | AgentServerInternalClientDisconnectedCommand AgentServerInternalClientDisconnectedCommandData + deriving (Show, Read, Eq) + +-- | +-- +getJsonRpcAgentServerCommand :: AgentServerCommand -> JsonRpcRequest +getJsonRpcAgentServerCommand (AgentServerListenCommand d) = d^.jsonrpcAgentServerListenCommandData +getJsonRpcAgentServerCommand (AgentServerCloseCommand d) = d^.jsonrpcAgentServerCloseCommandData +getJsonRpcAgentServerCommand (AgentServerStatusCommand d) = d^.jsonrpcAgentServerStatusCommandData +getJsonRpcAgentServerCommand (AgentServerEventsCommand d) = d^.jsonrpcAgentServerEventsCommandData +getJsonRpcAgentServerCommand (AgentServerReadCommand d) = d^.jsonrpcAgentServerReadCommandData +getJsonRpcAgentServerCommand (AgentServerWriteCommand d) = d^.jsonrpcAgentServerWriteCommandData +getJsonRpcAgentServerCommand (AgentServerReadByteCommand d) = d^.jsonrpcAgentServerReadByteCommandData +getJsonRpcAgentServerCommand (AgentServerWriteByteCommand d) = d^.jsonrpcAgentServerWriteByteCommandData +getJsonRpcAgentServerCommand (AgentServerInternalClientConnectedCommand _) = def +getJsonRpcAgentServerCommand (AgentServerInternalClientDisconnectedCommand _) = def + + +-------------------------------------------------------------------------------- +-- | +-- data SocketEchoCommandData = SocketEchoCommandData { _jsonrpcSocketEchoCommandData :: JsonRpcRequest @@ -1990,6 +2174,7 @@ , _agentProcessQueueDomainData :: TQueue AgentProcessCommand , _agentSocketQueueDomainData :: TQueue AgentSocketCommand , _agentSerialQueueDomainData :: TQueue AgentSerialCommand + , _agentServerQueueDomainData :: TQueue AgentServerCommand , _socketQueueDomainData :: TQueue SocketCommand , _serialQueueDomainData :: TQueue SerialCommand , _promptsDomainData :: [String] @@ -2025,6 +2210,7 @@ agentProcQ <- newTQueueIO agentSocketQ <- newTQueueIO agentSerialQ <- newTQueueIO + agentServerQ <- newTQueueIO socketQ <- newTQueueIO serialQ <- newTQueueIO return DomainData { @@ -2045,6 +2231,7 @@ , _agentProcessQueueDomainData = agentProcQ , _agentSocketQueueDomainData = agentSocketQ , _agentSerialQueueDomainData = agentSerialQ + , _agentServerQueueDomainData = agentServerQ , _socketQueueDomainData = socketQ , _serialQueueDomainData = serialQ , _promptsDomainData = def diff --git a/src/PMS/Domain/Model/DS/Utility.hs b/src/PMS/Domain/Model/DS/Utility.hs --- a/src/PMS/Domain/Model/DS/Utility.hs +++ b/src/PMS/Domain/Model/DS/Utility.hs @@ -260,6 +260,13 @@ bytesToHex :: BSS.ByteString -> String bytesToHex = map toUpper . BS.unpack . B16.encode +-- | Decode an uppercase/lowercase hex string to a ByteString. +hexToBytes :: String -> Either String BSS.ByteString +hexToBytes hex = + case B16.decode (BS.pack (map toUpper hex)) of + Right bs -> Right bs + Left err -> Left $ "hexToBytes: invalid hex string: " ++ err + -- | Encode a String to a UTF-8 encoded ByteString. str2bsUTF8 :: String -> BSS.ByteString str2bsUTF8 = TE.encodeUtf8 . T.pack