{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

module PMS.Infra.Socket.DS.Core where

import System.IO
import Control.Monad.Logger
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Lens
import Control.Monad.Reader
import qualified Control.Concurrent as CC 
import Control.Concurrent.Async
import qualified Control.Concurrent.STM as STM
import Data.Conduit
import qualified Data.Text as T
import Control.Monad.Except
import qualified Control.Exception.Safe as E
import System.Exit
import qualified Data.Text.Encoding as TE
import Data.Aeson 
import qualified Data.ByteString.Char8 as BS8
import Network.Socket
import Data.Word 
import qualified Data.ByteString as B

import qualified PMS.Domain.Model.DS.Utility as DM
import qualified PMS.Domain.Model.DM.Type as DM
import qualified PMS.Domain.Model.DM.Constant as DM

import PMS.Infra.Socket.DM.Type
import PMS.Infra.Socket.DS.Utility


-- |
--
app :: AppContext ()
app :: AppContext ()
app = do
  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"app called."
  ConduitT
  ()
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> AppContext ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit ConduitT
  ()
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
pipeline
  where
    pipeline :: ConduitM () Void AppContext ()
    pipeline :: ConduitT
  ()
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
pipeline = ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     SocketCommand
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ()
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     SocketCommand
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink

---------------------------------------------------------------------------------
-- |
--
src :: ConduitT () DM.SocketCommand AppContext ()
src :: ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src = AppContext SocketCommand
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     SocketCommand
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT () SocketCommand m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift AppContext SocketCommand
go ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  SocketCommand
-> (SocketCommand
    -> ConduitT
         ()
         SocketCommand
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         ()
         SocketCommand
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SocketCommand
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     ()
     SocketCommand
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  ()
  SocketCommand
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
src
  where
    go :: AppContext DM.SocketCommand
    go :: AppContext SocketCommand
go = do
      TQueue SocketCommand
queue <- Getting (TQueue SocketCommand) DomainData (TQueue SocketCommand)
-> DomainData -> TQueue SocketCommand
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue SocketCommand) DomainData (TQueue SocketCommand)
Lens' DomainData (TQueue SocketCommand)
DM.socketQueueDomainData (DomainData -> TQueue SocketCommand)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue SocketCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
      SocketCommand
dat <- IO SocketCommand -> AppContext SocketCommand
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketCommand -> AppContext SocketCommand)
-> IO SocketCommand -> AppContext SocketCommand
forall a b. (a -> b) -> a -> b
$ STM SocketCommand -> IO SocketCommand
forall a. STM a -> IO a
STM.atomically (STM SocketCommand -> IO SocketCommand)
-> STM SocketCommand -> IO SocketCommand
forall a b. (a -> b) -> a -> b
$ TQueue SocketCommand -> STM SocketCommand
forall a. TQueue a -> STM a
STM.readTQueue TQueue SocketCommand
queue
      SocketCommand -> AppContext SocketCommand
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return SocketCommand
dat

