servant-rawm 0.2.0.0 → 0.2.0.1
raw patch · 13 files changed
+422/−35 lines, 13 filesdep +Globdep +doctestdep +hspec-waidep −containersdep ~basedep ~bytestringdep ~http-clientPVP ok
version bump matches the API change (PVP)
Dependencies added: Glob, doctest, hspec-wai, tasty, tasty-hspec, tasty-hunit
Dependencies removed: containers
Dependency ranges changed: base, bytestring, http-client, http-media, http-types, servant, servant-client, servant-server, wai
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- README.md +64/−1
- example/Client.hs +0/−1
- example/files/foo.txt +3/−0
- servant-rawm.cabal +34/−29
- src/Servant/RawM.hs +57/−0
- src/Servant/RawM/Internal.hs +6/−3
- src/Servant/RawM/Internal/API.hs +16/−0
- src/Servant/RawM/Internal/Client.hs +14/−0
- src/Servant/RawM/Internal/Docs.hs +4/−1
- src/Servant/RawM/Internal/Server.hs +7/−0
- test/DocTest.hs +40/−0
- test/Spec.hs +173/−0
CHANGELOG.md view
@@ -1,4 +1,8 @@ +## 0.2.0.1++* Add tests and more documentation.+ ## 0.2.0.0 * (commit 30a2cd48488d) Add a phantom type to `RawM` to allow the user to
README.md view
@@ -7,4 +7,67 @@ [](http://stackage.org/nightly/package/servant-rawm)  -`servant-rawm` provides a way to embed a WAI `Application` in a Servant handler.+`servant-rawm` provides a way to embed a WAI+[`Application`](https://hackage.haskell.org/package/wai-3.2.1.1/docs/Network-Wai.html#t:Application)+in a Servant handler. It is more convenient and powerful than the+[`Raw`](https://hackage.haskell.org/package/servant-0.11/docs/Servant-API-Raw.html#t:Raw)+type provided by [`servant`](https://hackage.haskell.org/package/servant).++See the+[Haddocks on Hackage for `servant-rawm`](https://hackage.haskell.org/package/servant-rawm/docs/Servant-RawM.html)+for an explanation of how to use the+[`RawM`](https://hackage.haskell.org/package/servant-rawm/docs/Servant-RawM.html#t:RawM)+type.++## Example++There is code for an example server, client, and documentation located+in [`example/`](example/). The following section describes how to run the+example executables.++### Building++The example executables can be built with the following command:++```sh+$ stack build --flag servant-rawm:buildexample+```++### Server++After building, the server can be run with the following command:++```sh+$ stack exec -- servant-rawm-example-server+```++This runs a server on port 8201 serving files+in [`example/files/`](example/files/).++It can be accessed from `curl` like the following:++```sh+$ curl http://localhost:8201/serve-directory/foo.txt+This is an example text file.+```++### Client++After building, the client can be run like the following:++```sh+$ stack exec -- servant-rawm-example-client+Successfully got file ./example/files/foo.txt:++This is an example text file.+```++### Documentation++After building, the documentation can be generated like the following. This is+documentation for the API defined in [example/Api.hs](example/Api.hs):++```sh+$ stack exec -- servant-rawm-example-docs+...+```
example/Client.hs view
@@ -14,7 +14,6 @@ (BaseUrl(BaseUrl), ClientEnv(ClientEnv), ClientM, Scheme(Http), client, runClientM) import Servant.Common.Req (Req, appendToPath)- import Servant.RawM () import Api (Api, port)
+ example/files/foo.txt view
@@ -0,0 +1,3 @@+This is an example text file.++The example API will serve any file in the ./example/files directory.
servant-rawm.cabal view
@@ -1,5 +1,5 @@ name: servant-rawm-version: 0.2.0.0+version: 0.2.0.1 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@@ -12,6 +12,7 @@ build-type: Simple extra-source-files: CHANGELOG.md , README.md+ , example/files/foo.txt , stack.yaml cabal-version: >=1.10 @@ -29,14 +30,12 @@ , Servant.RawM.Internal.Server build-depends: base >= 4.8 && < 5 , bytestring >= 0.10- , containers >= 0.5 , filepath >= 1.4 , http-client >= 0.5 , http-media >= 0.6 , http-types >= 0.9 , lens >= 4.0 , resourcet >= 1.0- , servant >= 0.9 , servant-client >= 0.9 , servant-docs >= 0.9 , servant-server >= 0.9@@ -105,33 +104,39 @@ else buildable: False --- test-suite servant-rawm-doctest--- type: exitcode-stdio-1.0--- main-is: DocTest.hs--- hs-source-dirs: test--- build-depends: base--- , doctest--- , Glob--- default-language: Haskell2010--- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+test-suite servant-rawm-doctest+ type: exitcode-stdio-1.0+ main-is: DocTest.hs+ hs-source-dirs: test+ build-depends: base+ , doctest+ , Glob+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N --- test-suite servant-rawm-test--- type: exitcode-stdio-1.0--- main-is: Spec.hs--- other-modules:--- hs-source-dirs: test--- build-depends: base--- , bytestring--- , hspec-wai--- , tasty--- , tasty-hspec--- , tasty-hunit--- , servant--- , servant-rawm--- , servant-server--- , wai--- default-language: Haskell2010--- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists+test-suite servant-rawm-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ hs-source-dirs: test+ build-depends: base+ , bytestring+ , hspec-wai+ , http-client+ , http-media+ , http-types+ , servant+ , servant-client+ , servant-rawm+ , servant-server+ , tasty+ , tasty-hspec+ , tasty-hunit+ , transformers+ , wai+ , warp+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -Wmissing-import-lists source-repository head type: git
src/Servant/RawM.hs view
@@ -8,6 +8,63 @@ Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +This module exposes a 'RawM' type that allows you to embed a WAI+'Network.Wai.Application' in your Servant API.++It is similar to 'Servant.API.Raw.Raw' provided by Servant, but there is one big+difference. 'RawM' allows you to use monadic effects to create the+'Network.Wai.Application'.++What does this look like in practice? The following is an example of using+'RawM':++@+ type Api = \"serve-directory-example\" :> 'RawM'++ serverRoot :: 'Servant.Server.ServerT' Api ('Control.Monad.Reader.ReaderT' 'FilePath' 'IO')+ serverRoot = rawEndpoint++ rawEndpoint :: 'Control.Monad.Reader.ReaderT' 'FilePath' 'IO' 'Network.Wai.Application'+ rawEndpoint = do+ filePath <- 'Control.Monad.Reader.ask'+ 'serveDirectoryWebApp' filePath++ app :: FilePath -> 'Network.Wai.Application'+ app filePath =+ 'Servant.Server.serve' ('Data.Proxy.Proxy' :: 'Data.Proxy.Proxy' Api) apiServer+ where+ apiServer :: Server Api+ apiServer = 'Servant.Utils.Enter.enter' ('Servant.Utils.Enter.NT' 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+@++Notice how the above @rawEndpoint@ handler is able to get the @filePath@ from+the 'Control.Monad.Reader.ReaderT'. Using Servant's default+'Servant.API.Raw.Raw' type, @rawEndpoint@ would have to be written like the+following:++@+ type Api\' = \"serve-directory-example\" :> 'Raw'++ serverRoot\' :: 'Server.ServerT' Api ('Control.Monad.Reader.ReaderT' 'FilePath' 'IO')+ serverRoot\' = rawEndpoint\'++ rawEndpoint\' :: 'Data.Tagged.Tagged' ('Control.Monad.Reader.ReaderT' 'FilePath' 'IO') 'Network.Wai.Application'+ rawEndpoint\' = ...+@++@rawEndpoint\'@ does not have access to the 'Control.Monad.Reader.ReaderT' monad,+so there is no way to get the directory path.++'RawM' solves this problem by allowing the 'Network.Wai.Application' to be+produced monadically.++There is an+<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. -} module Servant.RawM
src/Servant/RawM/Internal.hs view
@@ -14,10 +14,13 @@ -} module Servant.RawM.Internal- ( module X+ ( module Servant.RawM.Internal.API+ -- , module Servant.RawM.Internal.Client+ -- , module Servant.RawM.Internal.Docs+ , module Servant.RawM.Internal.Server ) where -import Servant.RawM.Internal.API as X+import Servant.RawM.Internal.API import Servant.RawM.Internal.Client () import Servant.RawM.Internal.Docs ()-import Servant.RawM.Internal.Server as X+import Servant.RawM.Internal.Server
src/Servant/RawM/Internal/API.hs view
@@ -12,8 +12,24 @@ import Data.Typeable (Typeable) +-- | Specialization of 'RawM'' to 'FileServer'. This can be used if you are+-- using 'Servant.RawM.serveDirectoryWebApp',+-- 'Servant.RawM.serveDirectoryFileServer', etc. type RawM = RawM' FileServer +-- | This is a type to use to define a Servant API. It signifies a route that+-- allows embedding of a WAI 'Network.Wai.Application'. It is similar to+-- 'Servant.API.Raw.Raw', but it has a 'Servant.Server.HasServer' instance that+-- allows embedding of monadic effects. This should be more convenient than+-- 'Servant.API.Raw.Raw'.+--+-- The phantom type @serverType@ is used for defining the 'Servant.Docs.HasDocs'+-- instance. There are instances for 'Servant.Client.HasClient' and+-- 'Servant.Server.HasServer' for 'RawM'' with a polymorphic phantom type, but+-- there is only a 'Servant.Docs.HasDocs' instance specified for @'RawM''+-- 'FileServer'@. This allows the end-user to easily create a+-- 'Servant.Docs.HasDocs' instance for a custom 'Network.Wai.Application'. data RawM' serverType deriving Typeable +-- | Used by 'RawM' as a phantom type. data FileServer deriving Typeable
src/Servant/RawM/Internal/Client.hs view
@@ -27,6 +27,20 @@ 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+--+-- This allows modification of the underlying 'Req' 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
src/Servant/RawM/Internal/Docs.hs view
@@ -29,15 +29,18 @@ (Action, API, DocCapture(DocCapture), DocNote(DocNote), DocOptions, Endpoint, HasDocs(docsFor), captures, defResponse, method, notes, path, respBody, respStatus, respTypes, response, single)--- import Servant.Docs.Internal (apiEndpoints, respBody, response) import Servant.RawM.Internal.API (FileServer, RawM') +-- | This just defers to the 'HasDocs' instance for the @serverType@ phantom+-- type. instance (HasDocs serverType) => HasDocs (RawM' serverType) where docsFor :: Proxy (RawM' serverType) -> (Endpoint, Action) -> DocOptions -> API docsFor Proxy (endpoint, action) docOpts = docsFor (Proxy :: Proxy serverType) (endpoint, action) docOpts +-- | This is a 'HasDocs' instance compatible with the file servers defined in+-- "Servant.RawM.Internal.Server". instance HasDocs FileServer where docsFor :: Proxy FileServer -> (Endpoint, Action) -> DocOptions -> API docsFor Proxy (endpoint, action) _ =
src/Servant/RawM/Internal/Server.hs view
@@ -40,6 +40,13 @@ import Servant.RawM.Internal.API (RawM') +-- | Creates a server instance like the following:+--+--+-- >>> :set -XTypeOperators+-- >>> import Data.Type.Equality ((:~:)(Refl))+-- >>> Refl :: ServerT (RawM' a) m :~: m Application+-- Refl instance HasServer (RawM' serverType) context where type ServerT (RawM' serverType) m = m Application route
+ test/DocTest.hs view
@@ -0,0 +1,40 @@++module Main (main) where++import Prelude++import Data.Monoid ((<>))+import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= doDocTest++doDocTest :: [String] -> IO ()+doDocTest options = doctest $ options <> ghcExtensions++ghcExtensions :: [String]+ghcExtensions =+ [+ -- "-XConstraintKinds"+ -- , "-XDataKinds"+ "-XDeriveDataTypeable"+ , "-XDeriveGeneric"+ -- , "-XEmptyDataDecls"+ , "-XFlexibleContexts"+ -- , "-XFlexibleInstances"+ -- , "-XGADTs"+ -- , "-XGeneralizedNewtypeDeriving"+ -- , "-XInstanceSigs"+ -- , "-XMultiParamTypeClasses"+ -- , "-XNoImplicitPrelude"+ , "-XOverloadedStrings"+ -- , "-XPolyKinds"+ -- , "-XRankNTypes"+ -- , "-XRecordWildCards"+ , "-XScopedTypeVariables"+ -- , "-XStandaloneDeriving"+ -- , "-XTupleSections"+ -- , "-XTypeFamilies"+ -- , "-XTypeOperators"+ ]
+ test/Spec.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Main where++import Control.Concurrent+ (ThreadId, forkIO, killThread, threadDelay)+import Control.Exception (Exception, SomeException, catch)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)+import Data.ByteString.Lazy (ByteString)+import Data.Either (isLeft)+import Data.Monoid ((<>))+import Data.Proxy (Proxy(Proxy))+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.Wai (Application)+import Network.Wai.Handler.Warp (run)+import Servant ((:>), (:~>)(NT), Handler, ServerT, enter, serve)+import Servant.Client+ (Client, ClientEnv(ClientEnv), ClientM, client, runClientM)+import Servant.Common.BaseUrl (parseBaseUrl)+import Servant.Common.Req (Req, appendToPath)+import Test.Hspec.Wai (get, shouldRespondWith, with)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.Hspec (afterAll, beforeAll, it, shouldBe, testSpec)+import Test.Tasty.HUnit ((@?=), assertFailure, testCase)++import Servant.RawM (RawM, serveDirectoryWebApp)++main :: IO ()+main = do+ tests <- testsIO+ defaultMain tests++testsIO :: IO TestTree+testsIO = do+ clientTests <- clientTestsIO+ serverTests <- serverTestsIO+ pure $+ testGroup+ "tests"+ [ instanceTests+ , clientTests+ , serverTests+ ]++-------------+-- Helpers --+-------------++type Selector e = e -> Bool++anyException :: Selector SomeException+anyException _ = True++-- | Extra HUnit assertion to make sure an expression throws an exception.+assertThrows+ :: forall e a.+ (Exception e, Typeable e)+ => IO a -> Selector e -> IO ()+assertThrows ioAction selector = do+ didCatch <- catch (ioAction *> pure False) (pure . selector)+ case didCatch of+ False ->+ assertFailure "expecting an exception, but no exception occurred"+ True -> pure ()++-- | Infix version of 'assertThrows'.+(@!)+ :: (Exception e, Typeable e)+ => IO a -> Selector e -> IO ()+(@!) = assertThrows++infix 1 @!++------------------------------+-- HasServer instance tests --+------------------------------++checkRawMServer :: ServerT RawM m :~: m Application+checkRawMServer = Refl++checkRawMClient+ :: Client RawM :~:+ ( Method ->+ (Req -> Req) ->+ ClientM (Int, ByteString, MediaType, [Header], Response ByteString)+ )+checkRawMClient = Refl++instanceTests :: TestTree+instanceTests =+ testGroup+ "instances"+ [ testCase "HasServer" $ checkRawMServer @?= Refl+ , testCase "HasClient" $ checkRawMClient @?= Refl+ ]++--------------------------------+-- Real Server Tests (Server) --+--------------------------------++type Api = "test" :> RawM++server :: ServerT Api (ReaderT FilePath IO)+server = fileServer++fileServer :: ReaderT FilePath IO Application+fileServer = do+ path <- ask+ serveDirectoryWebApp path++app :: Application+app = serve (Proxy :: Proxy Api) $ enter (NT trans) server+ where+ trans :: ReaderT FilePath IO a -> Handler a+ trans readerT = liftIO $ runReaderT readerT "example/files"++serverTestsIO :: IO TestTree+serverTestsIO =+ testSpec "server" $+ with (pure app) $ do+ it "correctly serves files" $+ get "/test/bar.txt" `shouldRespondWith` "This is bar.txt.\n"+ it "returns 404 for non-existent files" $+ get "/test/non-existent-file.txt" `shouldRespondWith` 404++--------------------------------+-- Real Server Tests (Client) --+--------------------------------++getFile'+ :: Method+ -> (Req -> Req)+ -> ClientM (Int, ByteString, MediaType, [Header], Response ByteString)+getFile' = client (Proxy :: Proxy Api)++getFile :: String -> ClientM ByteString+getFile filePath = do+ (_, _, _, _, resp) <- getFile' methodGet $ \req -> appendToPath filePath req+ pure $ responseBody resp++clientTestsIO :: IO TestTree+clientTestsIO = do+ manager <- newManager defaultManagerSettings+ baseUrl <- parseBaseUrl $ "http://localhost:" <> show port <> "/"+ let clientEnv = ClientEnv manager baseUrl+ testSpec "client" . beforeAll runServer . afterAll killServer $ do+ it "correctly gets files" $ \_ -> do+ eitherRes <- runClientM (getFile "bar.txt") clientEnv+ eitherRes `shouldBe` Right "This is bar.txt.\n"+ it "returns ServantErr for non-existent files" $ \_ -> do+ eitherRes <- runClientM (getFile "non-existent-file.txt") clientEnv+ isLeft eitherRes `shouldBe` True++runServer :: IO ThreadId+runServer = do+ threadId <- forkIO (run port app)+ threadDelay $ 250 * 1000+ pure threadId++killServer :: ThreadId -> IO ()+killServer = killThread++port :: Int+port = 51135