{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeOperators         #-}
module Telegram.Bot.Simple.Webhook (webhookApp) where

import           Control.Concurrent                  (forkIO)
import           Control.Concurrent.STM
import           Control.Monad.IO.Class              (MonadIO (liftIO))
import           Data.Functor                        (void)
import           Servant

import           Telegram.Bot.API.GettingUpdates     (Update)
import           Telegram.Bot.Simple.BotApp.Internal

type WebhookAPI = ReqBody '[JSON] Update :> Post '[JSON] ()

server :: BotApp model action -> BotEnv model action -> Server WebhookAPI
server :: BotApp model action -> BotEnv model action -> Server WebhookAPI
server BotApp {model
[BotJob model action]
action -> model -> Eff action model
Update -> model -> Maybe action
botJobs :: forall model action. BotApp model action -> [BotJob model action]
botHandler :: forall model action.
BotApp model action -> action -> model -> Eff action model
botAction :: forall model action.
BotApp model action -> Update -> model -> Maybe action
botInitialModel :: forall model action. BotApp model action -> model
botJobs :: [BotJob model action]
botHandler :: action -> model -> Eff action model
botAction :: Update -> model -> Maybe action
botInitialModel :: model
..} botEnv :: BotEnv model action
botEnv@BotEnv {TVar model
TQueue (Maybe Update, action)
ClientEnv
User
botUser :: forall model action. BotEnv model action -> User
botClientEnv :: forall model action. BotEnv model action -> ClientEnv
botActionsQueue :: forall model action.
BotEnv model action -> TQueue (Maybe Update, action)
botModelVar :: forall model action. BotEnv model action -> TVar model
botUser :: User
botClientEnv :: ClientEnv
botActionsQueue :: TQueue (Maybe Update, action)
botModelVar :: TVar model
..} =
  Server WebhookAPI
Update -> Handler ()
updateHandler
  where
    updateHandler :: Update -> Handler ()
    updateHandler :: Update -> Handler ()
updateHandler Update
update = IO () -> Handler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ Update -> IO ()
forall (m :: * -> *). MonadIO m => Update -> m ()
handleUpdate Update
update
    handleUpdate :: Update -> m ()
handleUpdate Update
update = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO () -> IO ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe action
maction <- Update -> model -> Maybe action
botAction Update
update (model -> Maybe action) -> IO model -> IO (Maybe action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar model -> IO model
forall a. TVar a -> IO a
readTVarIO TVar model
botModelVar
      case Maybe action
maction of
        Maybe action
Nothing     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just action
action -> BotEnv model action -> Maybe Update -> Maybe action -> IO ()
forall model action.
BotEnv model action -> Maybe Update -> Maybe action -> IO ()
issueAction BotEnv model action
botEnv (Update -> Maybe Update
forall a. a -> Maybe a
Just Update
update) (action -> Maybe action
forall a. a -> Maybe a
Just action
action)

webhookAPI :: Proxy WebhookAPI
webhookAPI :: Proxy WebhookAPI
webhookAPI = Proxy WebhookAPI
forall k (t :: k). Proxy t
Proxy

app :: BotApp model action -> BotEnv model action -> Application
app :: BotApp model action -> BotEnv model action -> Application
app BotApp model action
botApp BotEnv model action
botEnv = Proxy WebhookAPI -> Server WebhookAPI -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve Proxy WebhookAPI
webhookAPI (Server WebhookAPI -> Application)
-> Server WebhookAPI -> Application
forall a b. (a -> b) -> a -> b
$ BotApp model action -> BotEnv model action -> Server WebhookAPI
forall model action.
BotApp model action -> BotEnv model action -> Server WebhookAPI
server BotApp model action
botApp BotEnv model action
botEnv

webhookApp :: BotApp model action -> BotEnv model action -> Application
webhookApp :: BotApp model action -> BotEnv model action -> Application
webhookApp = BotApp model action -> BotEnv model action -> Application
forall model action.
BotApp model action -> BotEnv model action -> Application
app