---------------------------------------------------------------------------------
-- |
--
cmd2task :: ConduitT DM.SocketCommand (IOTask ()) AppContext ()
cmd2task :: ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task = ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe SocketCommand)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe SocketCommand)
-> (Maybe SocketCommand
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just SocketCommand
cmd -> (ConduitT
   SocketCommand
   (IOTask ())
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ([Char]
     -> ConduitT
          SocketCommand
          (IOTask ())
          (ReaderT
             AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
          ())
 -> ConduitT
      SocketCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ([Char]
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ([Char]
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a.
ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ([Char]
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         a)
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (SocketCommand
-> [Char]
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl SocketCommand
cmd) (ConduitT
   SocketCommand
   (IOTask ())
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ConduitT
      SocketCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ do
    AppContext (IOTask ())
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     (IOTask ())
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT SocketCommand (IOTask ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SocketCommand -> AppContext (IOTask ())
go SocketCommand
cmd) ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (IOTask ())
-> (IOTask ()
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         SocketCommand
         (IOTask ())
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOTask ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task
  Maybe SocketCommand
Nothing -> do
    $Text
-> Text
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG Text
"cmd2task: await returns nothing. skip."
    ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task

  where
    errHdl :: DM.SocketCommand -> String -> ConduitT DM.SocketCommand (IOTask ()) AppContext ()
    errHdl :: SocketCommand
-> [Char]
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl SocketCommand
socketCmd [Char]
msg = do
      let jsonrpc :: JsonRpcRequest
jsonrpc = SocketCommand -> JsonRpcRequest
DM.getJsonRpcSocketCommand SocketCommand
socketCmd
      $Text
-> Text
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG (Text
 -> ConduitT
      SocketCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> Text
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"cmd2task: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
      AppContext ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT SocketCommand (IOTask ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AppContext ()
 -> ConduitT
      SocketCommand
      (IOTask ())
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> AppContext ()
-> ConduitT
     SocketCommand
     (IOTask ())
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ JsonRpcRequest -> [Char] -> AppContext ()
errorToolsCallResponse JsonRpcRequest
jsonrpc ([Char] -> AppContext ()) -> [Char] -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char]
"cmd2task: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
      ConduitT
  SocketCommand
  (IOTask ())
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
cmd2task

    go :: DM.SocketCommand -> AppContext (IOTask ())
    go :: SocketCommand -> AppContext (IOTask ())
go (DM.SocketEchoCommand SocketEchoCommandData
dat)    = SocketEchoCommandData -> AppContext (IOTask ())
genEchoTask SocketEchoCommandData
dat
    go (DM.SocketOpenCommand SocketOpenCommandData
dat)    = SocketOpenCommandData -> AppContext (IOTask ())
genSocketOpenTask SocketOpenCommandData
dat
    go (DM.SocketCloseCommand SocketCloseCommandData
dat)   = SocketCloseCommandData -> AppContext (IOTask ())
genSocketCloseTask SocketCloseCommandData
dat
    go (DM.SocketReadCommand SocketReadCommandData
dat)    = SocketReadCommandData -> AppContext (IOTask ())
genSocketReadTask SocketReadCommandData
dat
    go (DM.SocketWriteCommand SocketWriteCommandData
dat)   = SocketWriteCommandData -> AppContext (IOTask ())
genSocketWriteTask SocketWriteCommandData
dat
    go (DM.SocketMessageCommand SocketMessageCommandData
dat) = SocketMessageCommandData -> AppContext (IOTask ())
genSocketMessageTask SocketMessageCommandData
dat
    go (DM.SocketTelnetCommand SocketTelnetCommandData
dat)  = SocketTelnetCommandData -> AppContext (IOTask ())
genSocketTelnetTask SocketTelnetCommandData
dat

---------------------------------------------------------------------------------
-- |
--
sink :: ConduitT (IOTask ()) Void AppContext ()
sink :: ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink = ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe (IOTask ()))
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  (Maybe (IOTask ()))
-> (Maybe (IOTask ())
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> (a
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         b)
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just IOTask ()
req -> (ConduitT
   (IOTask ())
   Void
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ([Char]
     -> ConduitT
          (IOTask ())
          Void
          (ReaderT
             AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
          ())
 -> ConduitT
      (IOTask ())
      Void
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ([Char]
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ([Char]
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a.
ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ([Char]
    -> ConduitT
         (IOTask ())
         Void
         (ReaderT
            AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
         a)
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError [Char]
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl (ConduitT
   (IOTask ())
   Void
   (ReaderT
      AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
   ()
 -> ConduitT
      (IOTask ())
      Void
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ do
    AppContext ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (IOTask ()) Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOTask () -> AppContext ()
go IOTask ()
req) ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b.
ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  a
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink
  Maybe (IOTask ())
Nothing -> do
    $Text
-> Text
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG Text
"sink: await returns nothing. skip."
    ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink

  where
    errHdl :: String -> ConduitT (IOTask ()) Void AppContext ()
    errHdl :: [Char]
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
errHdl [Char]
msg = do
      $Text
-> Text
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
logWarnS Text
DM._LOGTAG (Text
 -> ConduitT
      (IOTask ())
      Void
      (ReaderT
         AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
      ())
-> Text
-> ConduitT
     (IOTask ())
     Void
     (ReaderT
        AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
     ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"sink: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
      ConduitT
  (IOTask ())
  Void
  (ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
  ()
sink

    go :: (IO ()) -> AppContext ()
    go :: IOTask () -> AppContext ()
go IOTask ()
task = do
      $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"sink: start async."
      Async ()
_ <- IO (Async ()) -> AppContext (Async ())
forall a.
IO a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO (Async ()) -> AppContext (Async ()))
-> IO (Async ()) -> AppContext (Async ())
forall a b. (a -> b) -> a -> b
$ IOTask () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IOTask ()
task
      $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"sink: end async."
      () -> AppContext ()
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


---------------------------------------------------------------------------------
-- |
--
genEchoTask :: DM.SocketEchoCommandData -> AppContext (IOTask ())
genEchoTask :: SocketEchoCommandData -> AppContext (IOTask ())
genEchoTask SocketEchoCommandData
dat = do
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  let val :: [Char]
val = SocketEchoCommandData
datSocketEchoCommandData
-> Getting [Char] SocketEchoCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] SocketEchoCommandData [Char]
Lens' SocketEchoCommandData [Char]
DM.valueSocketEchoCommandData

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"echoTask: echo : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ TQueue McpResponse -> SocketEchoCommandData -> [Char] -> IOTask ()
echoTask TQueue McpResponse
resQ SocketEchoCommandData
dat [Char]
val


-- |
--
echoTask :: STM.TQueue DM.McpResponse -> DM.SocketEchoCommandData -> String -> IOTask ()
echoTask :: TQueue McpResponse -> SocketEchoCommandData -> [Char] -> IOTask ()
echoTask TQueue McpResponse
resQ SocketEchoCommandData
cmdDat [Char]
val = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.echoTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val

  TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketEchoCommandData
cmdDatSocketEchoCommandData
-> Getting JsonRpcRequest SocketEchoCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketEchoCommandData JsonRpcRequest
Lens' SocketEchoCommandData JsonRpcRequest
DM.jsonrpcSocketEchoCommandData) ExitCode
ExitSuccess [Char]
val [Char]
""

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.echoTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketEchoCommandData
cmdDatSocketEchoCommandData
-> Getting JsonRpcRequest SocketEchoCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketEchoCommandData JsonRpcRequest
Lens' SocketEchoCommandData JsonRpcRequest
DM.jsonrpcSocketEchoCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

-- |
--
genSocketOpenTask :: DM.SocketOpenCommandData -> AppContext (IOTask ())
genSocketOpenTask :: SocketOpenCommandData -> AppContext (IOTask ())
genSocketOpenTask SocketOpenCommandData
cmdDat = do
  let argsBS :: ByteString
argsBS   = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SocketOpenCommandData
cmdDatSocketOpenCommandData
-> Getting
     RawJsonByteString SocketOpenCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting RawJsonByteString SocketOpenCommandData RawJsonByteString
Lens' SocketOpenCommandData RawJsonByteString
DM.argumentsSocketOpenCommandData

  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe Socket)
socketMVar <- Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
-> AppData -> TMVar (Maybe Socket)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
Lens' AppData (TMVar (Maybe Socket))
socketAppData (AppData -> TMVar (Maybe Socket))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe Socket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  SocketToolParams
argsDat <- Either [Char] SocketToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] SocketToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      SocketToolParams)
-> Either [Char] SocketToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] SocketToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] SocketToolParams)
-> ByteString -> Either [Char] SocketToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  let host :: [Char]
host = SocketToolParams
argsDatSocketToolParams
-> Getting [Char] SocketToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] SocketToolParams [Char]
Lens' SocketToolParams [Char]
hostSocketToolParams
      port :: [Char]
port = SocketToolParams
argsDatSocketToolParams
-> Getting [Char] SocketToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] SocketToolParams [Char]
Lens' SocketToolParams [Char]
portSocketToolParams

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genSocketOpenTask: cmd. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
host [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
port
 
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ SocketOpenCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> [Char]
-> [Char]
-> IOTask ()
socketOpenTask SocketOpenCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketMVar [Char]
host [Char]
port


-- |
--   
socketOpenTask :: DM.SocketOpenCommandData
              -> STM.TQueue DM.McpResponse
              -> STM.TMVar (Maybe Socket)
              -> String
              -> String
              -> IOTask ()
socketOpenTask :: SocketOpenCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> [Char]
-> [Char]
-> IOTask ()
socketOpenTask SocketOpenCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketVar [Char]
host [Char]
port = do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketOpenTask start. "

  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> STM (Maybe Socket)
forall a. TMVar a -> STM a
STM.takeTMVar TMVar (Maybe Socket)
socketVar) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Socket
p -> do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe Socket) -> Maybe Socket -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe Socket)
socketVar (Maybe Socket -> STM ()) -> Maybe Socket -> STM ()
forall a b. (a -> b) -> a -> b
$ Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
p
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.socketOpenTask: socket is already connected."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketOpenCommandData
cmdDatSocketOpenCommandData
-> Getting JsonRpcRequest SocketOpenCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketOpenCommandData JsonRpcRequest
Lens' SocketOpenCommandData JsonRpcRequest
DM.jsonrpcSocketOpenCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"socket is already running."
    Maybe Socket
Nothing -> (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
      Socket
sock <- [Char] -> [Char] -> IO Socket
createSocket [Char]
host [Char]
port
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe Socket) -> Maybe Socket -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe Socket)
socketVar (Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
sock)
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketOpenCommandData
cmdDatSocketOpenCommandData
-> Getting JsonRpcRequest SocketOpenCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketOpenCommandData JsonRpcRequest
Lens' SocketOpenCommandData JsonRpcRequest
DM.jsonrpcSocketOpenCommandData) ExitCode
ExitSuccess ([Char]
"socket connected to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
host [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
port) [Char]
""

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketOpenTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe Socket) -> Maybe Socket -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe Socket)
socketVar Maybe Socket
forall a. Maybe a
Nothing
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.Socket.DS.Core.socketRunTask: exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketOpenCommandData
cmdDatSocketOpenCommandData
-> Getting JsonRpcRequest SocketOpenCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketOpenCommandData JsonRpcRequest
Lens' SocketOpenCommandData JsonRpcRequest
DM.jsonrpcSocketOpenCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

-- |
--
genSocketCloseTask :: DM.SocketCloseCommandData -> AppContext (IOTask ())
genSocketCloseTask :: SocketCloseCommandData -> AppContext (IOTask ())
genSocketCloseTask SocketCloseCommandData
dat = do
  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genSocketCloseTask called. "
  TMVar (Maybe Socket)
socketTMVar <- Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
-> AppData -> TMVar (Maybe Socket)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
Lens' AppData (TMVar (Maybe Socket))
socketAppData (AppData -> TMVar (Maybe Socket))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe Socket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ SocketCloseCommandData
-> TQueue McpResponse -> TMVar (Maybe Socket) -> IOTask ()
socketCloseTask SocketCloseCommandData
dat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar

-- |
--
socketCloseTask :: DM.SocketCloseCommandData
                  -> STM.TQueue DM.McpResponse
                  -> STM.TMVar (Maybe Socket)
                  -> IOTask ()
socketCloseTask :: SocketCloseCommandData
-> TQueue McpResponse -> TMVar (Maybe Socket) -> IOTask ()
socketCloseTask SocketCloseCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketCloseTask run. "
  let jsonRpc :: JsonRpcRequest
jsonRpc = SocketCloseCommandData
cmdDatSocketCloseCommandData
-> Getting JsonRpcRequest SocketCloseCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketCloseCommandData JsonRpcRequest
Iso' SocketCloseCommandData JsonRpcRequest
DM.jsonrpcSocketCloseCommandData

  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> Maybe Socket -> STM (Maybe Socket)
forall a. TMVar a -> a -> STM a
STM.swapTMVar TMVar (Maybe Socket)
socketTMVar Maybe Socket
forall a. Maybe a
Nothing) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Socket
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.Socket.DS.Core.socketCloseTask: socket is not started."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"socket is not started."
    Just Socket
