eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Checkout servant-mock from master.

Browse source
This commit is contained in:
Julian K. Arni 2015-08-29 14:46:57 +02:00
parent 52adac2039
commit cb75ed4073
7 changed files with 325 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
servant-mock/LICENSE Normal file
View 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
View file

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

17
servant-mock/default.nix Normal file
View 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
View 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
View 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
View 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

189
servant-mock/src/Servant/Mock.hs Normal file
View file

@ -0,0 +1,189 @@
{-# 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 HasMock rest => HasMock (RemoteHost :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest => HasMock (IsSecure :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest => HasMock (Vault :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance HasMock rest => HasMock (HttpVersion :> 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