Merge pull request #206 from haskell-servant/jkarni/mock-in-0.4
Add servant-mock to 0.4
This commit is contained in:
commit
b4be241fc9
9 changed files with 328 additions and 0 deletions
30
servant-mock/LICENSE
Normal file
30
servant-mock/LICENSE
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
Copyright (c) 2015, Alp Mestanogullari
|
||||||
|
|
||||||
|
All rights reserved.
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
* Redistributions of source code must retain the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
* Redistributions in binary form must reproduce the above
|
||||||
|
copyright notice, this list of conditions and the following
|
||||||
|
disclaimer in the documentation and/or other materials provided
|
||||||
|
with the distribution.
|
||||||
|
|
||||||
|
* Neither the name of Alp Mestanogullari nor the names of other
|
||||||
|
contributors may be used to endorse or promote products derived
|
||||||
|
from this software without specific prior written permission.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||||
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||||
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||||
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||||
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||||
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||||
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||||
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
2
servant-mock/Setup.hs
Normal file
2
servant-mock/Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
import Distribution.Simple
|
||||||
|
main = defaultMain
|
17
servant-mock/default.nix
Normal file
17
servant-mock/default.nix
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
{ mkDerivation, aeson, base, bytestring, http-types, QuickCheck
|
||||||
|
, servant, servant-server, stdenv, transformers, wai, warp
|
||||||
|
}:
|
||||||
|
mkDerivation {
|
||||||
|
pname = "servant-mock";
|
||||||
|
version = "0.5";
|
||||||
|
src = ./.;
|
||||||
|
isLibrary = true;
|
||||||
|
isExecutable = true;
|
||||||
|
buildDepends = [
|
||||||
|
aeson base bytestring http-types QuickCheck servant servant-server
|
||||||
|
transformers wai warp
|
||||||
|
];
|
||||||
|
homepage = "http://github.com/haskell-servant/servant";
|
||||||
|
description = "Derive a mock server for free from your servant API types";
|
||||||
|
license = stdenv.lib.licenses.bsd3;
|
||||||
|
}
|
23
servant-mock/example/main.hs
Normal file
23
servant-mock/example/main.hs
Normal file
|
@ -0,0 +1,23 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
import Data.Aeson
|
||||||
|
import GHC.Generics
|
||||||
|
import Network.Wai.Handler.Warp
|
||||||
|
import Servant
|
||||||
|
import Servant.Mock
|
||||||
|
import Test.QuickCheck.Arbitrary
|
||||||
|
|
||||||
|
newtype User = User { username :: String }
|
||||||
|
deriving (Eq, Show, Arbitrary, Generic)
|
||||||
|
|
||||||
|
instance ToJSON User
|
||||||
|
|
||||||
|
type API = "user" :> Get '[JSON] User
|
||||||
|
|
||||||
|
api :: Proxy API
|
||||||
|
api = Proxy
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = run 8080 (serve api $ mock api)
|
46
servant-mock/servant-mock.cabal
Normal file
46
servant-mock/servant-mock.cabal
Normal file
|
@ -0,0 +1,46 @@
|
||||||
|
name: servant-mock
|
||||||
|
version: 0.5
|
||||||
|
synopsis: Derive a mock server for free from your servant API types
|
||||||
|
description:
|
||||||
|
Derive a mock server for free from your servant API types
|
||||||
|
.
|
||||||
|
See the @Servant.Mock@ module for the documentation and an example.
|
||||||
|
homepage: http://github.com/haskell-servant/servant
|
||||||
|
license: BSD3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Alp Mestanogullari
|
||||||
|
maintainer: alpmestan@gmail.com
|
||||||
|
copyright: 2015 Alp Mestanogullari
|
||||||
|
category: Web
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
flag example
|
||||||
|
description: Build the example too
|
||||||
|
manual: True
|
||||||
|
default: False
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Servant.Mock
|
||||||
|
build-depends:
|
||||||
|
base >=4.7 && <5,
|
||||||
|
bytestring >= 0.10 && <0.11,
|
||||||
|
http-types >= 0.8 && <0.9,
|
||||||
|
servant >= 0.4,
|
||||||
|
servant-server >= 0.4,
|
||||||
|
transformers >= 0.3 && <0.5,
|
||||||
|
QuickCheck >= 2.8 && <2.9,
|
||||||
|
wai >= 3.0 && <3.1
|
||||||
|
hs-source-dirs: src
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable mock-app
|
||||||
|
main-is: main.hs
|
||||||
|
hs-source-dirs: example
|
||||||
|
default-language: Haskell2010
|
||||||
|
build-depends: aeson, base, servant-mock, servant-server, QuickCheck, warp
|
||||||
|
if flag(example)
|
||||||
|
buildable: True
|
||||||
|
else
|
||||||
|
buildable: False
|
18
servant-mock/shell.nix
Normal file
18
servant-mock/shell.nix
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
let
|
||||||
|
pkgs = import <nixpkgs> {};
|
||||||
|
|
||||||
|
haskellPackages = pkgs.haskellPackages.override {
|
||||||
|
overrides = self: super: {
|
||||||
|
servant = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant {}) "--ghc-options=-Werror");
|
||||||
|
servant-client = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-client {}) "--ghc-options=-Werror");
|
||||||
|
servant-docs = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-docs {}) "--ghc-options=-Werror");
|
||||||
|
servant-js = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-js {}) "--ghc-options=-Werror");
|
||||||
|
servant-server = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-server {}) "--ghc-options=-Werror");
|
||||||
|
servant-examples = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-examples {}) "--ghc-options=-Werror");
|
||||||
|
servant-blaze = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-blaze {}) "--ghc-options=-Werror");
|
||||||
|
servant-lucid = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-lucid {}) "--ghc-options=-Werror");
|
||||||
|
servant-mock = pkgs.haskell.lib.appendConfigureFlag (self.callPackage ./. {}) "--ghc-options=-Werror";
|
||||||
|
};
|
||||||
|
};
|
||||||
|
|
||||||
|
in haskellPackages.servant-mock.env
|
177
servant-mock/src/Servant/Mock.hs
Normal file
177
servant-mock/src/Servant/Mock.hs
Normal file
|
@ -0,0 +1,177 @@
|
||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
-- |
|
||||||
|
-- Module : Servant.Mock
|
||||||
|
-- Copyright : 2015 Alp Mestanogullari
|
||||||
|
-- License : BSD3
|
||||||
|
--
|
||||||
|
-- Maintainer : Alp Mestanogullari <alpmestan@gmail.com>
|
||||||
|
-- Stability : experimental
|
||||||
|
-- Portability : portable
|
||||||
|
--
|
||||||
|
-- Automatically derive a mock webserver that implements some API type,
|
||||||
|
-- just from the said API type's definition.
|
||||||
|
--
|
||||||
|
-- Using this module couldn't be simpler. Given some API type, like:
|
||||||
|
--
|
||||||
|
-- > type API = "user" :> Get '[JSON] User
|
||||||
|
--
|
||||||
|
-- that describes your web application, all you have to do is define
|
||||||
|
-- a 'Proxy' to it:
|
||||||
|
--
|
||||||
|
-- > myAPI :: Proxy API
|
||||||
|
-- > myAPI = Proxy
|
||||||
|
--
|
||||||
|
-- and call 'mock', which has the following type:
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- 'mock' :: 'HasMock' api => 'Proxy' api -> 'Server' api
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- What this says is, given some API type @api@ that it knows it can
|
||||||
|
-- "mock", 'mock' hands you an implementation of the API type. It does so
|
||||||
|
-- by having each request handler generate a random value of the
|
||||||
|
-- appropriate type (@User@ in our case). All you need for this to work is
|
||||||
|
-- to provide 'Arbitrary' instances for the data types returned as response
|
||||||
|
-- bodies, hence appearing next to 'Delete', 'Get', 'Patch', 'Post' and 'Put'.
|
||||||
|
--
|
||||||
|
-- To put this all to work and run the mock server, just call 'serve' on the
|
||||||
|
-- result of 'mock' to get an 'Application' that you can then run with warp.
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- main :: IO ()
|
||||||
|
-- main = Network.Wai.Handler.Warp.run 8080 $
|
||||||
|
-- 'serve' myAPI ('mock' myAPI)
|
||||||
|
-- @
|
||||||
|
module Servant.Mock ( HasMock(..) ) where
|
||||||
|
|
||||||
|
#if !MIN_VERSION_base(4,8,0)
|
||||||
|
import Control.Applicative
|
||||||
|
#endif
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Data.ByteString.Lazy.Char8 (pack)
|
||||||
|
import Data.Proxy
|
||||||
|
import GHC.TypeLits
|
||||||
|
import Network.HTTP.Types.Status
|
||||||
|
import Network.Wai
|
||||||
|
import Servant
|
||||||
|
import Servant.API.ContentTypes
|
||||||
|
import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
|
||||||
|
import Test.QuickCheck.Gen (Gen, generate)
|
||||||
|
|
||||||
|
-- | 'HasMock' defines an interpretation of API types
|
||||||
|
-- than turns them into random-response-generating
|
||||||
|
-- request handlers, hence providing an instance for
|
||||||
|
-- all the combinators of the core /servant/ library.
|
||||||
|
class HasServer api => HasMock api where
|
||||||
|
-- | Calling this method creates request handlers of
|
||||||
|
-- the right type to implement the API described by
|
||||||
|
-- @api@ that just generate random response values of
|
||||||
|
-- the right type. E.g:
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- type API = "user" :> Get '[JSON] User
|
||||||
|
-- :<|> "book" :> Get '[JSON] Book
|
||||||
|
--
|
||||||
|
-- api :: Proxy API
|
||||||
|
-- api = Proxy
|
||||||
|
--
|
||||||
|
-- -- let's say we will start with the frontend,
|
||||||
|
-- -- and hence need a placeholder server
|
||||||
|
-- server :: Server API
|
||||||
|
-- server = mock api
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- What happens here is that @'Server' API@
|
||||||
|
-- actually "means" 2 request handlers, of the following types:
|
||||||
|
--
|
||||||
|
-- @
|
||||||
|
-- getUser :: EitherT ServantErr IO User
|
||||||
|
-- getBook :: EitherT ServantErr IO Book
|
||||||
|
-- @
|
||||||
|
--
|
||||||
|
-- So under the hood, 'mock' uses the 'IO' bit to generate
|
||||||
|
-- random values of type 'User' and 'Book' every time these
|
||||||
|
-- endpoints are requested.
|
||||||
|
mock :: Proxy api -> Server api
|
||||||
|
|
||||||
|
instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
|
||||||
|
mock _ = mock (Proxy :: Proxy a) :<|> mock (Proxy :: Proxy b)
|
||||||
|
|
||||||
|
instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
|
||||||
|
mock _ = mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, FromText a, HasMock rest) => HasMock (Capture s a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, FromText a, HasMock rest)
|
||||||
|
=> HasMock (QueryParam s a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, FromText a, HasMock rest)
|
||||||
|
=> HasMock (QueryParams s a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, FromText a, HasMock rest)
|
||||||
|
=> HasMock (MatrixParam s a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, FromText a, HasMock rest)
|
||||||
|
=> HasMock (MatrixParams s a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (KnownSymbol h, FromText a, HasMock rest) => HasMock (Header h a :> rest) where
|
||||||
|
mock _ = \_ -> mock (Proxy :: Proxy rest)
|
||||||
|
|
||||||
|
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where
|
||||||
|
mock _ = mockArbitrary
|
||||||
|
|
||||||
|
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Get ctypes a) where
|
||||||
|
mock _ = mockArbitrary
|
||||||
|
|
||||||
|
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Patch ctypes a) where
|
||||||
|
mock _ = mockArbitrary
|
||||||
|
|
||||||
|
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Post ctypes a) where
|
||||||
|
mock _ = mockArbitrary
|
||||||
|
|
||||||
|
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where
|
||||||
|
mock _ = mockArbitrary
|
||||||
|
|
||||||
|
instance HasMock Raw where
|
||||||
|
mock _ = \req respond -> do
|
||||||
|
bdy <- genBody
|
||||||
|
respond $ responseLBS status200 [] bdy
|
||||||
|
|
||||||
|
where genBody = pack <$> generate (vector 100 :: Gen [Char])
|
||||||
|
|
||||||
|
mockArbitrary :: (MonadIO m, Arbitrary a) => m a
|
||||||
|
mockArbitrary = liftIO (generate arbitrary)
|
||||||
|
|
||||||
|
-- utility instance
|
||||||
|
instance (Arbitrary (HList ls), Arbitrary a)
|
||||||
|
=> Arbitrary (Headers ls a) where
|
||||||
|
arbitrary = Headers <$> arbitrary <*> arbitrary
|
||||||
|
|
||||||
|
instance Arbitrary (HList '[]) where
|
||||||
|
arbitrary = pure HNil
|
||||||
|
|
||||||
|
instance (Arbitrary a, Arbitrary (HList hs))
|
||||||
|
=> Arbitrary (HList (Header h a ': hs)) where
|
||||||
|
arbitrary = HCons <$> fmap Header arbitrary <*> arbitrary
|
||||||
|
|
||||||
|
|
|
@ -6,3 +6,4 @@ servant-server
|
||||||
servant-examples
|
servant-examples
|
||||||
servant-blaze
|
servant-blaze
|
||||||
servant-lucid
|
servant-lucid
|
||||||
|
servant-mock
|
||||||
|
|
14
stack.yaml
Normal file
14
stack.yaml
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
packages:
|
||||||
|
- servant/
|
||||||
|
- servant-blaze/
|
||||||
|
- servant-client/
|
||||||
|
- servant-docs/
|
||||||
|
- servant-examples/
|
||||||
|
- servant-jquery/
|
||||||
|
- servant-lucid/
|
||||||
|
- servant-mock/
|
||||||
|
- servant-server/
|
||||||
|
extra-deps:
|
||||||
|
- engine-io-wai-1.0.2
|
||||||
|
- attoparsec-0.13.0.1
|
||||||
|
resolver: nightly-2015-07-24
|
Loading…
Reference in a new issue