sock -> do
      Socket -> IOTask ()
close Socket
sock
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc ExitCode
ExitSuccess [Char]
"" [Char]
"socket is teminated."
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketCloseTask closeSocket : "

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketCloseTask end."

  where
    -- |
    --
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketCloseCommandData
cmdDatSocketCloseCommandData
-> Getting JsonRpcRequest SocketCloseCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketCloseCommandData JsonRpcRequest
Iso' SocketCloseCommandData JsonRpcRequest
DM.jsonrpcSocketCloseCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)


-- |
--
genSocketReadTask :: DM.SocketReadCommandData -> AppContext (IOTask ())
genSocketReadTask :: SocketReadCommandData -> AppContext (IOTask ())
genSocketReadTask SocketReadCommandData
cmdData = do
  let argsBS :: ByteString
argsBS = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SocketReadCommandData
cmdDataSocketReadCommandData
-> Getting
     RawJsonByteString SocketReadCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting RawJsonByteString SocketReadCommandData RawJsonByteString
Lens' SocketReadCommandData RawJsonByteString
DM.argumentsSocketReadCommandData
      tout :: Int
tout = Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe Socket)
socketTMVar <- Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
-> AppData -> TMVar (Maybe Socket)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
Lens' AppData (TMVar (Maybe Socket))
socketAppData (AppData -> TMVar (Maybe Socket))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe Socket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  SocketIntToolParams
argsDat <- Either [Char] SocketIntToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketIntToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] SocketIntToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      SocketIntToolParams)
-> Either [Char] SocketIntToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketIntToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] SocketIntToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] SocketIntToolParams)
-> ByteString -> Either [Char] SocketIntToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  let size :: Int
size = SocketIntToolParams
argsDatSocketIntToolParams -> Getting Int SocketIntToolParams Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int SocketIntToolParams Int
Iso' SocketIntToolParams Int
sizeSocketIntToolParams

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genSocketReadTask: args. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ SocketReadCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> Int
-> Int
-> IOTask ()
socketReadTask SocketReadCommandData
cmdData TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar Int
size Int
tout

