diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,9 @@ +## 0.3.0.0 + +* Update to work with the latest version of Servant (0.14) and remove support from older versions of Servant. +* Remove support from Stackage LTS versions older than 12. + ## 0.2.0.2 * Add missing test file to extra-source-files in the cabal file. diff --git a/example/Client.hs b/example/Client.hs --- a/example/Client.hs +++ b/example/Client.hs @@ -6,14 +6,14 @@ import qualified Data.ByteString.Lazy as LBS import Data.Monoid ((<>)) import Data.Proxy (Proxy(Proxy)) -import Network.HTTP.Client (Response, defaultManagerSettings, newManager, responseBody) -import Network.HTTP.Media (MediaType) -import Network.HTTP.Types (Header, Method, methodGet) +import Data.Text (Text) +import Network.HTTP.Client (defaultManagerSettings, newManager) +import Network.HTTP.Types (methodGet) import Servant.API ((:<|>)((:<|>))) import Servant.Client - (BaseUrl(BaseUrl), ClientEnv(ClientEnv), ClientM, Scheme(Http), - client, runClientM) -import Servant.Common.Req (Req, appendToPath) + (BaseUrl(BaseUrl), ClientM, Response, Scheme(Http), + client, mkClientEnv, responseBody, runClientM) +import Servant.Client.Core (Request, appendToPath, requestMethod) import Servant.RawM () import Api (Api, port) @@ -23,15 +23,17 @@ ----------------------------------------- otherEndpoint1 :: ClientM Int -getFile' :: Method -> (Req -> Req) -> ClientM (Int, ByteString, MediaType, [Header], Response ByteString) +getFile' :: (Request -> Request) -> ClientM Response otherEndpoint2 :: ClientM Int otherEndpoint1 :<|> getFile' :<|> otherEndpoint2 = client (Proxy :: Proxy Api) -getFile :: String -> ClientM ByteString +getFile :: Text -> ClientM ByteString getFile filePath = do - (_, _, _, _, resp) <- getFile' methodGet $ \req -> appendToPath filePath req + resp <- + getFile' $ \req -> appendToPath filePath req { requestMethod = methodGet } pure $ responseBody resp + ---------- -- Main -- ---------- @@ -39,7 +41,7 @@ main :: IO () main = do manager <- newManager defaultManagerSettings - let clientEnv = ClientEnv manager baseUrl + let clientEnv = mkClientEnv manager baseUrl eitherRes <- runClientM (getFile "foo.txt") clientEnv case eitherRes of Left servantErr -> putStrLn $ "Got a ServantErr: " <> show servantErr diff --git a/example/Server.hs b/example/Server.hs --- a/example/Server.hs +++ b/example/Server.hs @@ -8,8 +8,7 @@ import Data.Proxy (Proxy(Proxy)) import Network.Wai (Application) import Network.Wai.Handler.Warp (run) -import Servant (Handler, (:<|>)((:<|>)), Server, ServerT, serve) -import Servant.Utils.Enter ((:~>)(NT), enter) +import Servant (Handler, (:<|>)((:<|>)), Server, ServerT, hoistServer, serve) import Servant.RawM (serveDirectoryWebApp) @@ -42,14 +41,14 @@ (Config _ int2 _) <- ask pure int2 +apiProxy :: Proxy Api +apiProxy = Proxy + app :: Config -> Application -app conf = serve (Proxy :: Proxy Api) apiServer +app conf = serve apiProxy apiServer where apiServer :: Server Api - apiServer = enter naturalTrans serverRoot - - naturalTrans :: ReaderT Config IO :~> Handler - naturalTrans = NT transformation + apiServer = hoistServer apiProxy transformation serverRoot transformation :: ReaderT Config IO a -> Handler a transformation readerT = liftIO $ runReaderT readerT conf diff --git a/servant-rawm.cabal b/servant-rawm.cabal --- a/servant-rawm.cabal +++ b/servant-rawm.cabal @@ -1,5 +1,5 @@ name: servant-rawm -version: 0.2.0.2 +version: 0.3.0.0 synopsis: Embed a raw 'Application' in a Servant API description: Please see . homepage: https://github.com/cdepillabout/servant-rawm @@ -37,11 +37,12 @@ , http-types >= 0.9 , lens >= 4.0 , resourcet >= 1.0 - , servant-client >= 0.9 - , servant-docs >= 0.9 - , servant-server >= 0.9 + , servant-client >= 0.14 + , servant-docs >= 0.11 + , servant-server >= 0.14 , wai >= 3.2 , wai-app-static >= 3.1 + , servant-client-core >= 0.14 default-language: Haskell2010 ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists @@ -60,6 +61,7 @@ , servant , servant-rawm , servant-client + , servant-client-core , text default-language: Haskell2010 ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists -threaded -rtsopts -with-rtsopts=-N @@ -128,11 +130,13 @@ , http-types , servant , servant-client + , servant-client-core , servant-rawm , servant-server , tasty , tasty-hspec , tasty-hunit + , text , transformers , wai , warp diff --git a/src/Servant/RawM.hs b/src/Servant/RawM.hs --- a/src/Servant/RawM.hs +++ b/src/Servant/RawM.hs @@ -29,12 +29,15 @@ filePath <- 'Control.Monad.Reader.ask' 'serveDirectoryWebApp' filePath + apiProxy :: 'Data.Proxy.Proxy' Api + apiProxy = 'Data.Proxy.Proxy' + app :: FilePath -> 'Network.Wai.Application' app filePath = - 'Servant.Server.serve' ('Data.Proxy.Proxy' :: 'Data.Proxy.Proxy' Api) apiServer + 'Servant.Server.serve' apiProxy apiServer where - apiServer :: Server Api - apiServer = 'Servant.Utils.Enter.enter' ('Servant.Utils.Enter.NT' transformation) serverRoot + apiServer :: 'Servant.Server.Server' Api + apiServer = 'Servant.Server.hoistServer' apiProxy transformation serverRoot transformation :: 'Control.Monad.Reader.ReaderT' 'FilePath' 'IO' a -> 'Servant.Server.Handler' a transformation readerT = 'Control.Monad.IO.Class.liftIO' $ 'Control.Monad.Reader.runReaderT' readerT filePath diff --git a/src/Servant/RawM/Internal/Client.hs b/src/Servant/RawM/Internal/Client.hs --- a/src/Servant/RawM/Internal/Client.hs +++ b/src/Servant/RawM/Internal/Client.hs @@ -1,4 +1,7 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -17,35 +20,39 @@ module Servant.RawM.Internal.Client where -import Data.ByteString.Lazy (ByteString) import Data.Proxy (Proxy(Proxy)) -import Network.HTTP.Client (Response) -import Network.HTTP.Media (MediaType) -import Network.HTTP.Types (Header, Method) -import Servant.Client (Client, ClientM, HasClient(clientWithRoute)) -import Servant.Common.Req (Req, performRequest) - +import Servant.Client (Client, HasClient(clientWithRoute, hoistClientMonad)) +import Servant.Client.Core (runRequest, RunClient, Request, Response) import Servant.RawM.Internal.API (RawM') -- | Creates a client route like the following: -- -- >>> :set -XTypeOperators -- >>> import Data.Type.Equality ((:~:)(Refl)) --- >>> Refl :: Client (RawM' a) :~: (Method -> (Req -> Req) -> ClientM (Int, ByteString, MediaType, [Header], Response ByteString)) +-- >>> Refl :: Client m (RawM' a) :~: ((Request -> Request) -> m Response) -- Refl -- --- This allows modification of the underlying 'Req' to work for any sort of +-- This allows modification of the underlying 'Request' to work for any sort of -- 'Network.Wai.Application'. -- -- Check out the -- in -- the source code repository that shows a more in-depth server, client, and -- documentation. -instance HasClient (RawM' serverType) where - type Client (RawM' serverType) = - Method - -> (Req -> Req) - -> ClientM (Int, ByteString, MediaType, [Header], Response ByteString) +instance RunClient m => HasClient m (RawM' serverType) where + type Client m (RawM' serverType) = (Request -> Request) -> m Response - clientWithRoute :: Proxy (RawM' serverType) -> Req -> Client (RawM' serverType) - clientWithRoute Proxy req method f = performRequest method $ f req + clientWithRoute + :: Proxy m + -> Proxy (RawM' serverType) + -> Request + -> Client m (RawM' serverType) + clientWithRoute Proxy Proxy req reqFunc = runRequest $ reqFunc req + + hoistClientMonad + :: Proxy m + -> Proxy (RawM' serverType) + -> (forall x. mon x -> mon' x) + -> Client mon (RawM' serverType) + -> Client mon' (RawM' serverType) + hoistClientMonad Proxy Proxy f cl = \meth -> f (cl meth) diff --git a/src/Servant/RawM/Internal/Server.hs b/src/Servant/RawM/Internal/Server.hs --- a/src/Servant/RawM/Internal/Server.hs +++ b/src/Servant/RawM/Internal/Server.hs @@ -31,7 +31,7 @@ import Network.Wai.Application.Static (StaticSettings, defaultFileServerSettings, defaultWebAppSettings, embeddedSettings, staticApp, webAppSettingsWithLookup) -import Servant (Context, HasServer(route), Handler, ServerT, runHandler) +import Servant (Context, HasServer(route, hoistServerWithContext), Handler, ServerT, runHandler) import Servant.Server.Internal (Delayed, Router'(RawRouter), RouteResult(Fail, FailFatal, Route), responseServantErr, runDelayed) @@ -74,7 +74,13 @@ case eitherApp of Left err -> respond . Route $ responseServantErr err Right app -> app request (respond . Route) - + hoistServerWithContext + :: Proxy (RawM' serverType) + -> Proxy context + -> (forall x. m x -> n x) + -> m Application + -> n Application + hoistServerWithContext Proxy Proxy f m = f m -- | Serve anything under the specified directory as a 'RawM'' endpoint. -- diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-9.2 +resolver: lts-12.7 # Local packages, usually specified by relative directory name packages: diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -14,19 +14,17 @@ import Data.Either (isLeft) import Data.Monoid ((<>)) import Data.Proxy (Proxy(Proxy)) +import Data.Text (Text) import Data.Type.Equality ((:~:)(Refl)) import Data.Typeable (Typeable) -import Network.HTTP.Client - (Response, defaultManagerSettings, newManager, responseBody) -import Network.HTTP.Media (MediaType) -import Network.HTTP.Types (Header, Method, methodGet) +import Network.HTTP.Client (defaultManagerSettings, newManager) +import Network.HTTP.Types (methodGet) import Network.Wai (Application) import Network.Wai.Handler.Warp (run) -import Servant ((:>), (:~>)(NT), Handler, ServerT, enter, serve) +import Servant ((:>), Handler, ServerT, hoistServer, serve) import Servant.Client - (Client, ClientEnv(ClientEnv), ClientM, client, runClientM) -import Servant.Common.BaseUrl (parseBaseUrl) -import Servant.Common.Req (Req, appendToPath) + (Client, ClientM, Response, client, mkClientEnv, parseBaseUrl, responseBody, runClientM) +import Servant.Client.Core (Request, appendToPath, requestMethod) import Test.Hspec.Wai (get, shouldRespondWith, with) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Hspec (afterAll, beforeAll, it, shouldBe, testSpec) @@ -88,11 +86,7 @@ checkRawMServer = Refl checkRawMClient - :: Client RawM :~: - ( Method -> - (Req -> Req) -> - ClientM (Int, ByteString, MediaType, [Header], Response ByteString) - ) + :: Client m RawM :~: ((Request -> Request) -> m Response) checkRawMClient = Refl instanceTests :: TestTree @@ -118,9 +112,12 @@ serveDirectoryWebApp path app :: Application -app = serve (Proxy :: Proxy Api) $ enter (NT trans) server +app = + let proxy = Proxy :: Proxy Api + in + serve proxy $ hoistServer proxy trans server where - trans :: ReaderT FilePath IO a -> Handler a + trans :: forall a. ReaderT FilePath IO a -> Handler a trans readerT = liftIO $ runReaderT readerT "example/files" serverTestsIO :: IO TestTree @@ -137,21 +134,21 @@ -------------------------------- getFile' - :: Method - -> (Req -> Req) - -> ClientM (Int, ByteString, MediaType, [Header], Response ByteString) + :: (Request -> Request) + -> ClientM Response getFile' = client (Proxy :: Proxy Api) -getFile :: String -> ClientM ByteString +getFile :: Text -> ClientM ByteString getFile filePath = do - (_, _, _, _, resp) <- getFile' methodGet $ \req -> appendToPath filePath req + resp <- + getFile' $ \req -> appendToPath filePath req { requestMethod = methodGet } pure $ responseBody resp clientTestsIO :: IO TestTree clientTestsIO = do manager <- newManager defaultManagerSettings baseUrl <- parseBaseUrl $ "http://localhost:" <> show port <> "/" - let clientEnv = ClientEnv manager baseUrl + let clientEnv = mkClientEnv manager baseUrl testSpec "client" . beforeAll runServer . afterAll killServer $ do it "correctly gets files" $ \_ -> do eitherRes <- runClientM (getFile "bar.txt") clientEnv