From fdd33e471dcf1e79accec11bd28319e763483f50 Mon Sep 17 00:00:00 2001 From: DrewFenwick Date: Mon, 18 Oct 2021 15:22:31 +0100 Subject: [PATCH 1/3] Fix tests Add a field to the stickers object datatype, which will require a minor version bump. Fix an assumption of successful response in /getFile test. Fix an outdated dependence on SpecWith satisfying MonadFail. --- src/Web/Telegram/API/Bot/Data.hs | 21 +++++++++++---------- test/MainSpec.hs | 7 ++++--- test/Spec.hs | 2 +- 3 files changed, 16 insertions(+), 14 deletions(-) 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/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 $ From d94fb019d50ae600eee2d6197b9e472f0347d5b9 Mon Sep 17 00:00:00 2001 From: DrewFenwick Date: Mon, 18 Oct 2021 16:19:06 +0100 Subject: [PATCH 2/3] Increase Compatibility Add compatibility with servant-client 0.17 and 0.18 Update to newer version of cabal file spec. Add upper and lower bounds on all dependencies. Builds under GHC 8.6.5 through 9.0.1 Should be compatible with Stackage lts 14.0 through 18.16 --- src/Servant/Client/MultipartFormData.hs | 15 +++++++-- src/Web/Telegram/API/Bot/API/Core.hs | 4 +-- telegram-api.cabal | 44 ++++++++++++++----------- 3 files changed, 39 insertions(+), 24 deletions(-) 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/telegram-api.cabal b/telegram-api.cabal index 3b4228b..db993f1 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,11 @@ copyright: Alexey Rodiontsev (c) 2016 category: Web build-type: Simple -- extra-source-files: -cabal-version: >=1.10 +tested-with: GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.5 + , GHC == 8.10.7 + , GHC == 9.0.1 data-files: test-data/christmas-cat.jpg , test-data/cert.pem , test-data/haskell-logo.webp @@ -46,23 +51,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 +80,8 @@ test-suite telegram-api-test , UpdatesSpec , StickersSpec , TestCore + , Paths_telegram_api + autogen-modules: Paths_telegram_api build-depends: base , aeson , hjpath From b2e8733ed2b0720fc44e34943f1014ae0d2f81fe Mon Sep 17 00:00:00 2001 From: DrewFenwick Date: Tue, 19 Oct 2021 15:39:20 +0100 Subject: [PATCH 3/3] Tidy cabal file tested-with field --- telegram-api.cabal | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/telegram-api.cabal b/telegram-api.cabal index db993f1..5d54cd7 100644 --- a/telegram-api.cabal +++ b/telegram-api.cabal @@ -12,11 +12,7 @@ copyright: Alexey Rodiontsev (c) 2016 category: Web build-type: Simple -- extra-source-files: -tested-with: GHC == 8.6.5 - , GHC == 8.8.4 - , GHC == 8.10.5 - , GHC == 8.10.7 - , GHC == 9.0.1 +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