-- |
--
socketReadTask :: DM.SocketReadCommandData
                -> STM.TQueue DM.McpResponse
                -> STM.TMVar (Maybe Socket)
                -> Int       -- read size.
                -> Int       -- timeout microsec
                -> IOTask ()
socketReadTask :: SocketReadCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> Int
-> Int
-> IOTask ()
socketReadTask SocketReadCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar Int
size Int
tout = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketReadTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size
    
  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> STM (Maybe Socket)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe Socket)
socketTMVar) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Socket
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.Socket.DS.Core.socketReadTask: socket is not started."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"socket is not started."
    Just Socket
p -> Socket -> IOTask ()
go Socket
p

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketReadTask end."

  where
    jsonRpc :: DM.JsonRpcRequest
    jsonRpc :: JsonRpcRequest
jsonRpc = SocketReadCommandData
cmdDatSocketReadCommandData
-> Getting JsonRpcRequest SocketReadCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketReadCommandData JsonRpcRequest
Lens' SocketReadCommandData JsonRpcRequest
DM.jsonrpcSocketReadCommandData

    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

    go :: Socket -> IO ()
    go :: Socket -> IOTask ()
go Socket
sock =
      IO ByteString -> IOTask () -> IO (Either ByteString ())
forall a b. IO a -> IO b -> IO (Either a b)
race (Socket -> Int -> IO ByteString
readSizeSocket Socket
sock Int
size) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either ByteString ())
-> (Either ByteString () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ByteString
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc ExitCode
ExitSuccess (ByteString -> [Char]
bytesToHex ByteString
res) [Char]
""
        Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."


-- |
--
genSocketWriteTask :: DM.SocketWriteCommandData -> AppContext (IOTask ())
genSocketWriteTask :: SocketWriteCommandData -> AppContext (IOTask ())
genSocketWriteTask SocketWriteCommandData
cmdData = do
  let argsBS :: ByteString
argsBS = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SocketWriteCommandData
cmdDataSocketWriteCommandData
-> Getting
     RawJsonByteString SocketWriteCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting RawJsonByteString SocketWriteCommandData RawJsonByteString
Lens' SocketWriteCommandData RawJsonByteString
DM.argumentsSocketWriteCommandData
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe Socket)
socketTMVar <- Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
-> AppData -> TMVar (Maybe Socket)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
Lens' AppData (TMVar (Maybe Socket))
socketAppData (AppData -> TMVar (Maybe Socket))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe Socket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  SocketWord8ArrayToolParams
argsDat <- Either [Char] SocketWord8ArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketWord8ArrayToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] SocketWord8ArrayToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      SocketWord8ArrayToolParams)
-> Either [Char] SocketWord8ArrayToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketWord8ArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] SocketWord8ArrayToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] SocketWord8ArrayToolParams)
-> ByteString -> Either [Char] SocketWord8ArrayToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  let args :: [Word8]
args = SocketWord8ArrayToolParams
argsDatSocketWord8ArrayToolParams
-> Getting [Word8] SocketWord8ArrayToolParams [Word8] -> [Word8]
forall s a. s -> Getting a s a -> a
^.Getting [Word8] SocketWord8ArrayToolParams [Word8]
Iso' SocketWord8ArrayToolParams [Word8]
dataSocketWord8ArrayToolParams

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genSocketWriteTask: args. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Char]
forall a. Show a => a -> [Char]
show [Word8]
args
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ SocketWriteCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> [Word8]
-> IOTask ()
socketWriteTask SocketWriteCommandData
cmdData TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar [Word8]
args

