{-# LANGUAGE RecordWildCards #-}
module Telegram.Bot.Simple.BotApp (
BotApp(..),
BotJob(..),
WebhookConfig(..),
startBot,
startBot_,
startBotAsync,
startBotAsync_,
startBotWebhook,
startBotWebhook_,
getEnvToken,
) where
import Control.Concurrent (forkIO)
import Control.Monad (void)
import Data.String (fromString)
import Servant.Client
import System.Environment (getEnv)
import Control.Exception (finally)
import Data.Either (isLeft)
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS
import qualified Telegram.Bot.API as Telegram
import Telegram.Bot.API.Webhook (SetWebhookRequest,
deleteWebhook,
setUpWebhook, webhookApp)
import Telegram.Bot.Simple.BotApp.Internal
startBotAsync :: BotApp model action -> ClientEnv -> IO (action -> IO ())
startBotAsync :: BotApp model action -> ClientEnv -> IO (action -> IO ())
startBotAsync BotApp model action
bot ClientEnv
env = do
BotEnv model action
botEnv <- BotApp model action -> ClientEnv -> IO (BotEnv model action)
forall model action.
BotApp model action -> ClientEnv -> IO (BotEnv model action)
startBotEnv BotApp model action
bot ClientEnv
env
ClientM () -> IO ()
forall a. ClientM a -> IO ()
fork_ (ClientM () -> IO ()) -> ClientM () -> IO ()
forall a b. (a -> b) -> a -> b
$ BotApp model action -> BotEnv model action -> ClientM ()
forall model action.
BotApp model action -> BotEnv model action -> ClientM ()
startBotPolling BotApp model action
bot BotEnv model action
botEnv
(action -> IO ()) -> IO (action -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BotEnv model action -> Maybe Update -> Maybe action -> IO ()
forall model action.
BotEnv model action -> Maybe Update -> Maybe action -> IO ()
issueAction BotEnv model action
botEnv Maybe Update
forall a. Maybe a
Nothing (Maybe action -> IO ())
-> (action -> Maybe action) -> action -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. action -> Maybe action
forall a. a -> Maybe a
Just)
where
fork_ :: ClientM a -> IO ()
fork_ = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ())
-> (ClientM a -> IO ThreadId) -> ClientM a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> (ClientM a -> IO ()) -> ClientM a -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ClientError a) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either ClientError a) -> IO ())
-> (ClientM a -> IO (Either ClientError a)) -> ClientM a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientM a -> ClientEnv -> IO (Either ClientError a))
-> ClientEnv -> ClientM a -> IO (Either ClientError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientEnv
env
startBotAsync_ :: BotApp model action -> ClientEnv -> IO ()
startBotAsync_ :: BotApp model action -> ClientEnv -> IO ()
startBotAsync_ BotApp model action
bot ClientEnv
env = IO (action -> IO ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BotApp model action -> ClientEnv -> IO (action -> IO ())
forall model action.
BotApp model action -> ClientEnv -> IO (action -> IO ())
startBotAsync BotApp model action
bot ClientEnv
env)
startBot :: BotApp model action -> ClientEnv -> IO (Either ClientError ())
startBot :: BotApp model action -> ClientEnv -> IO (Either ClientError ())
startBot BotApp model action
bot ClientEnv
env = do
BotEnv model action
botEnv <- BotApp model action -> ClientEnv -> IO (BotEnv model action)
forall model action.
BotApp model action -> ClientEnv -> IO (BotEnv model action)
startBotEnv BotApp model action
bot ClientEnv
env
ClientM () -> ClientEnv -> IO (Either ClientError ())
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (BotApp model action -> BotEnv model action -> ClientM ()
forall model action.
BotApp model action -> BotEnv model action -> ClientM ()
startBotPolling BotApp model action
bot BotEnv model action
botEnv) ClientEnv
env
startBot_ :: BotApp model action -> ClientEnv -> IO ()
startBot_ :: BotApp model action -> ClientEnv -> IO ()
startBot_ BotApp model action
bot = IO (Either ClientError ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either ClientError ()) -> IO ())
-> (ClientEnv -> IO (Either ClientError ())) -> ClientEnv -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotApp model action -> ClientEnv -> IO (Either ClientError ())
forall model action.
BotApp model action -> ClientEnv -> IO (Either ClientError ())
startBot BotApp model action
bot
data WebhookConfig = WebhookConfig
{ WebhookConfig -> TLSSettings
webhookConfigTlsSettings :: TLSSettings,
WebhookConfig -> Settings
webhookConfigTlsWarpSettings :: Settings,
WebhookConfig -> SetWebhookRequest
webhookConfigSetWebhookRequest :: SetWebhookRequest
}
startBotWebhook :: BotApp model action -> WebhookConfig -> ClientEnv -> IO (Either ClientError ())
startBotWebhook :: BotApp model action
-> WebhookConfig -> ClientEnv -> IO (Either ClientError ())
startBotWebhook BotApp model action
bot (WebhookConfig{SetWebhookRequest
Settings
TLSSettings
webhookConfigSetWebhookRequest :: SetWebhookRequest
webhookConfigTlsWarpSettings :: Settings
webhookConfigTlsSettings :: TLSSettings
webhookConfigSetWebhookRequest :: WebhookConfig -> SetWebhookRequest
webhookConfigTlsWarpSettings :: WebhookConfig -> Settings
webhookConfigTlsSettings :: WebhookConfig -> TLSSettings
..}) ClientEnv
env = do
BotEnv model action
botEnv <- BotApp model action -> ClientEnv -> IO (BotEnv model action)
forall model action.
BotApp model action -> ClientEnv -> IO (BotEnv model action)
startBotEnv BotApp model action
bot ClientEnv
env
Either ClientError ()
res <- SetWebhookRequest -> ClientEnv -> IO (Either ClientError ())
setUpWebhook SetWebhookRequest
webhookConfigSetWebhookRequest ClientEnv
env
if Either ClientError () -> Bool
forall a b. Either a b -> Bool
isLeft Either ClientError ()
res
then Either ClientError () -> IO (Either ClientError ())
forall (m :: * -> *) a. Monad m => a -> m a
return Either ClientError ()
res
else () -> Either ClientError ()
forall a b. b -> Either a b
Right (() -> Either ClientError ())
-> IO () -> IO (Either ClientError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TLSSettings -> Settings -> Application -> IO ()
runTLS TLSSettings
webhookConfigTlsSettings Settings
webhookConfigTlsWarpSettings (BotApp model action -> BotEnv model action -> Application
forall model action.
BotApp model action -> BotEnv model action -> Application
webhookApp BotApp model action
bot BotEnv model action
botEnv)
IO (Either ClientError ())
-> IO (Either ClientError ()) -> IO (Either ClientError ())
forall a b. IO a -> IO b -> IO a
`finally`
ClientEnv -> IO (Either ClientError ())
deleteWebhook ClientEnv
env
startBotWebhook_ :: BotApp model action -> WebhookConfig -> ClientEnv -> IO ()
startBotWebhook_ :: BotApp model action -> WebhookConfig -> ClientEnv -> IO ()
startBotWebhook_ BotApp model action
bot WebhookConfig
webhookConfig = IO (Either ClientError ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either ClientError ()) -> IO ())
-> (ClientEnv -> IO (Either ClientError ())) -> ClientEnv -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotApp model action
-> WebhookConfig -> ClientEnv -> IO (Either ClientError ())
forall model action.
BotApp model action
-> WebhookConfig -> ClientEnv -> IO (Either ClientError ())
startBotWebhook BotApp model action
bot WebhookConfig
webhookConfig
getEnvToken :: String -> IO Telegram.Token
getEnvToken :: String -> IO Token
getEnvToken String
varName = String -> Token
forall a. IsString a => String -> a
fromString (String -> Token) -> IO String -> IO Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
varName
startBotEnv :: BotApp model action -> ClientEnv -> IO (BotEnv model action)
startBotEnv :: BotApp model action -> ClientEnv -> IO (BotEnv model action)
startBotEnv BotApp model action
bot ClientEnv
env = do
BotEnv model action
botEnv <- BotApp model action -> ClientEnv -> IO (BotEnv model action)
forall model action.
BotApp model action -> ClientEnv -> IO (BotEnv model action)
defaultBotEnv BotApp model action
bot ClientEnv
env
[ThreadId]
_jobThreadIds <- BotEnv model action -> [BotJob model action] -> IO [ThreadId]
forall model action.
BotEnv model action -> [BotJob model action] -> IO [ThreadId]
scheduleBotJobs BotEnv model action
botEnv (BotApp model action -> [BotJob model action]
forall model action. BotApp model action -> [BotJob model action]
botJobs BotApp model action
bot)
ThreadId
_actionsThreadId <- BotApp model action -> BotEnv model action -> IO ThreadId
forall model action.
BotApp model action -> BotEnv model action -> IO ThreadId
processActionsIndefinitely BotApp model action
bot BotEnv model action
botEnv
BotEnv model action -> IO (BotEnv model action)
forall (m :: * -> *) a. Monad m => a -> m a
return BotEnv model action
botEnv