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

server: use {c,C}onfig instead of {c,C}fg everywhere

Browse source
This commit is contained in:
Sönke Hahn 2016-01-13 21:28:16 +01:00
parent d8db0fa779
commit 6ca120f08f
6 changed files with 59 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-client/test/Servant/ClientSpec.hs
View file

@ -285,7 +285,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
data WrappedApi where data WrappedApi where
WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a WrappedApi :: (HasServer (api :: *), Server api ~ ExceptT ServantErr IO a
, HasCfg api '[], HasClient api , HasConfig api '[], HasClient api
, Client api ~ ExceptT ServantError IO ()) => , Client api ~ ExceptT ServantError IO ()) =>
Proxy api -> WrappedApi Proxy api -> WrappedApi

4
servant-examples/auth-combinator/auth-combinator.hs
View file

@ -34,8 +34,8 @@ data AuthProtected
instance HasServer rest => HasServer (AuthProtected :> rest) where instance HasServer rest => HasServer (AuthProtected :> rest) where
type ServerT (AuthProtected :> rest) m = ServerT rest m type ServerT (AuthProtected :> rest) m = ServerT rest m
type HasCfg (AuthProtected :> rest) config = type HasConfig (AuthProtected :> rest) config =
(HasConfigEntry config DBConnection, HasCfg rest config) (HasConfigEntry config DBConnection, HasConfig rest config)
route Proxy config subserver = WithRequest $ \ request -> route Proxy config subserver = WithRequest $ \ request ->
route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request

10
servant-server/src/Servant/Server.hs
View file

@ -101,18 +101,18 @@ import Servant.Server.Internal.Enter
-- > myApi :: Proxy MyApi -- > myApi :: Proxy MyApi
-- > myApi = Proxy -- > myApi = Proxy
-- > -- >
-- > cfg :: Config '[] -- > config :: Config '[]
-- > cfg = EmptyConfig -- > config = EmptyConfig
-- > -- >
-- > app :: Application -- > app :: Application
-- > app = serve myApi cfg server -- > app = serve myApi config server
-- > -- >
-- > main :: IO () -- > main :: IO ()
-- > main = Network.Wai.Handler.Warp.run 8080 app -- > main = Network.Wai.Handler.Warp.run 8080 app
-- --
serve :: (HasCfg layout a, HasServer layout) serve :: (HasConfig layout a, HasServer layout)
=> Proxy layout -> Config a -> Server layout -> Application => Proxy layout -> Config a -> Server layout -> Application
serve p cfg server = toApplication (runRouter (route p cfg d)) serve p config server = toApplication (runRouter (route p config d))
where where
d = Delayed r r r (\ _ _ -> Route server) d = Delayed r r r (\ _ _ -> Route server)
r = return (Route ()) r = return (Route ())

86
servant-server/src/Servant/Server/Internal.hs
View file

