diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -32,16 +32,17 @@ main = do let token = Token "bot" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 manager <- newManager tlsManagerSettings - result <- runClient ( do + result <- runTelegramClient token manager $ do info <- getWebhookInfoM let request = setWebhookRequest' "https://example.com/hook" isSet <- setWebhookM request - getMeM) token manager + getMeM print result print "done!" ``` -### Running IO directly +### Running IO directly (planning to depricate this option) +:warning: This method to interact with a Telegram bot is about to be depricated and all new API calls will only have their `M` versions. You can run them using `runTelegramClient` function, for example `runTelegramClient token manager $ sendMessageM message` or in example below replace `getMe token manager` with `runTelegramClient token manager getMeM` to get the same behavior. `getMe` example diff --git a/src/Servant/Client/MultipartFormData.hs b/src/Servant/Client/MultipartFormData.hs --- a/src/Servant/Client/MultipartFormData.hs +++ b/src/Servant/Client/MultipartFormData.hs @@ -13,16 +13,19 @@ , MultipartFormDataReqBody ) where -import Control.Exception +--import Control.Exception import Control.Monad import Control.Monad.Error.Class import Control.Monad.IO.Class import Control.Monad.Reader.Class -import Data.ByteString.Lazy hiding (elem, filter, - map, null, pack, any) +import Data.ByteString.Lazy hiding (any, elem, + filter, map, null, pack) import Data.Proxy -import Data.Foldable (toList) -import Data.String.Conversions +--import Data.Foldable (toList) +import qualified Data.List.NonEmpty as NonEmpty +--import Data.String.Conversions +import qualified Data.Sequence as Sequence +import Data.Text (pack) import Data.Typeable (Typeable) import Network.HTTP.Client hiding (Proxy, path) import qualified Network.HTTP.Client as Client @@ -33,9 +36,11 @@ import qualified Network.HTTP.Types.Header as HTTP import Servant.API import Servant.Client -import Servant.Common.Req (Req, UrlReq (..), ClientEnv (..), - catchConnectionError, - reqAccept, reqToRequest) +import qualified Servant.Client.Core as Core +import Servant.Client.Internal.HttpClient (catchConnectionError, + clientResponseToReponse, + requestToClientRequest) + -- | A type that can be converted to a multipart/form-data value. class ToMultipartFormData a where -- | Convert a Haskell value to a multipart/form-data-friendly intermediate type. @@ -45,59 +50,60 @@ data MultipartFormDataReqBody a deriving (Typeable) -instance (ToMultipartFormData b, MimeUnrender ct a, cts' ~ (ct ': cts) - ) => HasClient (MultipartFormDataReqBody b :> Post cts' a) where - type Client (MultipartFormDataReqBody b :> Post cts' a) - = b -> ClientM a - clientWithRoute Proxy req reqData = - let reqToRequest' req' baseurl' = do - requestWithoutBody <- reqToRequest req' baseurl' +instance (Core.RunClient m, ToMultipartFormData b, MimeUnrender ct a, cts' ~ (ct ': cts) + ) => HasClient m (MultipartFormDataReqBody b :> Post cts' a) where + type Client m (MultipartFormDataReqBody b :> Post cts' a) = b-> ClientM a + clientWithRoute _pm Proxy req reqData = + let requestToClientRequest' req' baseurl' = do + let requestWithoutBody = requestToClientRequest baseurl' req' formDataBody (toMultipartFormData reqData) requestWithoutBody - in snd <$> performRequestCT' reqToRequest' (Proxy :: Proxy ct) H.methodPost req + in snd <$> performRequestCT' requestToClientRequest' (Proxy :: Proxy ct) H.methodPost req --- copied `performRequest` from servant-0.11, then modified so it takes a variant of `reqToRequest` +-- copied `performRequest` from servant-0.11, then modified so it takes a variant of `requestToClientRequest` -- as an argument. -performRequest' :: (Req -> BaseUrl -> IO Request) - -> Method -> Req +performRequest' :: (Core.Request -> BaseUrl -> IO Request) + -> Method -> Core.Request -> ClientM ( Int, ByteString, MediaType - , [HTTP.Header], Response ByteString) -performRequest' reqToRequest' reqMethod req = do + , [HTTP.Header], Client.Response ByteString) +performRequest' requestToClientRequest' reqMethod req = do m <- asks manager reqHost <- asks baseUrl - partialRequest <- liftIO $ reqToRequest' req reqHost + partialRequest <- liftIO $ requestToClientRequest' req reqHost let request = partialRequest { Client.method = reqMethod } eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m case eResponse of Left err -> - throwError . ConnectionError $ SomeException err + throwError . ConnectionError $ pack $ show err Right response -> do let status = Client.responseStatus response body = Client.responseBody response hdrs = Client.responseHeaders response status_code = statusCode status + coreResponse = clientResponseToReponse response ct <- case lookup "Content-Type" $ Client.responseHeaders response of Nothing -> pure $ "application"//"octet-stream" Just t -> case parseAccept t of - Nothing -> throwError $ InvalidContentTypeHeader (cs t) body + Nothing -> throwError $ InvalidContentTypeHeader coreResponse Just t' -> pure t' unless (status_code >= 200 && status_code < 300) $ - throwError $ FailureResponse (UrlReq reqHost req) status ct body + throwError $ FailureResponse coreResponse return (status_code, body, ct, hdrs, response) --- copied `performRequestCT` from servant-0.11, then modified so it takes a variant of `reqToRequest` +-- copied `performRequestCT` from servant-0.11, then modified so it takes a variant of `requestToClientRequest` -- as an argument. -performRequestCT' :: MimeUnrender ct result => - (Req -> BaseUrl -> IO Request) - -> Proxy ct -> Method -> Req +performRequestCT' :: MimeUnrender ct result => + (Core.Request -> BaseUrl -> IO Request) + -> Proxy ct -> Method -> Core.Request -> ClientM ([HTTP.Header], result) -performRequestCT' reqToRequest' ct reqMethod req = do +performRequestCT' requestToClientRequest' ct reqMethod req = do let acceptCTS = contentTypes ct (_status, respBody, respCT, hdrs, _response) <- - performRequest' reqToRequest' reqMethod (req { reqAccept = toList acceptCTS }) - unless (any (matches respCT) acceptCTS) $ throwError $ UnsupportedContentType respCT respBody + performRequest' requestToClientRequest' reqMethod (req { Core.requestAccept = Sequence.fromList $ NonEmpty.toList acceptCTS }) + let coreResponse = clientResponseToReponse _response + unless (any (matches respCT) acceptCTS) $ throwError $ UnsupportedContentType respCT coreResponse case mimeUnrender ct respBody of - Left err -> throwError $ DecodeFailure err respCT respBody + Left err -> throwError $ DecodeFailure (pack err) coreResponse Right val -> return (hdrs, val) diff --git a/src/Web/Telegram/API/Bot/API/Chats.hs b/src/Web/Telegram/API/Bot/API/Chats.hs --- a/src/Web/Telegram/API/Bot/API/Chats.hs +++ b/src/Web/Telegram/API/Bot/API/Chats.hs @@ -39,7 +39,7 @@ import Data.Text (Text) import Network.HTTP.Client (Manager) import Servant.API -import Servant.Client +import Servant.Client hiding (Response) import Servant.Client.MultipartFormData import Web.Telegram.API.Bot.API.Core import Web.Telegram.API.Bot.Requests diff --git a/src/Web/Telegram/API/Bot/API/Edit.hs b/src/Web/Telegram/API/Bot/API/Edit.hs --- a/src/Web/Telegram/API/Bot/API/Edit.hs +++ b/src/Web/Telegram/API/Bot/API/Edit.hs @@ -27,7 +27,7 @@ import Data.Proxy import Network.HTTP.Client (Manager) import Servant.API -import Servant.Client +import Servant.Client hiding (Response) import Web.Telegram.API.Bot.API.Core import Web.Telegram.API.Bot.Requests import Web.Telegram.API.Bot.Responses diff --git a/src/Web/Telegram/API/Bot/API/Messages.hs b/src/Web/Telegram/API/Bot/API/Messages.hs --- a/src/Web/Telegram/API/Bot/API/Messages.hs +++ b/src/Web/Telegram/API/Bot/API/Messages.hs @@ -57,7 +57,7 @@ import Data.Text (Text) import Network.HTTP.Client (Manager) import Servant.API -import Servant.Client +import Servant.Client hiding (Response) import Servant.Client.MultipartFormData import Web.Telegram.API.Bot.API.Core import Web.Telegram.API.Bot.Data diff --git a/src/Web/Telegram/API/Bot/API/Stickers.hs b/src/Web/Telegram/API/Bot/API/Stickers.hs --- a/src/Web/Telegram/API/Bot/API/Stickers.hs +++ b/src/Web/Telegram/API/Bot/API/Stickers.hs @@ -21,7 +21,7 @@ import Data.Proxy import Data.Text (Text) import Servant.API -import Servant.Client +import Servant.Client hiding (Response) import Servant.Client.MultipartFormData import Web.Telegram.API.Bot.API.Core import Web.Telegram.API.Bot.Data diff --git a/src/Web/Telegram/API/Bot/API/Updates.hs b/src/Web/Telegram/API/Bot/API/Updates.hs --- a/src/Web/Telegram/API/Bot/API/Updates.hs +++ b/src/Web/Telegram/API/Bot/API/Updates.hs @@ -25,7 +25,7 @@ import Data.Text (Text, empty) import Network.HTTP.Client (Manager) import Servant.API -import Servant.Client +import Servant.Client hiding (Response) import Servant.Client.MultipartFormData import Web.Telegram.API.Bot.API.Core import Web.Telegram.API.Bot.Requests diff --git a/src/Web/Telegram/API/Bot/Requests.hs b/src/Web/Telegram/API/Bot/Requests.hs --- a/src/Web/Telegram/API/Bot/Requests.hs +++ b/src/Web/Telegram/API/Bot/Requests.hs @@ -817,27 +817,29 @@ data SendInvoiceRequest = SendInvoiceRequest { - snd_inv_chat_id :: Int64 -- ^ Unique identifier for the target private chat - , snd_inv_title :: Text -- ^ Product name - , snd_inv_description :: Text -- ^ Product description - , snd_inv_payload :: Text -- ^ Bot-defined invoice payload, 1-128 bytes. This will not be displayed to the user, use for your internal processes. - , snd_inv_provider_token :: Text -- ^ Payments provider token, obtained via Botfather - , snd_inv_start_parameter :: Text -- ^ Unique deep-linking parameter that can be used to generate this invoice when used as a start parameter - , snd_inv_currency :: CurrencyCode -- ^ Three-letter ISO 4217 code - , snd_inv_prices :: [LabeledPrice] -- ^ Price breakdown, a list of components (e.g. product price, tax, discount, delivery cost, delivery tax, bonus, etc.) - , snd_inv_provider_data :: Maybe Text -- ^ JSON-encoded data about the invoice, which will be shared with the payment provider. A detailed description of required fields should be provided by the payment provider. - , snd_inv_photo_url :: Maybe Text -- ^ URL of the product photo for the invoice. Can be a photo of the goods or a marketing image for a service. People like it better when they see what they are paying for. - , snd_inv_photo_size :: Maybe Int -- ^ Photo size - , snd_inv_photo_width :: Maybe Int -- ^ Photo width - , snd_inv_photo_height :: Maybe Int -- ^ Photo height - , snd_inv_need_name :: Maybe Bool -- ^ Pass `True`, if you require the user's full name to complete the order - , snd_inv_need_phone_number :: Maybe Bool -- ^ Pass `True`, if you require the user's phone number to complete the order - , snd_inv_need_email :: Maybe Bool -- ^ Pass `True`, if you require the user's email to complete the order - , snd_inv_need_shipping_address :: Maybe Bool -- ^ Pass `True`, if you require the user's shipping address to complete the order - , snd_inv_is_flexible :: Maybe Bool -- ^ Pass `True`, if the final price depends on the shipping method - , snd_inv_disable_notification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound. - , snd_inv_reply_to_message :: Maybe Int -- ^ If the message is a reply, ID of the original message - , snd_inv_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard. If empty, one 'Pay total price' button will be shown. If not empty, the first button must be a Pay button. + snd_inv_chat_id :: Int64 -- ^ Unique identifier for the target private chat + , snd_inv_title :: Text -- ^ Product name + , snd_inv_description :: Text -- ^ Product description + , snd_inv_payload :: Text -- ^ Bot-defined invoice payload, 1-128 bytes. This will not be displayed to the user, use for your internal processes. + , snd_inv_provider_token :: Text -- ^ Payments provider token, obtained via Botfather + , snd_inv_start_parameter :: Text -- ^ Unique deep-linking parameter that can be used to generate this invoice when used as a start parameter + , snd_inv_currency :: CurrencyCode -- ^ Three-letter ISO 4217 code + , snd_inv_prices :: [LabeledPrice] -- ^ Price breakdown, a list of components (e.g. product price, tax, discount, delivery cost, delivery tax, bonus, etc.) + , snd_inv_provider_data :: Maybe Text -- ^ JSON-encoded data about the invoice, which will be shared with the payment provider. A detailed description of required fields should be provided by the payment provider. + , snd_inv_photo_url :: Maybe Text -- ^ URL of the product photo for the invoice. Can be a photo of the goods or a marketing image for a service. People like it better when they see what they are paying for. + , snd_inv_photo_size :: Maybe Int -- ^ Photo size + , snd_inv_photo_width :: Maybe Int -- ^ Photo width + , snd_inv_photo_height :: Maybe Int -- ^ Photo height + , snd_inv_need_name :: Maybe Bool -- ^ Pass `True`, if you require the user's full name to complete the order + , snd_inv_need_phone_number :: Maybe Bool -- ^ Pass `True`, if you require the user's phone number to complete the order + , snd_inv_need_email :: Maybe Bool -- ^ Pass `True`, if you require the user's email to complete the order + , snd_inv_need_shipping_address :: Maybe Bool -- ^ Pass `True`, if you require the user's shipping address to complete the order + , snd_inv_send_phone_number_to_provider :: Maybe Bool -- ^ Pass True, if user's phone number should be sent to provider + , snd_inv_send_email_to_provider :: Maybe Bool -- ^ Pass True, if user's email address should be sent to provider + , snd_inv_is_flexible :: Maybe Bool -- ^ Pass `True`, if the final price depends on the shipping method + , snd_inv_disable_notification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound. + , snd_inv_reply_to_message :: Maybe Int -- ^ If the message is a reply, ID of the original message + , snd_inv_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard. If empty, one 'Pay total price' button will be shown. If not empty, the first button must be a Pay button. } deriving (Show, Generic) instance ToJSON SendInvoiceRequest where @@ -856,7 +858,7 @@ -> [LabeledPrice] -- ^ Price breakdown, a list of components (e.g. product price, tax, discount, delivery cost, delivery tax, bonus, etc.) -> SendInvoiceRequest sendInvoiceRequest chatId title description payload providerToken startParameter currency prices - = SendInvoiceRequest chatId title description payload providerToken startParameter currency prices Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + = SendInvoiceRequest chatId title description payload providerToken startParameter currency prices Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing data AnswerShippingQueryRequest -- | If you sent an invoice requesting a shipping address and the parameter is_flexible was specified, the Bot API will send an Update with a shipping_query field to the bot. Use this method to reply to shipping queries. On success, True is returned. diff --git a/telegram-api.cabal b/telegram-api.cabal --- a/telegram-api.cabal +++ b/telegram-api.cabal @@ -1,5 +1,5 @@ name: telegram-api -version: 0.7.1.0 +version: 0.7.2.0 synopsis: Telegram Bot API bindings description: High-level bindings to the Telegram Bot API homepage: http://github.com/klappvisor/haskell-telegram-api#readme @@ -47,10 +47,12 @@ , Servant.Client.MultipartFormData build-depends: base >= 4.7 && < 5 , aeson >= 1.0 && < 1.3 + , containers >= 0.5 && < 0.6 , http-api-data , http-client >= 0.5 && < 0.6 - , servant >= 0.11 && <0.12 - , servant-client >= 0.11 && <0.12 + , servant >= 0.12 && < 0.13 + , servant-client >= 0.12 && < 0.13 + , servant-client-core >= 0.12 && < 0.13 , mtl >= 2.2 && < 2.3 , text , transformers @@ -82,8 +84,9 @@ , http-types , hspec , optparse-applicative - , servant >= 0.11 && <0.12 - , servant-client >= 0.11 && <0.12 + , servant >= 0.12 && <0.13 + , servant-client >= 0.12 && <0.13 + , servant-client-core >= 0.12 && < 0.13 , telegram-api , http-types , filepath diff --git a/test/InlineSpec.hs b/test/InlineSpec.hs --- a/test/InlineSpec.hs +++ b/test/InlineSpec.hs @@ -48,6 +48,6 @@ inline_article = InlineQueryResultArticle "2131341" (Just "text article content") (Just message_content) Nothing Nothing Nothing Nothing Nothing Nothing Nothing inline_photo = InlineQueryResultPhoto "1430810" "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg" (Just "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg") Nothing Nothing Nothing Nothing Nothing Nothing Nothing -inline_gif = InlineQueryResultGif "131231234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing -inline_mpeg = InlineQueryResultMpeg4Gif "131251234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing +inline_gif = InlineQueryResultGif "131231234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing +inline_mpeg = InlineQueryResultMpeg4Gif "131251234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing inline_video = InlineQueryResultVideo "123413542" "https://www.youtube.com/embed/TBKN7_vx2xo" "text/html" (Just "https://i.ytimg.com/vi_webp/TBKN7_vx2xo/mqdefault.webp") (Just "Enjoykin — Nyash Myash") Nothing Nothing Nothing Nothing Nothing Nothing Nothing diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -14,7 +14,8 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Types.Status import Paths_telegram_api -import Servant.Client +import Servant.Client hiding (Response) +import qualified Servant.Client.Core as Core import System.FilePath import Test.Hspec import TestCore @@ -41,7 +42,7 @@ it "should return error message" $ do res <- sendMessage token (sendMessageRequest (ChatChannel "") "test message") manager nosuccess res - let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res + let Left (FailureResponse Core.Response { responseStatusCode = Status { statusMessage = msg } }) = res msg `shouldBe` "Bad Request" it "should send message markdown" $ do @@ -99,7 +100,7 @@ it "should forward message" $ do res <- forwardMessage token (forwardMessageRequest chatId chatId 123000) manager nosuccess res - let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res + let Left (FailureResponse Core.Response { responseStatusCode = Status { statusMessage = msg } }) = res msg `shouldBe` "Bad Request" describe "/sendPhoto" $ do @@ -107,7 +108,7 @@ let photo = (sendPhotoRequest (ChatChannel "") "photo_id") { photo_caption = Just "photo caption" } - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- sendPhoto token photo manager + Left (FailureResponse Core.Response { responseStatusCode = Status { statusMessage = msg } }) <- sendPhoto token photo manager msg `shouldBe` "Bad Request" it "should upload photo and resend it by id" $ do let fileUpload = localFileUpload $ testFile "christmas-cat.jpg" @@ -132,7 +133,7 @@ _audio_performer = Just "performer" , _audio_title = Just "title" } - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- + Left (FailureResponse Core.Response { responseStatusCode = Status { statusMessage = msg } }) <- sendAudio token audio manager msg `shouldBe` "Bad Request" it "should upload audio and resend it by id" $ do @@ -264,7 +265,7 @@ fmap (T.take 10) (file_path file) `shouldBe` Just "thumbnails" it "should return error" $ do - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- + Left (FailureResponse Core.Response { responseStatusCode = Status { statusMessage = msg } }) <- getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAmm" manager msg `shouldBe` "Bad Request"