pms-domain-model 0.0.5.0 → 0.0.6.0

raw patch · 5 files changed

+109/−32 lines, 5 filesdep ~base

Dependency ranges changed: base

Files

• CHANGELOG.md +4/−0
• pms-domain-model.cabal +8/−7
• src/PMS/Domain/Model/DM/Constant.hs +5/−0
• src/PMS/Domain/Model/DM/Type.hs +75/−7
• src/PMS/Domain/Model/DS/Utility.hs +17/−18

@@ -1,5 +1,9 @@ # Revision history for pms-domain-model +## 0.0.6.0 -- 2025-07-13++* Added serial tool.+ ## 0.0.5.0 -- 2025-07-06  * Added socket tool.

@@ -1,4 +1,4 @@-cabal-version:      3.12+cabal-version: 2.4 -- The cabal-version field refers to the version of the .cabal specification, -- and can be different from the cabal-install (the tool) version and the -- Cabal (the library) version you are using. As such, the Cabal (the library)@@ -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-domain-model@@ -55,7 +55,8 @@ -- extra-source-files:  library-    ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial+    ghc-options: -Wall -threaded -Wno-orphans+--     ghc-options: -Wall -threaded -Wno-orphans -Wno-x-partial      -- Modules exported by the library.     exposed-modules:  PMS.Domain.Model.DM.TH,@@ -70,7 +71,7 @@     -- other-extensions:      -- Other library packages from which modules are imported.-    build-depends:    base ^>=4.21.0.0,+    build-depends:    base >= 4.18 && < 5,                       text,                       mtl,                       aeson,@@ -89,7 +90,7 @@     hs-source-dirs:   src      -- Base language which the package is written in.-    default-language: GHC2021+    default-language: Haskell2010  test-suite pms-domain-model-test     ghc-options: -threaded -Wno-incomplete-uni-patterns@@ -97,7 +98,7 @@     -- import:           warnings      -- Base language which the package is written in.-    default-language: GHC2021+    default-language: Haskell2010      -- Modules included in this executable, other than Main.     other-modules:    PMS.Domain.Model.DS.UtilitySpec@@ -115,7 +116,7 @@     main-is:          Spec.hs      -- Test dependencies.-    build-depends:    base ^>=4.21.0.0,+    build-depends:    base >= 4.18 && < 5,                       hspec,                       hspec-discover,                       data-default,

@@ -50,3 +50,8 @@ _CRLF :: String _CRLF = "\r\n" ++-- |+--+_CR :: String+_CR = "\r"

@@ -1343,16 +1343,81 @@   | SocketTelnetCommand  SocketTelnetCommandData   deriving (Show, Read, Eq) ++-------------------------------------------------------------------------------- -- | ---{--getJsonRpcSocketCommand :: SocketCommand -> JsonRpcRequest-getJsonRpcSocketCommand (SocketEchoCommand      d) = d^.jsonrpcSocketEchoCommandData-getJsonRpcSocketCommand (SocketOpenCommand       d) = d^.jsonrpcSocketOpenCommandData-getJsonRpcSocketCommand (SocketCloseCommand d) = d^.jsonrpcSocketCloseCommandData-getJsonRpcSocketCommand (SocketMessageCommand   d) = d^.jsonrpcSocketMessageCommandData--}+data SerialEchoCommandData =+  SerialEchoCommandData {+    _jsonrpcSerialEchoCommandData :: JsonRpcRequest+  , _valueSerialEchoCommandData   :: String+  } deriving (Show, Read, Eq) +makeLenses ''SerialEchoCommandData++-- |+--+data SerialOpenCommandData =+  SerialOpenCommandData {+    _jsonrpcSerialOpenCommandData   :: JsonRpcRequest+  , _nameSerialOpenCommandData      :: String+  , _argumentsSerialOpenCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++makeLenses ''SerialOpenCommandData++-- |+--+data SerialCloseCommandData =+  SerialCloseCommandData {+    _jsonrpcSerialCloseCommandData :: JsonRpcRequest+  } deriving (Show, Read, Eq)+  +makeLenses ''SerialCloseCommandData+++-- |+--+data SerialReadCommandData =+  SerialReadCommandData {+    _jsonrpcSerialReadCommandData :: JsonRpcRequest+  , _argumentsSerialReadCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)+  +makeLenses ''SerialReadCommandData++-- |+--+data SerialWriteCommandData =+  SerialWriteCommandData {+    _jsonrpcSerialWriteCommandData :: JsonRpcRequest+  , _argumentsSerialWriteCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++makeLenses ''SerialWriteCommandData+++-- |+--+data SerialMessageCommandData =+  SerialMessageCommandData {+    _jsonrpcSerialMessageCommandData   :: JsonRpcRequest+  , _argumentsSerialMessageCommandData :: RawJsonByteString+  } deriving (Show, Read, Eq)++makeLenses ''SerialMessageCommandData++-- |+--+data SerialCommand =+    SerialEchoCommand    SerialEchoCommandData+  | SerialOpenCommand    SerialOpenCommandData+  | SerialCloseCommand   SerialCloseCommandData+  | SerialReadCommand    SerialReadCommandData+  | SerialWriteCommand   SerialWriteCommandData+  | SerialMessageCommand SerialMessageCommandData+  deriving (Show, Read, Eq)+ -------------------------------------------------------------------------------- -- | --@@ -1370,6 +1435,7 @@   , _watchQueueDomainData        :: TQueue WatchCommand   , _procspawnQueueDomainData    :: TQueue ProcSpawnCommand   , _socketQueueDomainData       :: TQueue SocketCommand+  , _serialQueueDomainData       :: TQueue SerialCommand   , _promptsDomainData           :: [String]   } @@ -1394,6 +1460,7 @@   watchQ  <- newTQueueIO   procQ   <- newTQueueIO   socketQ   <- newTQueueIO+  serialQ   <- newTQueueIO   return DomainData {            _logDirDomainData            = Nothing          , _logLevelDomainData          = LevelDebug@@ -1408,6 +1475,7 @@          , _watchQueueDomainData        = watchQ          , _procspawnQueueDomainData    = procQ          , _socketQueueDomainData       = socketQ+         , _serialQueueDomainData       = serialQ          , _promptsDomainData           = def          } 

@@ -103,15 +103,23 @@   ] #endif + -- | --+validateMessage :: String -> IO String+validateMessage cmd = case words cmd of+  [] -> return cmd+  (c : args) -> do+    _ <- validateCommand c+    _ <- validateArgs args+    return cmd++-- |+-- validateCommand :: String -> IO String validateCommand cmd = do   let tcmd = T.pack cmd -  when (null cmd) $-    E.throwString "Command is empty."-   mapM_ (\seqStr ->           when (seqStr `T.isInfixOf` tcmd) $             E.throwString $ "Command contains forbidden sequence: " ++ T.unpack seqStr@@ -128,8 +136,14 @@     isAllowedChar :: Char -> Bool     isAllowedChar c = isAlphaNum c || c `elem` ("-._" :: String) + -- | --+validateArgs :: [String] -> IO [String]+validateArgs = mapM validateArg++-- |+-- validateArg :: String -> IO String validateArg arg = do   let tArg = T.pack arg@@ -137,21 +151,6 @@     E.throwString $ "Argument contains forbidden sequences: " ++ arg   return arg --- |----validateArgs :: [String] -> IO [String]-validateArgs = mapM validateArg---- |----validateMessage :: String -> IO String-validateMessage cmd =-  case words cmd of-    [] -> E.throwString "Command is empty."-    (c : args) -> do-      _ <- validateCommand c-      _ <- validateArgs args-      return cmd   -- |