@ -69,9 +69,9 @@ import Servant.Server.Internal.ServantErr
class HasServer layout where class HasServer layout where
type ServerT layout (m :: * -> *) :: * type ServerT layout (m :: * -> *) :: *
type HasCfg layout (c :: [*]) :: Constraint type HasConfig layout (c :: [*]) :: Constraint
route :: HasCfg layout a => Proxy layout -> Config a -> Delayed (Server layout) -> Router route :: HasConfig layout a => Proxy layout -> Config a -> Delayed (Server layout) -> Router
type Server layout = ServerT layout (ExceptT ServantErr IO) type Server layout = ServerT layout (ExceptT ServantErr IO)
@ -91,10 +91,10 @@ type Server layout = ServerT layout (ExceptT ServantErr IO)
instance (HasServer a, HasServer b) => HasServer (a :<|> b) where instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m type ServerT (a :<|> b) m = ServerT a m :<|> ServerT b m
type HasCfg (a :<|> b) c = (HasCfg a c, HasCfg b c) type HasConfig (a :<|> b) c = (HasConfig a c, HasConfig b c)
route Proxy cfg server = choice (route pa cfg ((\ (a :<|> _) -> a) <$> server)) route Proxy config server = choice (route pa config ((\ (a :<|> _) -> a) <$> server))
(route pb cfg ((\ (_ :<|> b) -> b) <$> server)) (route pb config ((\ (_ :<|> b) -> b) <$> server))
where pa = Proxy :: Proxy a where pa = Proxy :: Proxy a
pb = Proxy :: Proxy b pb = Proxy :: Proxy b
@ -123,12 +123,12 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
type ServerT (Capture capture a :> sublayout) m = type ServerT (Capture capture a :> sublayout) m =
a -> ServerT sublayout m a -> ServerT sublayout m
type HasCfg (Capture capture a :> sublayout) c = (HasCfg sublayout c) type HasConfig (Capture capture a :> sublayout) c = (HasConfig sublayout c)
route Proxy cfg d = route Proxy config d =
DynamicRouter $ \ first -> DynamicRouter $ \ first ->
route (Proxy :: Proxy sublayout) route (Proxy :: Proxy sublayout)
cfg config
(addCapture d $ case captured captureProxy first of (addCapture d $ case captured captureProxy first of
Nothing -> return $ Fail err404 Nothing -> return $ Fail err404
Just v -> return $ Route v Just v -> return $ Route v
@ -200,7 +200,7 @@ instance OVERLAPPABLE_
) => HasServer (Verb method status ctypes a) where ) => HasServer (Verb method status ctypes a) where
type ServerT (Verb method status ctypes a) m = m a type ServerT (Verb method status ctypes a) m = m a
type HasCfg (Verb method status ctypes a) c = () type HasConfig (Verb method status ctypes a) c = ()
route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status route Proxy _ = methodRouter method (Proxy :: Proxy ctypes) status
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
@ -212,7 +212,7 @@ instance OVERLAPPING_
) => HasServer (Verb method status ctypes (Headers h a)) where ) => HasServer (Verb method status ctypes (Headers h a)) where
type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a) type ServerT (Verb method status ctypes (Headers h a)) m = m (Headers h a)
type HasCfg (Verb method status ctypes (Headers h a)) c = () type HasConfig (Verb method status ctypes (Headers h a)) c = ()
route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status route Proxy _ = methodRouterHeaders method (Proxy :: Proxy ctypes) status
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
@ -243,11 +243,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
type ServerT (Header sym a :> sublayout) m = type ServerT (Header sym a :> sublayout) m =
Maybe a -> ServerT sublayout m Maybe a -> ServerT sublayout m
type HasCfg (Header sym a :> sublayout) c = HasCfg sublayout c type HasConfig (Header sym a :> sublayout) c = HasConfig sublayout c
route Proxy cfg subserver = WithRequest $ \ request -> route Proxy config subserver = WithRequest $ \ request ->
let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request) let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver mheader) in route (Proxy :: Proxy sublayout) config (passToServer subserver mheader)
where str = fromString $ symbolVal (Proxy :: Proxy sym) where str = fromString $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API, -- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
@ -276,9 +276,9 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
type ServerT (QueryParam sym a :> sublayout) m = type ServerT (QueryParam sym a :> sublayout) m =
Maybe a -> ServerT sublayout m Maybe a -> ServerT sublayout m
type HasCfg (QueryParam sym a :> sublayout) c = HasCfg sublayout c type HasConfig (QueryParam sym a :> sublayout) c = HasConfig sublayout c
route Proxy cfg subserver = WithRequest $ \ request -> route Proxy config subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request let querytext = parseQueryText $ rawQueryString request
param = param =
case lookup paramname querytext of case lookup paramname querytext of
@ -286,7 +286,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
Just Nothing -> Nothing -- param present with no value -> Nothing Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
-- the right type -- the right type
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver param) in route (Proxy :: Proxy sublayout) config (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API, -- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
@ -313,16 +313,16 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
type ServerT (QueryParams sym a :> sublayout) m = type ServerT (QueryParams sym a :> sublayout) m =
[a] -> ServerT sublayout m [a] -> ServerT sublayout m
type HasCfg (QueryParams sym a :> sublayout) c = HasCfg sublayout c type HasConfig (QueryParams sym a :> sublayout) c = HasConfig sublayout c
route Proxy cfg subserver = WithRequest $ \ request -> route Proxy config subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request let querytext = parseQueryText $ rawQueryString request
-- if sym is "foo", we look for query string parameters -- if sym is "foo", we look for query string parameters
-- named "foo" or "foo[]" and call parseQueryParam on the -- named "foo" or "foo[]" and call parseQueryParam on the
-- corresponding values -- corresponding values
parameters = filter looksLikeParam querytext parameters = filter looksLikeParam querytext
values = mapMaybe (convert . snd) parameters values = mapMaybe (convert . snd) parameters
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver values) in route (Proxy :: Proxy sublayout) config (passToServer subserver values)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing convert Nothing = Nothing
@ -345,15 +345,15 @@ instance (KnownSymbol sym, HasServer sublayout)
type ServerT (QueryFlag sym :> sublayout) m = type ServerT (QueryFlag sym :> sublayout) m =
Bool -> ServerT sublayout m Bool -> ServerT sublayout m
type HasCfg (QueryFlag sym :> sublayout) c = HasCfg sublayout c type HasConfig (QueryFlag sym :> sublayout) c = HasConfig sublayout c
route Proxy cfg subserver = WithRequest $ \ request -> route Proxy config subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request let querytext = parseQueryText $ rawQueryString request
param = case lookup paramname querytext of param = case lookup paramname querytext of
Just Nothing -> True -- param is there, with no value Just Nothing -> True -- param is there, with no value
Just (Just v) -> examine v -- param with a value Just (Just v) -> examine v -- param with a value
Nothing -> False -- param not in the query string Nothing -> False -- param not in the query string
in route (Proxy :: Proxy sublayout) cfg (passToServer subserver param) in route (Proxy :: Proxy sublayout) config (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
examine v | v == "true" || v == "1" || v == "" = True examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False | otherwise = False
@ -369,7 +369,7 @@ instance (KnownSymbol sym, HasServer sublayout)
instance HasServer Raw where instance HasServer Raw where
type ServerT Raw m = Application type ServerT Raw m = Application
type HasCfg Raw c = () type HasConfig Raw c = ()
route Proxy _ rawApplication = LeafRouter $ \ request respond -> do route Proxy _ rawApplication = LeafRouter $ \ request respond -> do
r <- runDelayed rawApplication r <- runDelayed rawApplication
@ -404,10 +404,10 @@ instance ( AllCTUnrender list a, HasServer sublayout
type ServerT (ReqBody list a :> sublayout) m = type ServerT (ReqBody list a :> sublayout) m =
a -> ServerT sublayout m a -> ServerT sublayout m
type HasCfg (ReqBody list a :> sublayout) c = HasCfg sublayout c type HasConfig (ReqBody list a :> sublayout) c = HasConfig sublayout c
route Proxy cfg subserver = WithRequest $ \ request -> route Proxy config subserver = WithRequest $ \ request ->
route (Proxy :: Proxy sublayout) cfg (addBodyCheck subserver (bodyCheck request)) route (Proxy :: Proxy sublayout) config (addBodyCheck subserver (bodyCheck request))
where where
bodyCheck request = do bodyCheck request = do
-- See HTTP RFC 2616, section 7.2.1 -- See HTTP RFC 2616, section 7.2.1
@ -428,42 +428,42 @@ instance ( AllCTUnrender list a, HasServer sublayout
instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
type ServerT (path :> sublayout) m = ServerT sublayout m type ServerT (path :> sublayout) m = ServerT sublayout m
type HasCfg (path :> sublayout) c = HasCfg sublayout c type HasConfig (path :> sublayout) c = HasConfig sublayout c
route Proxy cfg subserver = StaticRouter $ route Proxy config subserver = StaticRouter $
M.singleton (cs (symbolVal proxyPath)) M.singleton (cs (symbolVal proxyPath))
(route (Proxy :: Proxy sublayout) cfg subserver) (route (Proxy :: Proxy sublayout) config subserver)
where proxyPath = Proxy :: Proxy path where proxyPath = Proxy :: Proxy path
instance HasServer api => HasServer (RemoteHost :> api) where instance HasServer api => HasServer (RemoteHost :> api) where
type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
type HasCfg (RemoteHost :> api) c = HasCfg api c type HasConfig (RemoteHost :> api) c = HasConfig api c
route Proxy cfg subserver = WithRequest $ \req -> route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ remoteHost req) route (Proxy :: Proxy api) config (passToServer subserver $ remoteHost req)
instance HasServer api => HasServer (IsSecure :> api) where instance HasServer api => HasServer (IsSecure :> api) where
type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
type HasCfg (IsSecure :> api) c = HasCfg api c type HasConfig (IsSecure :> api) c = HasConfig api c
route Proxy cfg subserver = WithRequest $ \req -> route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ secure req) route (Proxy :: Proxy api) config (passToServer subserver $ secure req)
where secure req = if isSecure req then Secure else NotSecure where secure req = if isSecure req then Secure else NotSecure
instance HasServer api => HasServer (Vault :> api) where instance HasServer api => HasServer (Vault :> api) where
type ServerT (Vault :> api) m = Vault -> ServerT api m type ServerT (Vault :> api) m = Vault -> ServerT api m
type HasCfg (Vault :> api) c = HasCfg api c type HasConfig (Vault :> api) c = HasConfig api c
route Proxy cfg subserver = WithRequest $ \req -> route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ vault req) route (Proxy :: Proxy api) config (passToServer subserver $ vault req)
instance HasServer api => HasServer (HttpVersion :> api) where instance HasServer api => HasServer (HttpVersion :> api) where
type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
type HasCfg (HttpVersion :> api) c = HasCfg api c type HasConfig (HttpVersion :> api) c = HasConfig api c
route Proxy cfg subserver = WithRequest $ \req -> route Proxy config subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) cfg (passToServer subserver $ httpVersion req) route (Proxy :: Proxy api) config (passToServer subserver $ httpVersion req)
pathIsEmpty :: Request -> Bool pathIsEmpty :: Request -> Bool
pathIsEmpty = go . pathInfo pathIsEmpty = go . pathInfo
@ -481,8 +481,8 @@ instance (HasServer subApi) =>
type ServerT (SubConfig name subConfig :> subApi) m = type ServerT (SubConfig name subConfig :> subApi) m =
ServerT subApi m ServerT subApi m
type HasCfg (SubConfig name subConfig :> subApi) config = type HasConfig (SubConfig name subConfig :> subApi) config =
(HasConfigEntry config (SubConfig name subConfig), HasCfg subApi subConfig) (HasConfigEntry config (SubConfig name subConfig), HasConfig subApi subConfig)
route Proxy config delayed = route Proxy config delayed =
route subProxy subConfig delayed route subProxy subConfig delayed