-- |
--
socketWriteTask :: DM.SocketWriteCommandData
                -> STM.TQueue DM.McpResponse
                -> STM.TMVar (Maybe Socket)
                -> [Word8]
                -> IOTask ()
socketWriteTask :: SocketWriteCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> [Word8]
-> IOTask ()
socketWriteTask SocketWriteCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar [Word8]
args = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketWriteTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Word8] -> [Char]
forall a. Show a => a -> [Char]
show [Word8]
args
    
  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> STM (Maybe Socket)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe Socket)
socketTMVar) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Socket
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.Socket.DS.Core.socketWriteTask: socket is not started."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"socket is not started."
    Just Socket
p -> Socket -> IOTask ()
go Socket
p

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketWriteTask end."

  where
    jsonRpc :: DM.JsonRpcRequest
    jsonRpc :: JsonRpcRequest
jsonRpc = SocketWriteCommandData
cmdDatSocketWriteCommandData
-> Getting JsonRpcRequest SocketWriteCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketWriteCommandData JsonRpcRequest
Lens' SocketWriteCommandData JsonRpcRequest
DM.jsonrpcSocketWriteCommandData

    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

    go :: Socket -> IO ()
    go :: Socket -> IOTask ()
go Socket
sock = do
      let bsDat :: ByteString
