config: remove HasConfig and make HasServer take config as a parameter

servant-client/test/Servant/ClientSpec.hs

@@ -288,9 +288,8 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
           _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
 
 data WrappedApi where
-  WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a
+  WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
-                 , HasConfig api '[], HasClient api
+                 HasClient api, Client api ~ ExceptT ServantError IO ()) =>
-                 , Client api ~ ExceptT ServantError IO ()) =>
     Proxy api -> WrappedApi
 
 

servant-examples/auth-combinator/auth-combinator.hs

@@ -1,10 +1,13 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 import           Data.Aeson
 import           Data.ByteString          (ByteString)
@@ -32,10 +35,10 @@ isGoodCookie ref password = do
 
 data AuthProtected
 
-instance HasServer rest => HasServer (AuthProtected :> rest) where
+instance (HasConfigEntry config DBConnection, HasServer rest config)
+  => HasServer (AuthProtected :> rest) config where
+
   type ServerT (AuthProtected :> rest) m = ServerT rest m
-  type HasConfig (AuthProtected :> rest) config =
-    (HasConfigEntry config DBConnection, HasConfig rest config)
 
   route Proxy config subserver = WithRequest $ \ request ->
     route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request

servant-mock/example/main.hs

@@ -20,4 +20,4 @@ api :: Proxy API
 api = Proxy
 
 main :: IO ()
-main = run 8080 (serve api EmptyConfig $ mock api)
+main = run 8080 (serve api EmptyConfig $ mock api Proxy)

servant-mock/src/Servant/Mock.hs

@@ -2,8 +2,9 @@
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -66,6 +67,7 @@ import           Network.HTTP.Types.Status
 import           Network.Wai
 import           Servant
 import           Servant.API.ContentTypes
+import           Servant.Server.Internal.Config
 import           Test.QuickCheck.Arbitrary  (Arbitrary (..), vector)
 import           Test.QuickCheck.Gen        (Gen, generate)
 
@@ -73,7 +75,7 @@ import           Test.QuickCheck.Gen        (Gen, generate)
 --   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
+class HasServer api config => HasMock api config 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
@@ -103,65 +105,67 @@ class HasServer api => HasMock api where
   --   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
+  mock :: Proxy api -> Proxy config -> Server api
 
-instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
+instance (HasMock a config, HasMock b config) => HasMock (a :<|> b) config where
-  mock _ = mock (Proxy :: Proxy a) :<|> mock (Proxy :: Proxy b)
+  mock _ config = mock (Proxy :: Proxy a) config :<|> mock (Proxy :: Proxy b) config
 
-instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
+instance (KnownSymbol path, HasMock rest config) => HasMock (path :> rest) config where
   mock _ = mock (Proxy :: Proxy rest)
 
