servant-rawm 0.2.0.2 → 0.3.0.0
raw patch · 9 files changed
+87/−64 lines, 9 filesdep +servant-client-coredep ~servant-clientdep ~servant-docsdep ~servant-server
Dependencies added: servant-client-core
Dependency ranges changed: servant-client, servant-docs, servant-server
Files
- CHANGELOG.md +5/−0
- example/Client.hs +12/−10
- example/Server.hs +6/−7
- servant-rawm.cabal +8/−4
- src/Servant/RawM.hs +6/−3
- src/Servant/RawM/Internal/Client.hs +23/−16
- src/Servant/RawM/Internal/Server.hs +8/−2
- stack.yaml +1/−1
- test/Spec.hs +18/−21
CHANGELOG.md view
@@ -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.
example/Client.hs view
@@ -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
example/Server.hs view
@@ -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
servant-rawm.cabal view
@@ -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 <https://github.com/cdepillabout/servant-rawm#readme README.md>. 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
src/Servant/RawM.hs view
@@ -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
src/Servant/RawM/Internal/Client.hs view
@@ -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 -- <https://github.com/cdepillabout/servant-rawm/tree/master/example example> 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)
src/Servant/RawM/Internal/Server.hs view
@@ -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. --
stack.yaml view
@@ -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:
test/Spec.hs view
@@ -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