never executed always true always false

    1 module PureClaw.Channels.Telegram
    2   ( -- * Telegram channel
    3     TelegramChannel (..)
    4   , TelegramConfig (..)
    5   , mkTelegramChannel
    6     -- * Message parsing
    7   , parseTelegramUpdate
    8   , TelegramUpdate (..)
    9   , TelegramMessage (..)
   10   , TelegramChat (..)
   11   , TelegramUser (..)
   12   ) where
   13 
   14 import Control.Concurrent.STM
   15 import Data.Aeson
   16 import Data.Text (Text)
   17 import Data.Text qualified as T
   18 
   19 import PureClaw.Channels.Class
   20 import PureClaw.Core.Errors
   21 import PureClaw.Core.Types
   22 import PureClaw.Handles.Channel
   23 import PureClaw.Handles.Log
   24 import PureClaw.Handles.Network
   25 
   26 -- | Configuration for Telegram channel.
   27 data TelegramConfig = TelegramConfig
   28   { _tc_botToken :: Text
   29   , _tc_apiBase  :: Text
   30   }
   31   deriving stock (Show, Eq)
   32 
   33 -- | A Telegram channel backed by a message queue. Updates are pushed
   34 -- into the queue (e.g. from a webhook endpoint) and the agent loop
   35 -- pulls them out via 'receive'. Responses are sent via the Telegram
   36 -- Bot API using the provided 'NetworkHandle'.
   37 data TelegramChannel = TelegramChannel
   38   { _tch_config  :: TelegramConfig
   39   , _tch_inbox   :: TQueue TelegramUpdate
   40   , _tch_network :: NetworkHandle
   41   , _tch_log     :: LogHandle
   42   }
   43 
   44 -- | Create a Telegram channel with an empty inbox.
   45 mkTelegramChannel :: TelegramConfig -> NetworkHandle -> LogHandle -> IO TelegramChannel
   46 mkTelegramChannel config nh lh = do
   47   inbox <- newTQueueIO
   48   pure TelegramChannel
   49     { _tch_config  = config
   50     , _tch_inbox   = inbox
   51     , _tch_network = nh
   52     , _tch_log     = lh
   53     }
   54 
   55 instance Channel TelegramChannel where
   56   toHandle tc = ChannelHandle
   57     { _ch_receive   = receiveUpdate tc
   58     , _ch_send      = sendMessage tc
   59     , _ch_sendError = sendTelegramError tc
   60     }
   61 
   62 -- | Block until a Telegram update arrives in the queue.
   63 receiveUpdate :: TelegramChannel -> IO IncomingMessage
   64 receiveUpdate tc = do
   65   update <- atomically $ readTQueue (_tch_inbox tc)
   66   let msg = _tu_message update
   67       userId = T.pack (show (_tu_id (_tm_from msg)))
   68       content = _tm_text msg
   69   pure IncomingMessage
   70     { _im_userId  = UserId userId
   71     , _im_content = content
   72     }
   73 
   74 -- | Send a message to the chat that the last update came from.
   75 -- In a full implementation this would POST to the Telegram sendMessage API.
   76 -- For now, logs the outgoing message.
   77 sendMessage :: TelegramChannel -> OutgoingMessage -> IO ()
   78 sendMessage tc msg =
   79   _lh_logInfo (_tch_log tc) $ "Telegram send: " <> _om_content msg
   80 
   81 -- | Send an error to the Telegram chat.
   82 sendTelegramError :: TelegramChannel -> PublicError -> IO ()
   83 sendTelegramError tc err =
   84   _lh_logWarn (_tch_log tc) $ "Telegram error: " <> T.pack (show err)
   85 
   86 -- | A Telegram Update object (simplified).
   87 data TelegramUpdate = TelegramUpdate
   88   { _tu_updateId :: Int
   89   , _tu_message  :: TelegramMessage
   90   }
   91   deriving stock (Show, Eq)
   92 
   93 -- | A Telegram Message object (simplified).
   94 data TelegramMessage = TelegramMessage
   95   { _tm_messageId :: Int
   96   , _tm_from      :: TelegramUser
   97   , _tm_chat      :: TelegramChat
   98   , _tm_text      :: Text
   99   }
  100   deriving stock (Show, Eq)
  101 
  102 -- | A Telegram Chat object (simplified).
  103 data TelegramChat = TelegramChat
  104   { _tcht_id   :: Int
  105   , _tcht_type :: Text
  106   }
  107   deriving stock (Show, Eq)
  108 
  109 -- | A Telegram User object (simplified).
  110 data TelegramUser = TelegramUser
  111   { _tu_id        :: Int
  112   , _tu_firstName :: Text
  113   }
  114   deriving stock (Show, Eq)
  115 
  116 instance FromJSON TelegramUpdate where
  117   parseJSON = withObject "TelegramUpdate" $ \o ->
  118     TelegramUpdate <$> o .: "update_id" <*> o .: "message"
  119 
  120 instance FromJSON TelegramMessage where
  121   parseJSON = withObject "TelegramMessage" $ \o ->
  122     TelegramMessage <$> o .: "message_id" <*> o .: "from" <*> o .: "chat" <*> o .: "text"
  123 
  124 instance FromJSON TelegramChat where
  125   parseJSON = withObject "TelegramChat" $ \o ->
  126     TelegramChat <$> o .: "id" <*> o .: "type"
  127 
  128 instance FromJSON TelegramUser where
  129   parseJSON = withObject "TelegramUser" $ \o ->
  130     TelegramUser <$> o .: "id" <*> o .: "first_name"
  131 
  132 -- | Parse a JSON value as a Telegram update.
  133 parseTelegramUpdate :: Value -> Either String TelegramUpdate
  134 parseTelegramUpdate v = case fromJSON v of
  135   Error err   -> Left err
  136   Success upd -> Right upd