{-# 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, deleteWebhook, SetWebhookRequest (..), defSetWebhook, defDeleteWebhook ) where 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.Internal.Utils (gtoJSON) import Telegram.Bot.API.MakingRequests (Response) import Telegram.Bot.API.Types (InputFile, makeFile) import Telegram.Bot.API.Internal.TH (makeDefault) 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. SetWebhookRequest -> Rep SetWebhookRequest x) -> (forall x. Rep SetWebhookRequest x -> SetWebhookRequest) -> Generic SetWebhookRequest 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 $cfrom :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x from :: forall x. SetWebhookRequest -> Rep SetWebhookRequest x $cto :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest to :: forall x. Rep SetWebhookRequest x -> SetWebhookRequest Generic) instance ToJSON SetWebhookRequest where toJSON :: SetWebhookRequest -> Value toJSON = SetWebhookRequest -> Value 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. DeleteWebhookRequest -> Rep DeleteWebhookRequest x) -> (forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest) -> Generic DeleteWebhookRequest 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 $cfrom :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x from :: forall x. DeleteWebhookRequest -> Rep DeleteWebhookRequest x $cto :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest to :: forall x. Rep DeleteWebhookRequest x -> DeleteWebhookRequest Generic) instance ToJSON DeleteWebhookRequest where toJSON :: DeleteWebhookRequest -> Value toJSON = DeleteWebhookRequest -> Value 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 setWebhookUrl :: SetWebhookRequest -> String setWebhookCertificate :: SetWebhookRequest -> Maybe InputFile setWebhookIpAddress :: SetWebhookRequest -> Maybe String setWebhookMaxConnections :: SetWebhookRequest -> Maybe Int setWebhookAllowedUpdates :: SetWebhookRequest -> Maybe [String] setWebhookDropPendingUpdates :: SetWebhookRequest -> Maybe Bool setWebhookSecretToken :: SetWebhookRequest -> Maybe String setWebhookUrl :: String setWebhookCertificate :: Maybe InputFile setWebhookIpAddress :: Maybe String setWebhookMaxConnections :: Maybe Int setWebhookAllowedUpdates :: Maybe [String] setWebhookDropPendingUpdates :: Maybe Bool setWebhookSecretToken :: Maybe String ..} = Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp makeFile Text "certificate" (Maybe InputFile -> InputFile forall a. HasCallStack => Maybe a -> a fromJust Maybe InputFile setWebhookCertificate) ([Input] -> [FileData Tmp] -> MultipartData Tmp forall tag. [Input] -> [FileData tag] -> MultipartData tag MultipartData [Input] fields []) where fields :: [Input] fields = [Text -> Text -> Input Input Text "url" (Text -> Input) -> Text -> Input forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String setWebhookUrl] [Input] -> [Input] -> [Input] forall a. Semigroup a => a -> a -> a <> [Maybe Input] -> [Input] forall a. [Maybe a] -> [a] catMaybes [ Maybe String setWebhookSecretToken Maybe String -> (String -> Input) -> Maybe Input forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \String t -> Text -> Text -> Input Input Text "secret_token" (Text -> Input) -> Text -> Input forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String t, Maybe String setWebhookIpAddress Maybe String -> (String -> Input) -> Maybe Input forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \String t -> Text -> Text -> Input Input Text "ip_address" (Text -> Input) -> Text -> Input forall a b. (a -> b) -> a -> b $ String -> Text Text.pack String t, Maybe Int setWebhookMaxConnections Maybe Int -> (Int -> Input) -> Maybe Input forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Int t -> Text -> Text -> Input Input Text "max_connections" (Text -> Input) -> Text -> Input forall a b. (a -> b) -> a -> b $ String -> Text Text.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Int -> String forall a. Show a => a -> String show Int t, Maybe Bool setWebhookDropPendingUpdates Maybe Bool -> (Bool -> Input) -> Maybe Input forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Bool t -> Text -> Text -> Input Input Text "drop_pending_updates" (Text -> Text -> Bool -> Text forall a. a -> a -> Bool -> a bool Text "false" Text "true" Bool t), Maybe [String] setWebhookAllowedUpdates Maybe [String] -> ([String] -> Input) -> Maybe Input 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 "," ((String -> Text) -> [String] -> [Text] forall a b. (a -> b) -> [a] -> [b] map (\String s -> String -> Text Text.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ String "\"" String -> String -> String forall a. [a] -> [a] -> [a] ++ String s String -> String -> String 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 = (Either ClientError (Response Bool) -> Either ClientError () forall (f :: * -> *) a. Functor f => f a -> f () void (Either ClientError (Response Bool) -> Either ClientError ()) -> IO (Either ClientError (Response Bool)) -> IO (Either ClientError ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) (IO (Either ClientError (Response Bool)) -> IO (Either ClientError ())) -> (ClientEnv -> IO (Either ClientError (Response Bool))) -> ClientEnv -> IO (Either ClientError ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ClientM (Response Bool) -> ClientEnv -> IO (Either ClientError (Response Bool)) forall a. ClientM a -> ClientEnv -> IO (Either ClientError a) runClientM ClientM (Response Bool) setUpWebhookRequest where setUpWebhookRequest :: ClientM (Response Bool) setUpWebhookRequest = if Maybe InputFile -> Bool forall a. Maybe a -> Bool isJust (Maybe InputFile -> Bool) -> Maybe InputFile -> Bool forall a b. (a -> b) -> a -> b $ SetWebhookRequest -> Maybe InputFile setWebhookCertificate SetWebhookRequest requestData then do ByteString boundary <- IO ByteString -> ClientM ByteString forall a. IO a -> ClientM a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO ByteString genBoundary Proxy SetWebhookForm -> Client ClientM SetWebhookForm forall api. HasClient ClientM api => Proxy api -> Client ClientM api client (forall t. Proxy t forall {k} (t :: k). Proxy t Proxy @SetWebhookForm) (ByteString boundary, SetWebhookRequest requestData) else Proxy SetWebhookJson -> Client ClientM SetWebhookJson forall api. HasClient ClientM api => Proxy api -> Client ClientM api client (forall t. Proxy t forall {k} (t :: k). Proxy t Proxy @SetWebhookJson) SetWebhookRequest requestData deleteWebhook :: ClientEnv -> IO (Either ClientError ()) deleteWebhook :: ClientEnv -> IO (Either ClientError ()) deleteWebhook = (Either ClientError (Response Bool) -> Either ClientError () forall (f :: * -> *) a. Functor f => f a -> f () void (Either ClientError (Response Bool) -> Either ClientError ()) -> IO (Either ClientError (Response Bool)) -> IO (Either ClientError ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>) (IO (Either ClientError (Response Bool)) -> IO (Either ClientError ())) -> (ClientEnv -> IO (Either ClientError (Response Bool))) -> ClientEnv -> IO (Either ClientError ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ClientM (Response Bool) -> ClientEnv -> IO (Either ClientError (Response Bool)) forall a. ClientM a -> ClientEnv -> IO (Either ClientError a) runClientM ClientM (Response Bool) deleteWebhookRequest where requestData :: DeleteWebhookRequest requestData = DeleteWebhookRequest {deleteWebhookDropPendingUpdates :: Maybe Bool deleteWebhookDropPendingUpdates = Maybe Bool forall a. Maybe a Nothing} deleteWebhookRequest :: ClientM (Response Bool) deleteWebhookRequest = Proxy DeleteWebhook -> Client ClientM DeleteWebhook forall api. HasClient ClientM api => Proxy api -> Client ClientM api client (forall t. Proxy t forall {k} (t :: k). Proxy t Proxy @DeleteWebhook) DeleteWebhookRequest requestData foldMap makeDefault [ ''SetWebhookRequest , ''DeleteWebhookRequest ]