-instance (KnownSymbol s, FromHttpApiData a, HasMock rest) => HasMock (Capture s a :> rest) where
+instance (KnownSymbol s, FromHttpApiData a, HasMock rest config) => HasMock (Capture s a :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where
+instance (AllCTUnrender ctypes a, HasMock rest config) => HasMock (ReqBody ctypes a :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance HasMock rest => HasMock (RemoteHost :> rest) where
+instance HasMock rest config => HasMock (RemoteHost :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance HasMock rest => HasMock (IsSecure :> rest) where
+instance HasMock rest config => HasMock (IsSecure :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance HasMock rest => HasMock (Vault :> rest) where
+instance HasMock rest config => HasMock (Vault :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance HasMock rest => HasMock (HttpVersion :> rest) where
+instance HasMock rest config => HasMock (HttpVersion :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
+instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
-      => HasMock (QueryParam s a :> rest) where
+      => HasMock (QueryParam s a :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
+instance (KnownSymbol s, FromHttpApiData a, HasMock rest config)
-      => HasMock (QueryParams s a :> rest) where
+      => HasMock (QueryParams s a :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
+instance (KnownSymbol s, HasMock rest config) => HasMock (QueryFlag s :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
-instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
+instance (KnownSymbol h, FromHttpApiData a, HasMock rest config) => HasMock (Header h a :> rest) config where
-  mock _ = \_ -> mock (Proxy :: Proxy rest)
+  mock _ config = \_ -> mock (Proxy :: Proxy rest) config
 
 instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
-    => HasMock (Verb method status ctypes a) where
+    => HasMock (Verb method status ctypes a) config where
-  mock _ = mockArbitrary
+  mock _ _ = mockArbitrary
 
 instance OVERLAPPING_
     (GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),
      Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)
-    => HasMock (Verb method status ctypes (Headers headerTypes a)) where
+    => HasMock (Verb method status ctypes (Headers headerTypes a)) config where
-  mock _ = mockArbitrary
+  mock _ _ = mockArbitrary
 
-instance HasMock Raw where
+instance HasMock Raw config where
-  mock _ = \_req respond -> do
+  mock _ _ = \_req respond -> do
     bdy <- genBody
     respond $ responseLBS status200 [] bdy
 
     where genBody = pack <$> generate (vector 100 :: Gen [Char])
 
-instance HasMock rest => HasMock (WithNamedConfig name config rest) where
+instance (HasConfigEntry config (NamedConfig name subConfig), HasMock rest subConfig) =>
-  mock _ = mock (Proxy :: Proxy rest)
+  HasMock (WithNamedConfig name subConfig rest) config where
+
+  mock _ _ = mock (Proxy :: Proxy rest) (Proxy :: Proxy subConfig)
 
 mockArbitrary :: (MonadIO m, Arbitrary a) => m a
 mockArbitrary = liftIO (generate arbitrary)

servant-mock/test/Servant/MockSpec.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -21,7 +23,7 @@ import           Servant.API.Internal.Test.ComprehensiveAPI
 import           Servant.Mock
 
 -- This declaration simply checks that all instances are in place.
-_ = mock comprehensiveAPI
+_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedConfig "foo" '[]])
 
 data Body
   = Body
@@ -50,7 +52,7 @@ spec = do
     context "Get" $ do
       let api :: Proxy (Get '[JSON] Body)
           api = Proxy
-          app = serve api (mock api)
+          app = serve api EmptyConfig (mock api Proxy)
       with (return app) $ do
         it "serves arbitrary response bodies" $ do
           get "/" `shouldRespondWith` 200{
@@ -62,8 +64,8 @@ spec = do
           withHeader = Proxy
           withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
           withoutHeader = Proxy
-          toApp :: HasMock api => Proxy api -> IO Application
+          toApp :: (HasMock api '[]) => Proxy api -> IO Application
-          toApp api = return $ serve api (mock api)
+          toApp api = return $ serve api EmptyConfig (mock api (Proxy :: Proxy '[]))
       with (toApp withHeader) $ do
         it "serves arbitrary response bodies" $ do
           get "/" `shouldRespondWith` 200{

servant-server/src/Servant/Server.hs

@@ -110,8 +110,8 @@ import           Servant.Server.Internal.Enter
 -- > main :: IO ()
 -- > main = Network.Wai.Handler.Warp.run 8080 app
 --
-serve :: (HasConfig layout a, HasServer layout)
+serve :: (HasServer layout config)
-    => Proxy layout -> Config a -> Server layout -> Application
+    => Proxy layout -> Config config -> Server layout -> Application
 serve p config server = toApplication (runRouter (route p config d))
   where
     d = Delayed r r r (\ _ _ -> Route server)

servant-server/src/Servant/Server/Internal.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE PolyKinds                  #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
@@ -68,11 +69,10 @@ import           Servant.Server.Internal.RoutingApplication
 import           Servant.Server.Internal.ServantErr
 
 
-class HasServer layout where
+class HasServer layout config where
   type ServerT layout (m :: * -> *) :: *
-  type HasConfig layout (c :: [*]) :: Constraint
 
-  route :: HasConfig layout config => Proxy layout -> Config config -> Delayed (Server layout) -> Router
+  route :: Proxy layout -> Config config -> Delayed (Server layout) -> Router
 
 type Server layout = ServerT layout (ExceptT ServantErr IO)
 
@@ -89,10 +89,9 @@ type Server layout = ServerT layout (ExceptT ServantErr IO)
 -- > server = listAllBooks :<|> postBook
 -- >   where listAllBooks = ...
 -- >         postBook book = ...
-instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
+instance (HasServer a config, HasServer b config) => HasServer (a :<|> b) config where
 
   type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
-  type HasConfig (a :<|> b) c = (HasConfig a c, HasConfig b c)
 
   route Proxy config server = choice (route pa config ((\ (a :<|> _) -> a) <$> server))
                                      (route pb config ((\ (_ :<|> b) -> b) <$> server))
@@ -119,12 +118,11 @@ captured _ = parseUrlPieceMaybe
 -- > server = getBook
 -- >   where getBook :: Text -> ExceptT ServantErr IO Book
 -- >         getBook isbn = ...
-instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
+instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout config)
-      => HasServer (Capture capture a :> sublayout) where
+      => HasServer (Capture capture a :> sublayout) config where
 
   type ServerT (Capture capture a :> sublayout) m =
      a -> ServerT sublayout m
-  type HasConfig (Capture capture a :> sublayout) c = (HasConfig sublayout c)
 
   route Proxy config d =
     DynamicRouter $ \ first ->
@@ -198,10 +196,9 @@ methodRouterHeaders method proxy status action = LeafRouter route'
 
 instance OVERLAPPABLE_
          ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
-         ) => HasServer (Verb method status ctypes a) where
+         ) => HasServer (Verb method status ctypes a) config where
 
   type ServerT (Verb method status ctypes a) m = m a
-  type HasConfig (Verb method status ctypes a) c = ()
 
   route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status
     where method = reflectMethod (Proxy :: Proxy method)
@@ -210,10 +207,9 @@ instance OVERLAPPABLE_
 instance OVERLAPPING_
          ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
          , GetHeaders (Headers h a)
-         ) => HasServer (Verb method status ctypes (Headers h a)) where
+         ) => HasServer (Verb method status ctypes (Headers h a)) config where
 
   type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
-  type HasConfig (Verb method status ctypes (Headers h a)) c = ()
 
   route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status
     where method = reflectMethod (Proxy :: Proxy method)
@@ -239,12 +235,11 @@ instance OVERLAPPING_
 -- > server = viewReferer
 -- >   where viewReferer :: Referer -> ExceptT ServantErr IO referer
 -- >         viewReferer referer = return referer
-instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
-      => HasServer (Header sym a :> sublayout) where
+      => HasServer (Header sym a :> sublayout) config where
 
   type ServerT (Header sym a :> sublayout) m =
     Maybe a -> ServerT sublayout m
-  type HasConfig (Header sym a :> sublayout) c = HasConfig sublayout c
 
   route Proxy config subserver = WithRequest $ \ request ->
     let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
@@ -272,12 +267,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
 -- >   where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
 -- >         getBooksBy Nothing       = ...return all books...
 -- >         getBooksBy (Just author) = ...return books by the given author...
-instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
-      => HasServer (QueryParam sym a :> sublayout) where
+      => HasServer (QueryParam sym a :> sublayout) config where
 
   type ServerT (QueryParam sym a :> sublayout) m =
     Maybe a -> ServerT sublayout m
-  type HasConfig (QueryParam sym a :> sublayout) c = HasConfig sublayout c
 
   route Proxy config subserver = WithRequest $ \ request ->
     let querytext = parseQueryText $ rawQueryString request
@@ -309,12 +303,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
 -- > server = getBooksBy
 -- >   where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
 -- >         getBooksBy authors = ...return all books by these authors...
-instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
+instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout config)
-      => HasServer (QueryParams sym a :> sublayout) where
+      => HasServer (QueryParams sym a :> sublayout) config where
 
   type ServerT (QueryParams sym a :> sublayout) m =
     [a] -> ServerT sublayout m
-  type HasConfig (QueryParams sym a :> sublayout) c = HasConfig sublayout c
 
   route Proxy config subserver = WithRequest $ \ request ->
     let querytext = parseQueryText $ rawQueryString request
@@ -341,12 +334,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
 -- > server = getBooks
 -- >   where getBooks :: Bool -> ExceptT ServantErr IO [Book]
 -- >         getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
-instance (KnownSymbol sym, HasServer sublayout)
+instance (KnownSymbol sym, HasServer sublayout config)
-      => HasServer (QueryFlag sym :> sublayout) where
+      => HasServer (QueryFlag sym :> sublayout) config where
 
   type ServerT (QueryFlag sym :> sublayout) m =
     Bool -> ServerT sublayout m
-  type HasConfig (QueryFlag sym :> sublayout) c = HasConfig sublayout c
 
   route Proxy config subserver = WithRequest $ \ request ->
     let querytext = parseQueryText $ rawQueryString request
@@ -367,10 +359,9 @@ instance (KnownSymbol sym, HasServer sublayout)
 -- >
 -- > server :: Server MyApi
 -- > server = serveDirectory "/var/www/images"
-instance HasServer Raw where
+instance HasServer Raw config where
 
   type ServerT Raw m = Application
-  type HasConfig Raw c = ()
 
   route Proxy _ rawApplication = LeafRouter $ \ request respond -> do
     r <- runDelayed rawApplication
@@ -400,12 +391,11 @@ instance HasServer Raw where
 -- > server = postBook
 -- >   where postBook :: Book -> ExceptT ServantErr IO Book
 -- >         postBook book = ...insert into your db...
-instance ( AllCTUnrender list a, HasServer sublayout
+instance ( AllCTUnrender list a, HasServer sublayout config
-         ) => HasServer (ReqBody list a :> sublayout) where
+         ) => HasServer (ReqBody list a :> sublayout) config where
 
   type ServerT (ReqBody list a :> sublayout) m =
     a -> ServerT sublayout m
-  type HasConfig (ReqBody list a :> sublayout) c = HasConfig sublayout c
 
   route Proxy config subserver = WithRequest $ \ request ->
     route (Proxy :: Proxy sublayout) config (addBodyCheck subserver (bodyCheck request))
@@ -426,42 +416,37 @@ instance ( AllCTUnrender list a, HasServer sublayout
 
 -- | Make sure the incoming request starts with @"/path"@, strip it and
 -- pass the rest of the request path to @sublayout@.
-instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
+instance (KnownSymbol path, HasServer sublayout config) => HasServer (path :> sublayout) config where
 
   type ServerT (path :> sublayout) m = ServerT sublayout m
-  type HasConfig (path :> sublayout) c = HasConfig sublayout c
 
   route Proxy config subserver = StaticRouter $
     M.singleton (cs (symbolVal proxyPath))
                 (route (Proxy :: Proxy sublayout) config subserver)
     where proxyPath = Proxy :: Proxy path
 
-instance HasServer api => HasServer (RemoteHost :> api) where
+instance HasServer api config => HasServer (RemoteHost :> api) config where
   type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
-  type HasConfig (RemoteHost :> api) c = HasConfig api c
 
   route Proxy config subserver = WithRequest $ \req ->
     route (Proxy :: Proxy api) config (passToServer subserver $ remoteHost req)
 
-instance HasServer api => HasServer (IsSecure :> api) where
+instance HasServer api config => HasServer (IsSecure :> api) config where
   type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
-  type HasConfig (IsSecure :> api) c = HasConfig api c
 
   route Proxy config subserver = WithRequest $ \req ->
     route (Proxy :: Proxy api) config (passToServer subserver $ secure req)
 
     where secure req = if isSecure req then Secure else NotSecure
 
-instance HasServer api => HasServer (Vault :> api) where
+instance HasServer api config => HasServer (Vault :> api) config where
   type ServerT (Vault :> api) m = Vault -> ServerT api m
-  type HasConfig (Vault :> api) c = HasConfig api c
 
   route Proxy config subserver = WithRequest $ \req ->
     route (Proxy :: Proxy api) config (passToServer subserver $ vault req)
 
-instance HasServer api => HasServer (HttpVersion :> api) where
+instance HasServer api config => HasServer (HttpVersion :> api) config where
   type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
-  type HasConfig (HttpVersion :> api) c = HasConfig api c
 
   route Proxy config subserver = WithRequest $ \req ->
     route (Proxy :: Proxy api) config (passToServer subserver $ httpVersion req)
@@ -477,11 +462,11 @@ ct_wildcard = "*" <> "/" <> "*" -- Because CPP
 
 -- * configs
 
-instance HasServer subApi => HasServer (WithNamedConfig name subConfig subApi) where
+instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig)
+  => HasServer (WithNamedConfig name subConfig subApi) config where
+
   type ServerT (WithNamedConfig name subConfig subApi) m =
     ServerT subApi m
-  type HasConfig (WithNamedConfig name subConfig subApi) config =
-    (HasConfigEntry config (NamedConfig name subConfig), HasConfig subApi subConfig)
 
   route Proxy config delayed =
     route subProxy subConfig delayed

servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -24,13 +25,11 @@ import           Servant.Server.Internal.RoutingApplication
 
 data ExtractFromConfig
 
-instance (HasServer subApi) =>
+instance (HasConfigEntry config String, HasServer subApi config) =>
-  HasServer (ExtractFromConfig :> subApi) where
+  HasServer (ExtractFromConfig :> subApi) config where
 
   type ServerT (ExtractFromConfig :> subApi) m =
     String -> ServerT subApi m
-  type HasConfig (ExtractFromConfig :> subApi) (c :: [*]) =
-    (HasConfigEntry c String, HasConfig subApi c)
 
   route Proxy config delayed =
     route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@@ -42,13 +41,11 @@ instance (HasServer subApi) =>
 
 data InjectIntoConfig
 
-instance (HasServer subApi) =>
+instance (HasServer subApi (String ': config)) =>
-  HasServer (InjectIntoConfig :> subApi) where
+  HasServer (InjectIntoConfig :> subApi) config where
 
   type ServerT (InjectIntoConfig :> subApi) m =
     ServerT subApi m
-  type HasConfig (InjectIntoConfig :> subApi) c =
-    (HasConfig subApi (String ': c))
 
   route Proxy config delayed =
     route subProxy newConfig delayed
@@ -60,13 +57,11 @@ instance (HasServer subApi) =>
 
 data NamedConfigWithBirdface (name :: Symbol) (subConfig :: [*])
 
-instance (HasServer subApi) =>
+instance (HasConfigEntry config (NamedConfig name subConfig), HasServer subApi subConfig) =>
-  HasServer (NamedConfigWithBirdface name subConfig :> subApi) where
+  HasServer (NamedConfigWithBirdface name subConfig :> subApi) config where
 
   type ServerT (NamedConfigWithBirdface name subConfig :> subApi) m =
     ServerT subApi m
-  type HasConfig (NamedConfigWithBirdface name subConfig :> subApi) config =
-    (HasConfigEntry config (NamedConfig name subConfig), HasConfig subApi subConfig)
 
   route Proxy config delayed =
     route subProxy subConfig delayed

servant-server/test/Servant/ServerSpec.hs

@@ -1,14 +1,15 @@
 {-# LANGUAGE CPP                  #-}
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE PolyKinds            #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances    #-}
 
 module Servant.ServerSpec where