From 87c3bd590eafe504f169a2f95aea194927656a4d Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 22 Jul 2015 21:22:42 +0200 Subject: [PATCH 1/5] first shot at Servant.Mock --- servant-mock/LICENSE | 30 +++++++++ servant-mock/Setup.hs | 2 + servant-mock/example/main.hs | 23 +++++++ servant-mock/servant-mock.cabal | 47 +++++++++++++ servant-mock/src/Servant/Mock.hs | 109 +++++++++++++++++++++++++++++++ sources.txt | 1 + 6 files changed, 212 insertions(+) create mode 100644 servant-mock/LICENSE create mode 100644 servant-mock/Setup.hs create mode 100644 servant-mock/example/main.hs create mode 100644 servant-mock/servant-mock.cabal create mode 100644 servant-mock/src/Servant/Mock.hs diff --git a/servant-mock/LICENSE b/servant-mock/LICENSE new file mode 100644 index 00000000..f2e47b91 --- /dev/null +++ b/servant-mock/LICENSE @@ -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. diff --git a/servant-mock/Setup.hs b/servant-mock/Setup.hs new file mode 100644 index 00000000..9a994af6 --- /dev/null +++ b/servant-mock/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/servant-mock/example/main.hs b/servant-mock/example/main.hs new file mode 100644 index 00000000..93398c4c --- /dev/null +++ b/servant-mock/example/main.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +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) diff --git a/servant-mock/servant-mock.cabal b/servant-mock/servant-mock.cabal new file mode 100644 index 00000000..31acbed7 --- /dev/null +++ b/servant-mock/servant-mock.cabal @@ -0,0 +1,47 @@ +-- Initial servant-mock.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: servant-mock +version: 0.4 +synopsis: Derive a mock server for free from your servant API types +description: Derive a mock server for free from your servant API types +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 +-- extra-source-files: +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.4 && <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 diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs new file mode 100644 index 00000000..9971820b --- /dev/null +++ b/servant-mock/src/Servant/Mock.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Servant.Mock ( HasMock(..) ) where + +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) + +class HasServer api => HasMock api where + 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 = fmap 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 + + diff --git a/sources.txt b/sources.txt index a36345e5..20f09fab 100644 --- a/sources.txt +++ b/sources.txt @@ -6,3 +6,4 @@ servant-server servant-examples servant-blaze servant-lucid +servant-mock From 349cc1089b6e6c55390b3af5019f3a1e27c11799 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 22 Jul 2015 21:49:24 +0200 Subject: [PATCH 2/5] transformers bound --- servant-mock/servant-mock.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/servant-mock/servant-mock.cabal b/servant-mock/servant-mock.cabal index 31acbed7..e7d70b15 100644 --- a/servant-mock/servant-mock.cabal +++ b/servant-mock/servant-mock.cabal @@ -30,7 +30,7 @@ library http-types >= 0.8 && <0.9, servant >= 0.4, servant-server >= 0.4, - transformers >= 0.4 && <0.5, + transformers >= 0.3 && <0.5, QuickCheck >= 2.8 && <2.9, wai >= 3.0 && <3.1 hs-source-dirs: src From 248033ad817407977b85d2b4f6c0220b3646481c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 22 Jul 2015 22:06:46 +0200 Subject: [PATCH 3/5] fix build on 7.8 --- servant-mock/src/Servant/Mock.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index 9971820b..5fbd00fc 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -6,6 +7,9 @@ {-# LANGUAGE ScopedTypeVariables #-} 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 From d6a7f5c8562409209b189b8f371d473bdceafadf Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 22 Jul 2015 22:08:56 +0200 Subject: [PATCH 4/5] actually fix the build on 7.8, hopefully --- servant-mock/src/Servant/Mock.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index 5fbd00fc..e50b4926 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -8,7 +8,7 @@ module Servant.Mock ( HasMock(..) ) where #if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) +import Control.Applicative #endif import Control.Monad.IO.Class import Data.ByteString.Lazy.Char8 (pack) From fe0e526aa12a6873586e69cdcdd326dba362109d Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 23 Jul 2015 13:00:37 +0200 Subject: [PATCH 5/5] haddocks for Servant.Mock --- servant-mock/servant-mock.cabal | 9 ++-- servant-mock/src/Servant/Mock.hs | 76 ++++++++++++++++++++++++++++++++ 2 files changed, 80 insertions(+), 5 deletions(-) diff --git a/servant-mock/servant-mock.cabal b/servant-mock/servant-mock.cabal index e7d70b15..a6e8119d 100644 --- a/servant-mock/servant-mock.cabal +++ b/servant-mock/servant-mock.cabal @@ -1,10 +1,10 @@ --- Initial servant-mock.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: servant-mock version: 0.4 synopsis: Derive a mock server for free from your servant API types -description: 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 @@ -13,7 +13,6 @@ maintainer: alpmestan@gmail.com copyright: 2015 Alp Mestanogullari category: Web build-type: Simple --- extra-source-files: cabal-version: >=1.10 flag example diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index e50b4926..9382d40f 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -5,6 +5,49 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +-- | +-- Module : Servant.Mock +-- Copyright : 2015 Alp Mestanogullari +-- License : BSD3 +-- +-- Maintainer : Alp Mestanogullari +-- 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) @@ -21,7 +64,40 @@ 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