diff --git a/src/Servant/Client/MultipartFormData.hs b/src/Servant/Client/MultipartFormData.hs index ce2efb8..1b6d17d 100644 --- a/src/Servant/Client/MultipartFormData.hs +++ b/src/Servant/Client/MultipartFormData.hs @@ -7,6 +7,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE CPP #-} module Servant.Client.MultipartFormData ( ToMultipartFormData (..) @@ -36,8 +38,10 @@ import qualified Network.HTTP.Types.Header as HTTP import Servant.API import Servant.Client import qualified Servant.Client.Core as Core -import Servant.Client.Internal.HttpClient (catchConnectionError, clientResponseToResponse, - requestToClientRequest) +import Servant.Client.Internal.HttpClient (catchConnectionError, clientResponseToResponse) +#if !MIN_VERSION_servant_client(0,17,0) +import Servant.Client.Internal.HttpClient (requestToClientRequest) +#endif -- | A type that can be converted to a multipart/form-data value. class ToMultipartFormData a where @@ -53,7 +57,12 @@ instance (Core.RunClient m, ToMultipartFormData b, MimeUnrender ct a, cts' ~ (ct 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' + let requestWithoutBody = +#if MIN_VERSION_servant_client(0,17,0) + defaultMakeClientRequest baseurl' req' +#else + requestToClientRequest baseurl' req' +#endif formDataBody (toMultipartFormData reqData) requestWithoutBody in snd <$> performRequestCT' requestToClientRequest' (Proxy :: Proxy ct) H.methodPost req diff --git a/src/Web/Telegram/API/Bot/API/Core.hs b/src/Web/Telegram/API/Bot/API/Core.hs index 963c295..4a0a5cd 100644 --- a/src/Web/Telegram/API/Bot/API/Core.hs +++ b/src/Web/Telegram/API/Bot/API/Core.hs @@ -44,7 +44,7 @@ runClient' tcm token = runClientM (runReaderT tcm token) -- | Runs 'TelegramClient' runClient :: TelegramClient a -> Token -> Manager -> IO (Either ClientError a) -runClient tcm token manager = runClient' tcm token (ClientEnv manager telegramBaseUrl Nothing) +runClient tcm token manager = runClient' tcm token (mkClientEnv manager telegramBaseUrl) -- | Runs 'TelegramClient' runTelegramClient :: Token -> Manager -> TelegramClient a -> IO (Either ClientError a) @@ -54,7 +54,7 @@ asking :: Monad m => (t -> m b) -> ReaderT t m b asking op = ask >>= \t -> lift $ op t run :: BaseUrl -> (Token -> a -> ClientM b) -> Token -> a -> Manager -> IO (Either ClientError b) -run b e t r m = runClientM (e t r) (ClientEnv m b Nothing) +run b e t r m = runClientM (e t r) (mkClientEnv m b) run_ :: Monad m => (a -> b -> m c) -> b -> ReaderT a m c run_ act request = asking $ flip act request diff --git a/src/Web/Telegram/API/Bot/Data.hs b/src/Web/Telegram/API/Bot/Data.hs index ff58954..5ad5e00 100644 --- a/src/Web/Telegram/API/Bot/Data.hs +++ b/src/Web/Telegram/API/Bot/Data.hs @@ -290,16 +290,17 @@ instance FromJSON Animation where -- | This object represents a sticker. data Sticker = Sticker - { - sticker_file_id :: Text -- ^ Unique identifier for this file - , sticker_width :: Int -- ^ Sticker width - , sticker_height :: Int -- ^ Sticker height - , sticker_thumb :: Maybe PhotoSize -- ^ Sticker thumbnail in .webp or .jpg format - , sticker_emoji :: Maybe Text -- ^ Emoji associated with the sticker - , sticker_set_name :: Maybe Text - , sticker_mask_position :: Maybe MaskPosition - , sticker_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) + { sticker_file_id :: Text -- ^ Unique identifier for this file + , sticker_file_unique_id :: Text + , sticker_width :: Int -- ^ Sticker width + , sticker_height :: Int -- ^ Sticker height + , sticker_thumb :: Maybe PhotoSize -- ^ Sticker thumbnail in .webp or .jpg format + , sticker_emoji :: Maybe Text -- ^ Emoji associated with the sticker + , sticker_set_name :: Maybe Text + , sticker_mask_position :: Maybe MaskPosition + , sticker_file_size :: Maybe Int -- ^ File size + } + deriving (Show, Generic) instance ToJSON Sticker where toJSON = toJsonDrop 8 diff --git a/telegram-api.cabal b/telegram-api.cabal index 3b4228b..5d54cd7 100644 --- a/telegram-api.cabal +++ b/telegram-api.cabal @@ -1,9 +1,10 @@ +cabal-version: 3.4 name: telegram-api version: 0.7.1.0 synopsis: Telegram Bot API bindings description: High-level bindings to the Telegram Bot API homepage: http://github.com/klappvisor/haskell-telegram-api#readme -license: BSD3 +license: BSD-3-Clause license-file: LICENSE author: Alexey Rodiontsev maintainer: alex.rodiontsev@gmail.com @@ -11,7 +12,7 @@ copyright: Alexey Rodiontsev (c) 2016 category: Web build-type: Simple -- extra-source-files: -cabal-version: >=1.10 +tested-with: GHC == {8.6.5, 8.8.4, 8.10.5, 8.10.7, 9.0.1} data-files: test-data/christmas-cat.jpg , test-data/cert.pem , test-data/haskell-logo.webp @@ -46,23 +47,22 @@ library , Web.Telegram.API.Bot.API.Core , Servant.Client.MultipartFormData build-depends: base >= 4.7 && < 5 - , aeson - , containers - , http-api-data - , http-client - , servant - , servant-client == 0.16 - , servant-client-core - , mtl - , text - , transformers - , http-media - , http-types - , mime-types - , bytestring - , string-conversions - , binary - default-language: Haskell2010 + , aeson ^>= {1.4.4, 1.5.6} + , containers ^>= 0.6.0 + , http-api-data ^>= 0.4.1 + , http-client ^>= {0.6.4, 0.7.0} + , servant (>= 0.16 && < 0.18) || ^>= 0.18 + , servant-client (>= 0.16 && < 0.18) || ^>= 0.18 + , servant-client-core (>= 0.16 && < 0.18) || ^>= 0.18 + , mtl ^>= 2.2.2 + , text ^>= 1.2.3 + , transformers ^>= 0.5.6 + , http-media ^>= 0.8.0.0 + , http-types ^>= 0.12.3 + , mime-types ^>= 0.1.0.0 + , bytestring ^>= 0.10.8 + , string-conversions ^>= 0.4.0.1 + , binary ^>= 0.8.6 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-binds test-suite telegram-api-test @@ -76,6 +76,8 @@ test-suite telegram-api-test , UpdatesSpec , StickersSpec , TestCore + , Paths_telegram_api + autogen-modules: Paths_telegram_api build-depends: base , aeson , hjpath diff --git a/test/MainSpec.hs b/test/MainSpec.hs index ba82ecf..a38ab70 100644 --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -162,7 +162,7 @@ spec token chatId botName = do let sticker = sendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" Right Response { result = Message { sticker = Just sticker } } <- sendSticker token sticker manager - sticker_file_id sticker `shouldBe` "CAADAgADGgADkWgMAAFNFIZh3zoKbRYE" --"BQADAgADGgADkWgMAAGXlYGBiM_d2wI" + sticker_file_unique_id sticker `shouldBe` "AgADGgADkWgMAAE" --"BQADAgADGgADkWgMAAGXlYGBiM_d2wI" it "should upload sticker" $ do let fileUpload = localFileUpload $ testFile "haskell-logo.webp" stickerReq = uploadStickerRequest chatId fileUpload @@ -258,8 +258,9 @@ spec token chatId botName = do describe "/getFile" $ do it "should get file" $ do - Right Response { result = file } <- - getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC" manager + res <- getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC" manager + success res + Right Response { result = file } <- pure res fmap (T.take 10) (file_path file) `shouldBe` Just "thumbnails" it "should return error" $ do diff --git a/test/Spec.hs b/test/Spec.hs index 172db43..72fb709 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -81,7 +81,7 @@ runIntegrationSpec (Just token) (Just chatId) (Just botName) (Just paymentToken) describe "Stickers API spec" $ StickersSpec.spec token chatId botName --describe "Inline integration tests" $ InlineSpec.spec token chatId botName runIntegrationSpec _ _ _ _ = describe "Integration tests" $ - fail "Missing required arguments for integration tests. Run stack test --test-arguments \"--help\" for more info" + error "Missing required arguments for integration tests. Run stack test --test-arguments \"--help\" for more info" description :: Maybe PP.Doc description = Just $