git.iko.soy/typeable/servant
on master help sign in
Checkout servant-mock from master.
cb75ed4Julian K. Arni
servant-mock/LICENSEnew file+30
compare with master
unifiedsplit
@@ -0,0 +1,30 @@
1+Copyright (c) 2015, Alp Mestanogullari
2+
3+All rights reserved.
4+
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
7+
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
10+
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
15+
16+ * Neither the name of Alp Mestanogullari nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
servant-mock/Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
servant-mock/default.nixnew file+17
@@ -0,0 +1,17 @@
1+{ mkDerivation, aeson, base, bytestring, http-types, QuickCheck
2+, servant, servant-server, stdenv, transformers, wai, warp
3+}:
4+mkDerivation {
5+ pname = "servant-mock";
6+ version = "0.5";
7+ src = ./.;
8+ isLibrary = true;
9+ isExecutable = true;
10+ buildDepends = [
11+ aeson base bytestring http-types QuickCheck servant servant-server
12+ transformers wai warp
13+ ];
14+ homepage = "http://github.com/haskell-servant/servant";
15+ description = "Derive a mock server for free from your servant API types";
16+ license = stdenv.lib.licenses.bsd3;
17+}
servant-mock/example/main.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE TypeOperators #-}
5+import Data.Aeson
6+import GHC.Generics
7+import Network.Wai.Handler.Warp
8+import Servant
9+import Servant.Mock
10+import Test.QuickCheck.Arbitrary
11+
12+newtype User = User { username :: String }
13+ deriving (Eq, Show, Arbitrary, Generic)
14+
15+instance ToJSON User
16+
17+type API = "user" :> Get '[JSON] User
18+
19+api :: Proxy API
20+api = Proxy
21+
22+main :: IO ()
23+main = run 8080 (serve api $ mock api)
servant-mock/servant-mock.cabalnew file+46
@@ -0,0 +1,46 @@
1+name: servant-mock
2+version: 0.5
3+synopsis: Derive a mock server for free from your servant API types
4+description:
5+ Derive a mock server for free from your servant API types
6+ .
7+ See the @Servant.Mock@ module for the documentation and an example.
8+homepage: http://github.com/haskell-servant/servant
9+license: BSD3
10+license-file: LICENSE
11+author: Alp Mestanogullari
12+maintainer: alpmestan@gmail.com
13+copyright: 2015 Alp Mestanogullari
14+category: Web
15+build-type: Simple
16+cabal-version: >=1.10
17+
18+flag example
19+ description: Build the example too
20+ manual: True
21+ default: False
22+
23+library
24+ exposed-modules:
25+ Servant.Mock
26+ build-depends:
27+ base >=4.7 && <5,
28+ bytestring >= 0.10 && <0.11,
29+ http-types >= 0.8 && <0.9,
30+ servant >= 0.4,
31+ servant-server >= 0.4,
32+ transformers >= 0.3 && <0.5,
33+ QuickCheck >= 2.8 && <2.9,
34+ wai >= 3.0 && <3.1
35+ hs-source-dirs: src
36+ default-language: Haskell2010
37+
38+executable mock-app
39+ main-is: main.hs
40+ hs-source-dirs: example
41+ default-language: Haskell2010
42+ build-depends: aeson, base, servant-mock, servant-server, QuickCheck, warp
43+ if flag(example)
44+ buildable: True
45+ else
46+ buildable: False
servant-mock/shell.nixnew file+18
@@ -0,0 +1,18 @@
1+let
2+ pkgs = import <nixpkgs> {};
3+
4+ haskellPackages = pkgs.haskellPackages.override {
5+ overrides = self: super: {
6+ servant = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant {}) "--ghc-options=-Werror");
7+ servant-client = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-client {}) "--ghc-options=-Werror");
8+ servant-docs = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-docs {}) "--ghc-options=-Werror");
9+ servant-js = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-js {}) "--ghc-options=-Werror");
10+ servant-server = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-server {}) "--ghc-options=-Werror");
11+ servant-examples = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-examples {}) "--ghc-options=-Werror");
12+ servant-blaze = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-blaze {}) "--ghc-options=-Werror");
13+ servant-lucid = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.appendConfigureFlag (self.callPackage ../servant-lucid {}) "--ghc-options=-Werror");
14+ servant-mock = pkgs.haskell.lib.appendConfigureFlag (self.callPackage ./. {}) "--ghc-options=-Werror";
15+ };
16+ };
17+
18+in haskellPackages.servant-mock.env
servant-mock/src/Servant/Mock.hsnew file+189
@@ -0,0 +1,189 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE TypeOperators #-}
8+-- |
9+-- Module : Servant.Mock
10+-- Copyright : 2015 Alp Mestanogullari
11+-- License : BSD3
12+--
13+-- Maintainer : Alp Mestanogullari <alpmestan@gmail.com>
14+-- Stability : experimental
15+-- Portability : portable
16+--
17+-- Automatically derive a mock webserver that implements some API type,
18+-- just from the said API type's definition.
19+--
20+-- Using this module couldn't be simpler. Given some API type, like:
21+--
22+-- > type API = "user" :> Get '[JSON] User
23+--
24+-- that describes your web application, all you have to do is define
25+-- a 'Proxy' to it:
26+--
27+-- > myAPI :: Proxy API
28+-- > myAPI = Proxy
29+--
30+-- and call 'mock', which has the following type:
31+--
32+-- @
33+-- 'mock' :: 'HasMock' api => 'Proxy' api -> 'Server' api
34+-- @
35+--
36+-- What this says is, given some API type @api@ that it knows it can
37+-- "mock", 'mock' hands you an implementation of the API type. It does so
38+-- by having each request handler generate a random value of the
39+-- appropriate type (@User@ in our case). All you need for this to work is
40+-- to provide 'Arbitrary' instances for the data types returned as response
41+-- bodies, hence appearing next to 'Delete', 'Get', 'Patch', 'Post' and 'Put'.
42+--
43+-- To put this all to work and run the mock server, just call 'serve' on the
44+-- result of 'mock' to get an 'Application' that you can then run with warp.
45+--
46+-- @
47+-- main :: IO ()
48+-- main = Network.Wai.Handler.Warp.run 8080 $
49+-- 'serve' myAPI ('mock' myAPI)
50+-- @
51+module Servant.Mock ( HasMock(..) ) where
52+
53+#if !MIN_VERSION_base(4,8,0)
54+import Control.Applicative
55+#endif
56+import Control.Monad.IO.Class
57+import Data.ByteString.Lazy.Char8 (pack)
58+import Data.Proxy
59+import GHC.TypeLits
60+import Network.HTTP.Types.Status
61+import Network.Wai
62+import Servant
63+import Servant.API.ContentTypes
64+import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
65+import Test.QuickCheck.Gen (Gen, generate)
66+
67+-- | 'HasMock' defines an interpretation of API types
68+-- than turns them into random-response-generating
69+-- request handlers, hence providing an instance for
70+-- all the combinators of the core /servant/ library.
71+class HasServer api => HasMock api where
72+ -- | Calling this method creates request handlers of
73+ -- the right type to implement the API described by
74+ -- @api@ that just generate random response values of
75+ -- the right type. E.g:
76+ --
77+ -- @
78+ -- type API = "user" :> Get '[JSON] User
79+ -- :<|> "book" :> Get '[JSON] Book
80+ --
81+ -- api :: Proxy API
82+ -- api = Proxy
83+ --
84+ -- -- let's say we will start with the frontend,
85+ -- -- and hence need a placeholder server
86+ -- server :: Server API
87+ -- server = mock api
88+ -- @
89+ --
90+ -- What happens here is that @'Server' API@
91+ -- actually "means" 2 request handlers, of the following types:
92+ --
93+ -- @
94+ -- getUser :: EitherT ServantErr IO User
95+ -- getBook :: EitherT ServantErr IO Book
96+ -- @
97+ --
98+ -- So under the hood, 'mock' uses the 'IO' bit to generate
99+ -- random values of type 'User' and 'Book' every time these
100+ -- endpoints are requested.
101+ mock :: Proxy api -> Server api
102+
103+instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
104+ mock _ = mock (Proxy :: Proxy a) :<|> mock (Proxy :: Proxy b)
105+
106+instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
107+ mock _ = mock (Proxy :: Proxy rest)
108+
109+instance (KnownSymbol s, FromText a, HasMock rest) => HasMock (Capture s a :> rest) where
110+ mock _ = \_ -> mock (Proxy :: Proxy rest)
111+
112+instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where
113+ mock _ = \_ -> mock (Proxy :: Proxy rest)
114+
115+instance HasMock rest => HasMock (RemoteHost :> rest) where
116+ mock _ = \_ -> mock (Proxy :: Proxy rest)
117+
118+instance HasMock rest => HasMock (IsSecure :> rest) where
119+ mock _ = \_ -> mock (Proxy :: Proxy rest)
120+
121+instance HasMock rest => HasMock (Vault :> rest) where
122+ mock _ = \_ -> mock (Proxy :: Proxy rest)
123+
124+instance HasMock rest => HasMock (HttpVersion :> rest) where
125+ mock _ = \_ -> mock (Proxy :: Proxy rest)
126+
127+instance (KnownSymbol s, FromText a, HasMock rest)
128+ => HasMock (QueryParam s a :> rest) where
129+ mock _ = \_ -> mock (Proxy :: Proxy rest)
130+
131+instance (KnownSymbol s, FromText a, HasMock rest)
132+ => HasMock (QueryParams s a :> rest) where
133+ mock _ = \_ -> mock (Proxy :: Proxy rest)
134+
135+instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
136+ mock _ = \_ -> mock (Proxy :: Proxy rest)
137+
138+instance (KnownSymbol s, FromText a, HasMock rest)
139+ => HasMock (MatrixParam s a :> rest) where
140+ mock _ = \_ -> mock (Proxy :: Proxy rest)
141+
142+instance (KnownSymbol s, FromText a, HasMock rest)
143+ => HasMock (MatrixParams s a :> rest) where
144+ mock _ = \_ -> mock (Proxy :: Proxy rest)
145+
146+instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where
147+ mock _ = \_ -> mock (Proxy :: Proxy rest)
148+
149+instance (KnownSymbol h, FromText a, HasMock rest) => HasMock (Header h a :> rest) where
150+ mock _ = \_ -> mock (Proxy :: Proxy rest)
151+
152+instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where
153+ mock _ = mockArbitrary
154+
155+instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Get ctypes a) where
156+ mock _ = mockArbitrary
157+
158+instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Patch ctypes a) where
159+ mock _ = mockArbitrary
160+
161+instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Post ctypes a) where
162+ mock _ = mockArbitrary
163+
164+instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where
165+ mock _ = mockArbitrary
166+
167+instance HasMock Raw where
168+ mock _ = \req respond -> do
169+ bdy <- genBody
170+ respond $ responseLBS status200 [] bdy
171+
172+ where genBody = pack <$> generate (vector 100 :: Gen [Char])
173+
174+mockArbitrary :: (MonadIO m, Arbitrary a) => m a
175+mockArbitrary = liftIO (generate arbitrary)
176+
177+-- utility instance
178+instance (Arbitrary (HList ls), Arbitrary a)
179+ => Arbitrary (Headers ls a) where
180+ arbitrary = Headers <$> arbitrary <*> arbitrary
181+
182+instance Arbitrary (HList '[]) where
183+ arbitrary = pure HNil
184+
185+instance (Arbitrary a, Arbitrary (HList hs))
186+ => Arbitrary (HList (Header h a ': hs)) where
187+ arbitrary = HCons <$> fmap Header arbitrary <*> arbitrary
188+
189+