{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Telegram.Bot.API.Webhook ( setUpWebhook, webhookApp, deleteWebhook, SetWebhookRequest (..), ) where import Control.Concurrent (forkIO) import Control.Concurrent.STM import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson (ToJSON (toJSON)) import Data.Bool (bool) import Data.Functor (void, (<&>)) import Data.Maybe (catMaybes, fromJust, isJust) import qualified Data.Text as Text import GHC.Generics (Generic) import Servant import Servant.Client (ClientEnv, ClientError, client, runClientM) import Servant.Multipart.API import Servant.Multipart.Client (genBoundary) import Telegram.Bot.API.GettingUpdates (Update) import Telegram.Bot.API.Internal.Utils (gtoJSON) import Telegram.Bot.API.MakingRequests (Response) import Telegram.Bot.API.Types (InputFile, makeFile) import Telegram.Bot.Simple.BotApp.Internal type WebhookAPI = ReqBody '[JSON] Update :> Post '[JSON] () server :: BotApp model action -> BotEnv model action -> Server WebhookAPI server :: forall model action. 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) User ClientEnv 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 ..} = Update -> Handler () updateHandler where updateHandler :: Update -> Handler () updateHandler :: Update -> Handler () updateHandler Update update = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall {m :: * -> *}. MonadIO m => Update -> m () handleUpdate Update update handleUpdate :: Update -> m () handleUpdate Update update = forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Functor f => f a -> f () void forall b c a. (b -> c) -> (a -> b) -> a -> c . IO () -> IO ThreadId forkIO forall a b. (a -> b) -> a -> b $ do Maybe action maction <- Update -> model -> Maybe action botAction Update update forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. TVar a -> IO a readTVarIO TVar model botModelVar case Maybe action maction of Maybe action Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return () Just action action -> forall model action. BotEnv model action -> Maybe Update -> Maybe action -> IO () issueAction BotEnv model action botEnv (forall a. a -> Maybe a Just Update update) (forall a. a -> Maybe a Just action action) webhookAPI :: Proxy WebhookAPI webhookAPI :: Proxy WebhookAPI webhookAPI = forall {k} (t :: k). Proxy t Proxy app :: BotApp model action -> BotEnv model action -> Application app :: forall model action. BotApp model action -> BotEnv model action -> Application app BotApp model action botApp BotEnv model action botEnv = forall api. HasServer api '[] => Proxy api -> Server api -> Application serve Proxy WebhookAPI webhookAPI forall a b. (a -> b) -> a -> b $ forall model action. BotApp model action -> BotEnv model action -> Server WebhookAPI server BotApp model action botApp BotEnv model action botEnv data SetWebhookRequest = SetWebhookRequest { SetWebhookRequest -> String setWebhookUrl :: String, SetWebhookRequest -> Maybe InputFile setWebhookCertificate :: Maybe InputFile, SetWebhookRequest -> Maybe String setWebhookIpAddress :: Maybe String, SetWebhookRequest -> Maybe Int setWebhookMaxConnections :: Maybe Int, SetWebhookRequest -> Maybe [String] setWebhookAllowedUpdates :: Maybe [String], SetWebhookRequest -> Maybe Bool setWebhookDropPendingUpdates :: Maybe Bool, SetWebhookRequest -> Maybe String setWebhookSecretToken :: Maybe String } deriving (forall x. Rep SetWebhookRequest x -> SetWebhookRequest forall x. SetWebhookRequest -> Rep SetWebhookRequest x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest $cfrom :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x Generic) instance ToJSON SetWebhookRequest where toJSON :: SetWebhookRequest -> Value toJSON = forall a (d :: Meta) (f :: * -> *). (Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) => a -> Value gtoJSON newtype DeleteWebhookRequest = DeleteWebhookRequest { DeleteWebhookRequest -> Maybe Bool deleteWebhookDropPendingUpdates :: Maybe Bool } deriving (forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest $cfrom :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x Generic) instance ToJSON DeleteWebhookRequest where toJSON :: DeleteWebhookRequest -> Value toJSON = forall a (d :: Meta) (f :: * -> *). (Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) => a -> Value gtoJSON instance ToMultipart Tmp SetWebhookRequest where toMultipart :: SetWebhookRequest -> MultipartData Tmp toMultipart SetWebhookRequest {String Maybe Bool Maybe Int Maybe String Maybe [String] Maybe InputFile setWebhookSecretToken :: Maybe String setWebhookDropPendingUpdates :: Maybe Bool setWebhookAllowedUpdates :: Maybe [String] setWebhookMaxConnections :: Maybe Int setWebhookIpAddress :: Maybe String setWebhookCertificate :: Maybe InputFile setWebhookUrl :: String setWebhookSecretToken :: SetWebhookRequest -> Maybe String setWebhookDropPendingUpdates :: SetWebhookRequest -> Maybe Bool setWebhookAllowedUpdates :: SetWebhookRequest -> Maybe [String] setWebhookMaxConnections :: SetWebhookRequest -> Maybe Int setWebhookIpAddress :: SetWebhookRequest -> Maybe String setWebhookCertificate :: SetWebhookRequest -> Maybe InputFile setWebhookUrl :: SetWebhookRequest -> String ..} = Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp makeFile Text "certificate" (forall a. HasCallStack => Maybe a -> a fromJust Maybe InputFile setWebhookCertificate) (forall tag. [Input] -> [FileData tag] -> MultipartData tag MultipartData [Input] fields []) where fields :: [Input] fields = [Text -> Text -> Input Input Text "url" forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String setWebhookUrl] forall a. Semigroup a => a -> a -> a <> forall a. [Maybe a] -> [a] catMaybes [ Maybe String setWebhookSecretToken forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \String t -> Text -> Text -> Input Input Text "secret_token" forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String t, Maybe String setWebhookIpAddress forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \String t -> Text -> Text -> Input Input Text "ip_address" forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String t, Maybe Int setWebhookMaxConnections forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Int t -> Text -> Text -> Input Input Text "max_connections" forall a b. (a -> b) -> a -> b $ String -> Text Text.pack forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Int t, Maybe Bool setWebhookDropPendingUpdates forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Bool t -> Text -> Text -> Input Input Text "drop_pending_updates" (forall a. a -> a -> Bool -> a bool Text "false" Text "true" Bool t), Maybe [String] setWebhookAllowedUpdates forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \[String] t -> Text -> Text -> Input Input Text "allowed_updates" ([String] -> Text arrToJson [String] t) ] arrToJson :: [String] -> Text arrToJson [String] arr = Text -> [Text] -> Text Text.intercalate Text "" [Text "[", Text -> [Text] -> Text Text.intercalate Text "," (forall a b. (a -> b) -> [a] -> [b] map (\String s -> String -> Text Text.pack forall a b. (a -> b) -> a -> b $ String "\"" forall a. [a] -> [a] -> [a] ++ String s forall a. [a] -> [a] -> [a] ++ String "\"") [String] arr), Text "]"] type SetWebhookForm = "setWebhook" :> MultipartForm Tmp SetWebhookRequest :> Get '[JSON] (Response Bool) type SetWebhookJson = "setWebhook" :> ReqBody '[JSON] SetWebhookRequest :> Get '[JSON] (Response Bool) type DeleteWebhook = "deleteWebhook" :> ReqBody '[JSON] DeleteWebhookRequest :> Get '[JSON] (Response Bool) setUpWebhook :: SetWebhookRequest -> ClientEnv -> IO (Either ClientError ()) setUpWebhook :: SetWebhookRequest -> ClientEnv -> IO (Either ClientError ()) setUpWebhook SetWebhookRequest requestData = (forall (f :: * -> *) a. Functor f => f a -> f () void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. ClientM a -> ClientEnv -> IO (Either ClientError a) runClientM ClientM (Response Bool) setUpWebhookRequest where setUpWebhookRequest :: ClientM (Response Bool) setUpWebhookRequest = if forall a. Maybe a -> Bool isJust forall a b. (a -> b) -> a -> b $ SetWebhookRequest -> Maybe InputFile setWebhookCertificate SetWebhookRequest requestData then do ByteString boundary <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO ByteString genBoundary forall api. HasClient ClientM api => Proxy api -> Client ClientM api client (forall {k} (t :: k). Proxy t Proxy @SetWebhookForm) (ByteString boundary, SetWebhookRequest requestData) else forall api. HasClient ClientM api => Proxy api -> Client ClientM api client (forall {k} (t :: k). Proxy t Proxy @SetWebhookJson) SetWebhookRequest requestData deleteWebhook :: ClientEnv -> IO (Either ClientError ()) deleteWebhook :: ClientEnv -> IO (Either ClientError ()) deleteWebhook = (forall (f :: * -> *) a. Functor f => f a -> f () void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. ClientM a -> ClientEnv -> IO (Either ClientError a) runClientM ClientM (Response Bool) deleteWebhookRequest where requestData :: DeleteWebhookRequest requestData = DeleteWebhookRequest {deleteWebhookDropPendingUpdates :: Maybe Bool deleteWebhookDropPendingUpdates = forall a. Maybe a Nothing} deleteWebhookRequest :: ClientM (Response Bool) deleteWebhookRequest = forall api. HasClient ClientM api => Proxy api -> Client ClientM api client (forall {k} (t :: k). Proxy t Proxy @DeleteWebhook) DeleteWebhookRequest requestData webhookApp :: BotApp model action -> BotEnv model action -> Application webhookApp :: forall model action. BotApp model action -> BotEnv model action -> Application webhookApp = forall model action. BotApp model action -> BotEnv model action -> Application app