never executed always true always false

    1 module PureClaw.Channels.Signal
    2   ( -- * Signal channel
    3     SignalChannel (..)
    4   , SignalConfig (..)
    5   , mkSignalChannel
    6     -- * Message parsing
    7   , parseSignalEnvelope
    8   , SignalEnvelope (..)
    9   , SignalDataMessage (..)
   10   ) where
   11 
   12 import Control.Concurrent.STM
   13 import Data.Aeson
   14 import Data.Text (Text)
   15 import Data.Text qualified as T
   16 
   17 import PureClaw.Channels.Class
   18 import PureClaw.Core.Errors
   19 import PureClaw.Core.Types
   20 import PureClaw.Handles.Channel
   21 import PureClaw.Handles.Log
   22 
   23 -- | Configuration for Signal channel.
   24 newtype SignalConfig = SignalConfig
   25   { _sc_account :: Text
   26   }
   27   deriving stock (Show, Eq)
   28 
   29 -- | A Signal channel backed by a message queue. Messages from signal-cli
   30 -- are pushed into the queue and the agent loop pulls them out via 'receive'.
   31 data SignalChannel = SignalChannel
   32   { _sch_config :: SignalConfig
   33   , _sch_inbox  :: TQueue SignalEnvelope
   34   , _sch_log    :: LogHandle
   35   }
   36 
   37 -- | Create a Signal channel with an empty inbox.
   38 mkSignalChannel :: SignalConfig -> LogHandle -> IO SignalChannel
   39 mkSignalChannel config lh = do
   40   inbox <- newTQueueIO
   41   pure SignalChannel
   42     { _sch_config = config
   43     , _sch_inbox  = inbox
   44     , _sch_log    = lh
   45     }
   46 
   47 instance Channel SignalChannel where
   48   toHandle sc = ChannelHandle
   49     { _ch_receive   = receiveEnvelope sc
   50     , _ch_send      = sendSignalMessage sc
   51     , _ch_sendError = sendSignalError sc
   52     }
   53 
   54 -- | Block until a Signal envelope arrives in the queue.
   55 receiveEnvelope :: SignalChannel -> IO IncomingMessage
   56 receiveEnvelope sc = do
   57   envelope <- atomically $ readTQueue (_sch_inbox sc)
   58   let sender = _se_source envelope
   59       content = maybe "" _sdm_message (_se_dataMessage envelope)
   60   pure IncomingMessage
   61     { _im_userId  = UserId sender
   62     , _im_content = content
   63     }
   64 
   65 -- | Send a message via Signal. In a full implementation this would
   66 -- invoke signal-cli. For now, logs the outgoing message.
   67 sendSignalMessage :: SignalChannel -> OutgoingMessage -> IO ()
   68 sendSignalMessage sc msg =
   69   _lh_logInfo (_sch_log sc) $ "Signal send: " <> _om_content msg
   70 
   71 -- | Send an error via Signal.
   72 sendSignalError :: SignalChannel -> PublicError -> IO ()
   73 sendSignalError sc err =
   74   _lh_logWarn (_sch_log sc) $ "Signal error: " <> T.pack (show err)
   75 
   76 -- | A Signal envelope (simplified JSON-RPC format from signal-cli).
   77 data SignalEnvelope = SignalEnvelope
   78   { _se_source      :: Text
   79   , _se_timestamp   :: Int
   80   , _se_dataMessage :: Maybe SignalDataMessage
   81   }
   82   deriving stock (Show, Eq)
   83 
   84 -- | A Signal data message.
   85 data SignalDataMessage = SignalDataMessage
   86   { _sdm_message   :: Text
   87   , _sdm_timestamp :: Int
   88   }
   89   deriving stock (Show, Eq)
   90 
   91 instance FromJSON SignalEnvelope where
   92   parseJSON = withObject "SignalEnvelope" $ \o ->
   93     SignalEnvelope <$> o .: "source" <*> o .: "timestamp" <*> o .:? "dataMessage"
   94 
   95 instance FromJSON SignalDataMessage where
   96   parseJSON = withObject "SignalDataMessage" $ \o ->
   97     SignalDataMessage <$> o .: "message" <*> o .: "timestamp"
   98 
   99 -- | Parse a JSON value as a Signal envelope.
  100 parseSignalEnvelope :: Value -> Either String SignalEnvelope
  101 parseSignalEnvelope v = case fromJSON v of
  102   Error err -> Left err
  103   Success e -> Right e