telegram-api 0.7.1.0 → 0.7.2.0
raw patch · 11 files changed
+89/−76 lines, 11 filesdep +containersdep +servant-client-coredep ~basedep ~servantdep ~servant-client
Dependencies added: containers, servant-client-core
Dependency ranges changed: base, servant, servant-client
Files
- README.md +4/−3
- src/Servant/Client/MultipartFormData.hs +39/−33
- src/Web/Telegram/API/Bot/API/Chats.hs +1/−1
- src/Web/Telegram/API/Bot/API/Edit.hs +1/−1
- src/Web/Telegram/API/Bot/API/Messages.hs +1/−1
- src/Web/Telegram/API/Bot/API/Stickers.hs +1/−1
- src/Web/Telegram/API/Bot/API/Updates.hs +1/−1
- src/Web/Telegram/API/Bot/Requests.hs +24/−22
- telegram-api.cabal +8/−5
- test/InlineSpec.hs +2/−2
- test/MainSpec.hs +7/−6
README.md view
@@ -32,16 +32,17 @@ main = do let token = Token "bot<token>" -- 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
src/Servant/Client/MultipartFormData.hs view
@@ -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)
src/Web/Telegram/API/Bot/API/Chats.hs view
@@ -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
src/Web/Telegram/API/Bot/API/Edit.hs view
@@ -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
src/Web/Telegram/API/Bot/API/Messages.hs view
@@ -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
src/Web/Telegram/API/Bot/API/Stickers.hs view
@@ -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
src/Web/Telegram/API/Bot/API/Updates.hs view
@@ -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
src/Web/Telegram/API/Bot/Requests.hs view
@@ -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 <https://core.telegram.org/bots/payments#supported-currencies currency> 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 <https://core.telegram.org/bots/payments#supported-currencies currency> 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.
telegram-api.cabal view
@@ -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
test/InlineSpec.hs view
@@ -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
test/MainSpec.hs view
@@ -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"