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