bsDat = [Word8] -> ByteString
B.pack [Word8]
args

      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketWriteTask writeSocket (hex): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
bytesToHex ByteString
bsDat

      Socket -> ByteString -> IOTask ()
writeSocket Socket
sock ByteString
bsDat

      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc ExitCode
ExitSuccess ([Char]
"write data to socket. "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
bytesToHex ByteString
bsDat) [Char]
""


-- |
--
genSocketMessageTask :: DM.SocketMessageCommandData -> AppContext (IOTask ())
genSocketMessageTask :: SocketMessageCommandData -> AppContext (IOTask ())
genSocketMessageTask SocketMessageCommandData
cmdData = do
  let argsBS :: ByteString
argsBS = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SocketMessageCommandData
cmdDataSocketMessageCommandData
-> Getting
     RawJsonByteString SocketMessageCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting
  RawJsonByteString SocketMessageCommandData RawJsonByteString
Lens' SocketMessageCommandData RawJsonByteString
DM.argumentsSocketMessageCommandData
      tout :: Int
tout = Int
DM._TIMEOUT_MICROSEC
  [[Char]]
prompts <- Getting [[Char]] DomainData [[Char]] -> DomainData -> [[Char]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [[Char]] DomainData [[Char]]
Lens' DomainData [[Char]]
DM.promptsDomainData (DomainData -> [[Char]])
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe Socket)
socketTMVar <- Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
-> AppData -> TMVar (Maybe Socket)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
Lens' AppData (TMVar (Maybe Socket))
socketAppData (AppData -> TMVar (Maybe Socket))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe Socket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar ()
lockTMVar <- Getting (TMVar ()) AppData (TMVar ()) -> AppData -> TMVar ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar ()) AppData (TMVar ())
Lens' AppData (TMVar ())
lockAppData (AppData -> TMVar ())
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  SocketStringToolParams
argsDat <- Either [Char] SocketStringToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketStringToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] SocketStringToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      SocketStringToolParams)
-> Either [Char] SocketStringToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketStringToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] SocketStringToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] SocketStringToolParams)
-> ByteString -> Either [Char] SocketStringToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  let args :: [Char]
args = SocketStringToolParams
argsDatSocketStringToolParams
-> Getting [Char] SocketStringToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] SocketStringToolParams [Char]
Iso' SocketStringToolParams [Char]
argumentsSocketStringToolParams

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genSocketMessageTask: args. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
args
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ SocketMessageCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> TMVar ()
-> [Char]
-> [[Char]]
-> Int
-> IOTask ()
socketMessageTask SocketMessageCommandData
cmdData TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar TMVar ()
lockTMVar [Char]
args [[Char]]
prompts Int
tout

-- |
--
socketMessageTask :: DM.SocketMessageCommandData
                -> STM.TQueue DM.McpResponse
                -> STM.TMVar (Maybe Socket)
                -> STM.TMVar ()
                -> String  -- arguments line
                -> [String]  -- prompt list
                -> Int       -- timeout microsec
                -> IOTask ()
socketMessageTask :: SocketMessageCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> TMVar ()
-> [Char]
-> [[Char]]
-> Int
-> IOTask ()
socketMessageTask SocketMessageCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketTMVar TMVar ()
lockTMVar [Char]
args [[Char]]
prompts Int
tout = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketMessageTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
args
    
  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> STM (Maybe Socket)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe Socket)
socketTMVar) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Socket
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infra.Socket.DS.Core.socketMessageTask: socket is not started."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"socket is not started."
    Just Socket
p -> Socket -> IOTask ()
go Socket
p

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketMessageTask end."

  where
    jsonRpc :: DM.JsonRpcRequest
    jsonRpc :: JsonRpcRequest
