module Marvin.Adapter.Telegram.Poll
( TelegramAdapter, Poll
, TelegramChat(..), ChatType(..)
, TelegramUser(..)
, MkTelegram
) where
import Control.Concurrent.Chan.Lifted
import Control.Concurrent.Lifted
import Control.Lens
import Control.Monad
import Control.Monad.Logger
import Data.Aeson hiding (Error, Success)
import Data.Aeson.Types hiding (Error, Success)
import Data.IORef.Lifted
import Marvin.Adapter
import Marvin.Adapter.Telegram.Common
import Marvin.Interpolate.Text
import Network.HTTP.Client (managerResponseTimeout)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.Wreq
#if MIN_VERSION_http_client(0,5,0)
import Network.HTTP.Client (responseTimeoutMicro)
#else
responseTimeoutMicro = Just
#endif
data UpdateWithId = UpdateWithId {updateId :: Integer, updateContent :: TelegramUpdate Poll }
instance FromJSON UpdateWithId where
parseJSON = withObject "expected object" $ \o -> UpdateWithId <$> o .: "update_id" <*> parseJSON (Object o)
pollEventGetter :: Chan (TelegramUpdate Poll) -> AdapterM (TelegramAdapter Poll) ()
pollEventGetter msgChan = do
idRef <- newIORef Nothing
forever $ do
timeout <- lookupFromAdapterConfig "polling-timeout" >>= readTimeout
let defParams = ["timeout" := (timeout :: Int) ]
nextId <- readIORef idRef
let pollSettings = defaults & manager . _Left .~ tlsManagerSettings { managerResponseTimeout = responseTimeoutMicro ((timeout + 3) * 1000)}
response <- execAPIMethodWith pollSettings parseJSON "getUpdates" $ maybe defParams ((:defParams) . ("offset" :=)) nextId
case response of
Left err -> do
logErrorN $(isT "Unable to parse json: #{err}")
threadDelay 30000
Right (Error code desc) -> do
logErrorN $(isT "Sending message failed with #{code}: #{desc}")
threadDelay 30000
Right Success {result=[]} -> return ()
Right Success {result=updates} -> do
writeIORef idRef $ Just $ succ $ maximum $ map updateId updates
logDebugN "Writing messages"
writeList2Chan msgChan $ map updateContent updates
where
defaultTimeout = 120
readTimeout Nothing = return defaultTimeout
readTimeout (Just n)
| n < 0 = do
logErrorN $(isT "Telegram adapter poll timeout must be positive, was #{n} (using default timeout instead)")
return defaultTimeout
| otherwise = return n
data Poll
instance MkTelegram Poll where
mkAdapterId = "telegram-poll"
mkEventGetter = pollEventGetter