diff --git a/servant-jsaddle.cabal b/servant-jsaddle.cabal index 4ff54b6..0fe89eb 100644 --- a/servant-jsaddle.cabal +++ b/servant-jsaddle.cabal @@ -1,5 +1,5 @@ name: servant-jsaddle -version: 0.16 +version: 0.17 synopsis: automatic derivation of querying functions for servant webservices for jsaddle @@ -46,21 +46,21 @@ library -- Bundled with GHC: Lower bound to not force re-installs -- text and mtl are bundled starting with GHC-8.4 build-depends: - base >=4.9 && <4.14 - , bytestring >=0.10.8.1 && <0.11 + base >=4.9 && <5 + , bytestring >=0.10.8.1 && <0.13 , containers >=0.5.7.1 && <0.7 - , mtl >=2.2.2 && <2.3 - , text >=1.2.3.0 && <1.3 - , transformers >=0.5.2.0 && <0.6 + , mtl >=2.2.2 && <2.4 + , text >=1.2.3.0 && <2.2 + , transformers >=0.5.2.0 && <0.7 - if impl(ghcjs -any) + if impl(ghcjs -any) || arch(javascript) build-depends: ghcjs-base -- Servant dependencies. -- Strict dependency on `servant-client-core` as we re-export things. - build-depends: servant-client-core >=0.16 && <0.16.1 + build-depends: servant-client-core >=0.16 && <0.21 build-depends: - base-compat >=0.10.5 && <0.12 + base-compat >=0.10.5 && <=0.13.1 , case-insensitive >=1.2.0.0 && <1.3 , exceptions >=0.10.0 && <0.11 , ghcjs-dom >=0.9.4.0 && <0.10 @@ -68,7 +68,7 @@ library , http-types >=0.12.2 && <0.13 , jsaddle >=0.9.6.0 && <0.10 , monad-control >=1.0.2.3 && <1.1 - , semigroupoids >=5.3.1 && <5.4 + , semigroupoids >=5.3.1 && <6.1 , string-conversions >=0.3 && <0.5 , transformers-base >=0.4.4 && <0.5 @@ -82,7 +82,7 @@ test-suite spec hs-source-dirs: test main-is: Spec.hs - if impl(ghcjs -any) + if impl(ghcjs -any) || arch(javascript) build-depends: base , servant-jsaddle diff --git a/src/Servant/Client/Internal/JSaddleXhrClient.hs b/src/Servant/Client/Internal/JSaddleXhrClient.hs index e219ff2..d242c85 100644 --- a/src/Servant/Client/Internal/JSaddleXhrClient.hs +++ b/src/Servant/Client/Internal/JSaddleXhrClient.hs @@ -48,6 +48,8 @@ import Data.Foldable (toList) import Data.Functor.Alt (Alt (..)) +import Data.Maybe + (fromMaybe) import Data.Proxy (Proxy (..)) import qualified Data.Sequence as Seq @@ -70,7 +72,7 @@ import qualified Language.Javascript.JSaddle.Types as JSaddle import Network.HTTP.Media (renderHeader) import Network.HTTP.Types - (ResponseHeaders, http11, mkStatus, renderQuery, statusCode) + (ResponseHeaders, Status, http11, mkStatus, renderQuery, statusCode) import System.IO (hPutStrLn, stderr) @@ -120,9 +122,15 @@ instance Alt ClientM where instance RunClient ClientM where throwClientError = throwError +#if MIN_VERSION_servant_client_core(0,18,1) + runRequestAcceptStatus acceptStatuses r = do + d <- ClientM askDOM + performRequest (fromMaybe [] acceptStatuses) d r +#else runRequest r = do d <- ClientM askDOM - performRequest d r + performRequest [] d r +#endif runClientM :: ClientM a -> ClientEnv -> DOM (Either ClientError a) runClientM cm env = runExceptT $ flip runReaderT env $ fromClientM cm @@ -156,8 +164,8 @@ getDefaultBaseUrl = do pure (BaseUrl protocol hostname port "") -performRequest :: DOMContext -> Request -> ClientM Response -performRequest domc req = do +performRequest :: [Status] -> DOMContext -> Request -> ClientM Response +performRequest acceptStatuses domc req = do xhr <- JS.newXMLHttpRequest `runDOM` domc burl <- asks baseUrl fixUp <- asks fixUpXhr @@ -165,7 +173,7 @@ performRequest domc req = do resp <- toResponse domc xhr let status = statusCode (responseStatusCode resp) - unless (status >= 200 && status < 300) $ + unless ((status >= 200 && status < 300) || status `elem` (statusCode <$> acceptStatuses)) $ throwError $ mkFailureResponse burl req resp pure resp