4
servant-server/src/Servant/Server/Internal/Config.hs
View file

@ -33,8 +33,8 @@ instance Eq (Config '[]) where
instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where instance (Eq a, Eq (Config as)) => Eq (Config (a ': as)) where
x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2 x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
class HasConfigEntry (cfg :: [*]) (val :: *) where class HasConfigEntry (config :: [*]) (val :: *) where
getConfigEntry :: Config cfg -> val getConfigEntry :: Config config -> val
instance OVERLAPPABLE_ instance OVERLAPPABLE_
HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where HasConfigEntry xs val => HasConfigEntry (notIt ': xs) val where

12
servant-server/test/Servant/Server/UsingConfigSpec/TestCombinators.hs
View file

@ -26,8 +26,8 @@ instance (HasServer subApi) =>
type ServerT (ExtractFromConfig :> subApi) m = type ServerT (ExtractFromConfig :> subApi) m =
String -> ServerT subApi m String -> ServerT subApi m
type HasCfg (ExtractFromConfig :> subApi) (c :: [*]) = type HasConfig (ExtractFromConfig :> subApi) (c :: [*]) =
(HasConfigEntry c String, HasCfg subApi c) (HasConfigEntry c String, HasConfig subApi c)
route Proxy config delayed = route Proxy config delayed =
route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi)) route subProxy config (fmap (inject config) delayed :: Delayed (Server subApi))
@ -44,8 +44,8 @@ instance (HasServer subApi) =>
type ServerT (InjectIntoConfig :> subApi) m = type ServerT (InjectIntoConfig :> subApi) m =
ServerT subApi m ServerT subApi m
type HasCfg (InjectIntoConfig :> subApi) c = type HasConfig (InjectIntoConfig :> subApi) c =
(HasCfg subApi (String ': c)) (HasConfig subApi (String ': c))
route Proxy config delayed = route Proxy config delayed =
route subProxy newConfig delayed route subProxy newConfig delayed
@ -60,8 +60,8 @@ data Descend (name :: Symbol) (subConfig :: [*]) subApi
instance HasServer subApi => HasServer (Descend name subConfig subApi) where instance HasServer subApi => HasServer (Descend name subConfig subApi) where
type ServerT (Descend name subConfig subApi) m = type ServerT (Descend name subConfig subApi) m =
ServerT subApi m ServerT subApi m
type HasCfg (Descend name subConfig subApi) config = type HasConfig (Descend name subConfig subApi) config =
(HasConfigEntry config (SubConfig name subConfig), HasCfg subApi subConfig) (HasConfigEntry config (SubConfig name subConfig), HasConfig subApi subConfig)
route Proxy config delayed = route Proxy config delayed =
route subProxy subConfig delayed route subProxy subConfig delayed