{-# 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

-- | Start bot with asynchronous polling.
-- The result is a function that allows you to send actions
-- directly to the bot.
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

-- | Like 'startBotAsync', but ignores result.
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)

-- | Start bot with update polling in the main thread.
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

-- | Like 'startBot', but ignores result.
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
  }

-- | Start bot with webhook on update in the main thread.
-- Port must be one of 443, 80, 88, 8443
-- certPath must be provided if using self signed certificate.
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


-- | Like 'startBotWebhook', but ignores result.
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

-- | Get a 'Telegram.Token' from environment variable.
--
-- Common use:
--
-- @
-- 'getEnvToken' "TELEGRAM_BOT_TOKEN"
-- @
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