jsonRpc = SocketMessageCommandData
cmdDatSocketMessageCommandData
-> Getting JsonRpcRequest SocketMessageCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketMessageCommandData JsonRpcRequest
Lens' SocketMessageCommandData JsonRpcRequest
DM.jsonrpcSocketMessageCommandData

    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)

    go :: Socket -> IO ()
    go :: Socket -> IOTask ()
go Socket
sock = do

      [Char]
msg <- [Char] -> IO [Char]
DM.validateMessage [Char]
args
      let cmd :: ByteString
cmd = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
msg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
DM._CRLF

      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketMessageTask writeSocket : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BS8.unpack ByteString
cmd

      Socket -> ByteString -> IOTask ()
writeSocket Socket
sock ByteString
cmd

      IO (Maybe [Char]) -> IOTask () -> IO (Either (Maybe [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (TMVar () -> IO ByteString -> [[Char]] -> IO (Maybe [Char])
DM.expect TMVar ()
lockTMVar (Socket -> IO ByteString
readTelnetSocket Socket
sock) [[Char]]
prompts) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (Maybe [Char]) ())
-> (Either (Maybe [Char]) () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Maybe [Char]
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc ExitCode
ExitSuccess ([Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Nothing" [Char] -> [Char]
forall a. a -> a
id Maybe [Char]
res) [Char]
""
        Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ JsonRpcRequest
jsonRpc (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."



-- |
--
genSocketTelnetTask :: DM.SocketTelnetCommandData -> AppContext (IOTask ())
genSocketTelnetTask :: SocketTelnetCommandData -> AppContext (IOTask ())
genSocketTelnetTask SocketTelnetCommandData
cmdDat = do
  let argsBS :: ByteString
argsBS   = RawJsonByteString -> ByteString
DM.unRawJsonByteString (RawJsonByteString -> ByteString)
-> RawJsonByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SocketTelnetCommandData
cmdDatSocketTelnetCommandData
-> Getting
     RawJsonByteString SocketTelnetCommandData RawJsonByteString
-> RawJsonByteString
forall s a. s -> Getting a s a -> a
^.Getting RawJsonByteString SocketTelnetCommandData RawJsonByteString
Lens' SocketTelnetCommandData RawJsonByteString
DM.argumentsSocketTelnetCommandData
      tout :: Int
tout     = Int
DM._TIMEOUT_MICROSEC

  [[Char]]
prompts <- Getting [[Char]] DomainData [[Char]] -> DomainData -> [[Char]]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [[Char]] DomainData [[Char]]
Lens' DomainData [[Char]]
DM.promptsDomainData (DomainData -> [[Char]])
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TQueue McpResponse
resQ <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar (Maybe Socket)
socketMVar <- Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
-> AppData -> TMVar (Maybe Socket)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar (Maybe Socket)) AppData (TMVar (Maybe Socket))
Lens' AppData (TMVar (Maybe Socket))
socketAppData (AppData -> TMVar (Maybe Socket))
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar (Maybe Socket))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
  TMVar ()
lockTMVar <- Getting (TMVar ()) AppData (TMVar ()) -> AppData -> TMVar ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar ()) AppData (TMVar ())
Lens' AppData (TMVar ())
lockAppData (AppData -> TMVar ())
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     (TMVar ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask

  SocketToolParams
argsDat <- Either [Char] SocketToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketToolParams
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] SocketToolParams
 -> ReaderT
      AppData
      (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
      SocketToolParams)
-> Either [Char] SocketToolParams
-> ReaderT
     AppData
     (ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
     SocketToolParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] SocketToolParams
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode (ByteString -> Either [Char] SocketToolParams)
-> ByteString -> Either [Char] SocketToolParams
forall a b. (a -> b) -> a -> b
$ ByteString
argsBS
  let host :: [Char]
host = SocketToolParams
argsDatSocketToolParams
-> Getting [Char] SocketToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] SocketToolParams [Char]
Lens' SocketToolParams [Char]
hostSocketToolParams
      port :: [Char]
port = SocketToolParams
argsDatSocketToolParams
-> Getting [Char] SocketToolParams [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] SocketToolParams [Char]
Lens' SocketToolParams [Char]
portSocketToolParams
      addPrompts :: [[Char]]
addPrompts = [[Char]
"login:"]

  $Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"genSocketTelnetTask: cmd. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
host [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
port
 
  IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
     AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ SocketTelnetCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> TMVar ()
-> [Char]
-> [Char]
-> [[Char]]
-> Int
-> IOTask ()
socketTelnetTask SocketTelnetCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketMVar TMVar ()
lockTMVar [Char]
host [Char]
port ([[Char]]
prompts[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++[[Char]]
addPrompts) Int
tout


-- |
--   
socketTelnetTask :: DM.SocketTelnetCommandData
              -> STM.TQueue DM.McpResponse
              -> STM.TMVar (Maybe Socket)
              -> STM.TMVar ()
              -> String
              -> String
              -> [String]
              -> Int
              -> IOTask ()
socketTelnetTask :: SocketTelnetCommandData
-> TQueue McpResponse
-> TMVar (Maybe Socket)
-> TMVar ()
-> [Char]
-> [Char]
-> [[Char]]
-> Int
-> IOTask ()
socketTelnetTask SocketTelnetCommandData
cmdDat TQueue McpResponse
resQ TMVar (Maybe Socket)
socketVar TMVar ()
lockTMVar [Char]
host [Char]
port [[Char]]
prompts Int
tout = do
  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketTelnetTask start. "

  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> STM (Maybe Socket)
forall a. TMVar a -> STM a
STM.takeTMVar TMVar (Maybe Socket)
socketVar) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Socket
p -> do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe Socket) -> Maybe Socket -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe Socket)
socketVar (Maybe Socket -> STM ()) -> Maybe Socket -> STM ()
forall a b. (a -> b) -> a -> b
$ Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
p
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.socketTelnetTask: socket is already connected."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketTelnetCommandData
cmdDatSocketTelnetCommandData
-> Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
Lens' SocketTelnetCommandData JsonRpcRequest
DM.jsonrpcSocketTelnetCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"socket is already running."
    Maybe Socket
Nothing -> (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
      Socket
sock <- [Char] -> [Char] -> IO Socket
createSocket [Char]
host [Char]
port
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe Socket) -> Maybe Socket -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe Socket)
socketVar (Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
sock)

  STM (Maybe Socket) -> IO (Maybe Socket)
forall a. STM a -> IO a
STM.atomically (TMVar (Maybe Socket) -> STM (Maybe Socket)
forall a. TMVar a -> STM a
STM.readTMVar TMVar (Maybe Socket)
socketVar) IO (Maybe Socket) -> (Maybe Socket -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Socket
p -> IO (Maybe [Char]) -> IOTask () -> IO (Either (Maybe [Char]) ())
forall a b. IO a -> IO b -> IO (Either a b)
race (TMVar () -> IO ByteString -> [[Char]] -> IO (Maybe [Char])
DM.expect TMVar ()
lockTMVar (Socket -> IO ByteString
readTelnetSocket Socket
p) [[Char]]
prompts) (Int -> IOTask ()
CC.threadDelay Int
tout) IO (Either (Maybe [Char]) ())
-> (Either (Maybe [Char]) () -> IOTask ()) -> IOTask ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left Maybe [Char]
res -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketTelnetCommandData
cmdDatSocketTelnetCommandData
-> Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
Lens' SocketTelnetCommandData JsonRpcRequest
DM.jsonrpcSocketTelnetCommandData) ExitCode
ExitSuccess ([Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"Nothing" [Char] -> [Char]
forall a. a -> a
id Maybe [Char]
res) [Char]
""
      Right ()
_  -> TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketTelnetCommandData
cmdDatSocketTelnetCommandData
-> Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
Lens' SocketTelnetCommandData JsonRpcRequest
DM.jsonrpcSocketTelnetCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"timeout occurred."
    Maybe Socket
Nothing -> do
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[ERROR] PMS.Infrastructure.DS.Core.socketTelnetTask: unexpected. socket not found."
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketTelnetCommandData
cmdDatSocketTelnetCommandData
-> Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
Lens' SocketTelnetCommandData JsonRpcRequest
DM.jsonrpcSocketTelnetCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" [Char]
"unexpected. socket not found."

  Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Socket.DS.Core.socketTelnetTask end."

  where
    errHdl :: E.SomeException -> IO ()
    errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = do
      STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TMVar (Maybe Socket) -> Maybe Socket -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar (Maybe Socket)
socketVar Maybe Socket
forall a. Maybe a
Nothing
      Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.Socket.DS.Core.socketTelnetTask: exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
      TQueue McpResponse
-> JsonRpcRequest -> ExitCode -> [Char] -> [Char] -> IOTask ()
toolsCallResponse TQueue McpResponse
resQ (SocketTelnetCommandData
cmdDatSocketTelnetCommandData
-> Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest SocketTelnetCommandData JsonRpcRequest
Lens' SocketTelnetCommandData JsonRpcRequest
DM.jsonrpcSocketTelnetCommandData) (Int -> ExitCode
ExitFailure Int
1) [Char]
"" (SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e)