Compare commits
6 Commits
master
...
static-cli
Author | SHA1 | Date | |
---|---|---|---|
|
171195010c | ||
|
d37b6a12df | ||
|
be4f08a4fb | ||
|
353b1aada0 | ||
|
3875aa82ba | ||
|
3375a33b4a |
|
@ -1,5 +1,5 @@
|
||||||
name: tutorial
|
name: tutorial
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: The servant tutorial
|
synopsis: The servant tutorial
|
||||||
homepage: http://haskell-servant.github.io/
|
homepage: http://haskell-servant.github.io/
|
||||||
license: BSD3
|
license: BSD3
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||||
|
|
||||||
name: servant-blaze
|
name: servant-blaze
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: Blaze-html support for servant
|
synopsis: Blaze-html support for servant
|
||||||
-- description:
|
-- description:
|
||||||
homepage: http://haskell-servant.github.io/
|
homepage: http://haskell-servant.github.io/
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||||
|
|
||||||
name: servant-cassava
|
name: servant-cassava
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: Servant CSV content-type for cassava
|
synopsis: Servant CSV content-type for cassava
|
||||||
-- description:
|
-- description:
|
||||||
homepage: http://haskell-servant.github.io/
|
homepage: http://haskell-servant.github.io/
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant-client
|
name: servant-client
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: automatical derivation of querying functions for servant webservices
|
synopsis: automatical derivation of querying functions for servant webservices
|
||||||
description:
|
description:
|
||||||
This library lets you derive automatically Haskell functions that
|
This library lets you derive automatically Haskell functions that
|
||||||
|
|
|
@ -2,7 +2,9 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
@ -18,6 +20,7 @@ module Servant.Client
|
||||||
( AuthClientData
|
( AuthClientData
|
||||||
, AuthenticateReq(..)
|
, AuthenticateReq(..)
|
||||||
, client
|
, client
|
||||||
|
, staticClient
|
||||||
, HasClient(..)
|
, HasClient(..)
|
||||||
, ClientM
|
, ClientM
|
||||||
, mkAuthenticateReq
|
, mkAuthenticateReq
|
||||||
|
@ -60,6 +63,36 @@ import Servant.Common.Req
|
||||||
client :: HasClient layout => Proxy layout -> Client layout
|
client :: HasClient layout => Proxy layout -> Client layout
|
||||||
client p = clientWithRoute p defReq
|
client p = clientWithRoute p defReq
|
||||||
|
|
||||||
|
|
||||||
|
class Foo layout where
|
||||||
|
type StaticClient layout :: *
|
||||||
|
staticClient :: Proxy layout -> BaseUrl -> StaticClient layout
|
||||||
|
|
||||||
|
instance (Foo left, Foo right) => Foo (left :<|> right) where
|
||||||
|
type StaticClient (left :<|> right) = StaticClient left :<|> StaticClient right
|
||||||
|
staticClient p url =
|
||||||
|
staticClient pleft url :<|>
|
||||||
|
staticClient pright url
|
||||||
|
where pleft = Proxy :: Proxy left
|
||||||
|
pright = Proxy :: Proxy right
|
||||||
|
|
||||||
|
instance OVERLAPPABLE_ (Client (combinator :> api) ~ Client api, Foo api) => Foo (combinator :> api) where
|
||||||
|
type StaticClient (combinator :> api) = StaticClient api
|
||||||
|
staticClient p url = staticClient (Proxy :: Proxy api) url
|
||||||
|
|
||||||
|
instance OVERLAPPING_ (MimeRender ct a, Client (ReqBody (ct ': cts) a :> sublayout) ~ (a -> Client sublayout), Foo sublayout)
|
||||||
|
=> Foo (ReqBody (ct ': cts) a :> sublayout) where
|
||||||
|
type StaticClient (ReqBody (ct ': cts) a :> sublayout) = a -> Client sublayout
|
||||||
|
staticClient p url = _
|
||||||
|
|
||||||
|
instance (Client (Verb method status ctypes result) ~ (Manager -> BaseUrl -> ClientM result), ctypes ~ (c ': ct), MimeUnrender c result, ReflectMethod method) => Foo (Verb method status ctypes result) where
|
||||||
|
type StaticClient (Verb method status ctypes result) = Manager -> ClientM result
|
||||||
|
staticClient p url = \ mgr -> (client p) mgr url
|
||||||
|
|
||||||
|
instance Foo Raw where
|
||||||
|
type StaticClient Raw = H.Method -> Manager -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
|
||||||
|
staticClient p url = \h m -> (client p) h m url
|
||||||
|
|
||||||
-- | This class lets us define how each API combinator
|
-- | This class lets us define how each API combinator
|
||||||
-- influences the creation of an HTTP request. It's mostly
|
-- influences the creation of an HTTP request. It's mostly
|
||||||
-- an internal class, you can just use 'client'.
|
-- an internal class, you can just use 'client'.
|
||||||
|
|
|
@ -296,6 +296,11 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||||
return $
|
return $
|
||||||
result === Right (cap, num, flag, body)
|
result === Right (cap, num, flag, body)
|
||||||
|
|
||||||
|
describe "staticClient" $ do
|
||||||
|
it "allows to pass in the BaseUrl to staticClient" $ \(_, baseUrl) -> do
|
||||||
|
let getGet' :: C.Manager -> ClientM Person
|
||||||
|
getGet' :<|> _ = staticClient api baseUrl
|
||||||
|
(left show <$> runExceptT (getGet' manager)) `shouldReturn` Right alice
|
||||||
|
|
||||||
wrappedApiSpec :: Spec
|
wrappedApiSpec :: Spec
|
||||||
wrappedApiSpec = describe "error status codes" $ do
|
wrappedApiSpec = describe "error status codes" $ do
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant-docs
|
name: servant-docs
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: generate API docs for your servant webservice
|
synopsis: generate API docs for your servant webservice
|
||||||
description:
|
description:
|
||||||
Library for generating API docs from a servant API definition.
|
Library for generating API docs from a servant API definition.
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant-foreign
|
name: servant-foreign
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: Helpers for generating clients for servant APIs in any programming language
|
synopsis: Helpers for generating clients for servant APIs in any programming language
|
||||||
description:
|
description:
|
||||||
Helper types and functions for generating client functions for servant APIs in any programming language
|
Helper types and functions for generating client functions for servant APIs in any programming language
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant-js
|
name: servant-js
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: Automatically derive javascript functions to query servant webservices.
|
synopsis: Automatically derive javascript functions to query servant webservices.
|
||||||
description:
|
description:
|
||||||
Automatically derive javascript functions to query servant webservices.
|
Automatically derive javascript functions to query servant webservices.
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||||
|
|
||||||
name: servant-lucid
|
name: servant-lucid
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: Servant support for lucid
|
synopsis: Servant support for lucid
|
||||||
-- description:
|
-- description:
|
||||||
homepage: http://haskell-servant.github.io/
|
homepage: http://haskell-servant.github.io/
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant-mock
|
name: servant-mock
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: Derive a mock server for free from your servant API types
|
synopsis: Derive a mock server for free from your servant API types
|
||||||
description:
|
description:
|
||||||
Derive a mock server for free from your servant API types
|
Derive a mock server for free from your servant API types
|
||||||
|
|
|
@ -1,3 +1,11 @@
|
||||||
|
0.6.1
|
||||||
|
-----
|
||||||
|
|
||||||
|
* If servers use the `BasicAuth` combinator and receive requests with missing or
|
||||||
|
invalid credentials, the resulting error responses (401 and 403) could be
|
||||||
|
overwritten by subsequent alternative routes. Now `BasicAuth` uses `FailFatal`
|
||||||
|
and the error responses can't be overwritten anymore.
|
||||||
|
|
||||||
0.6
|
0.6
|
||||||
---
|
---
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant-server
|
name: servant-server
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: A family of combinators for defining webservices APIs and serving them
|
synopsis: A family of combinators for defining webservices APIs and serving them
|
||||||
description:
|
description:
|
||||||
A family of combinators for defining webservices APIs and serving them
|
A family of combinators for defining webservices APIs and serving them
|
||||||
|
|
|
@ -63,4 +63,3 @@ instance ( HasServer api context
|
||||||
where
|
where
|
||||||
authHandler = unAuthHandler (getContextEntry context)
|
authHandler = unAuthHandler (getContextEntry context)
|
||||||
authCheck = fmap (either FailFatal Route) . runExceptT . authHandler
|
authCheck = fmap (either FailFatal Route) . runExceptT . authHandler
|
||||||
|
|
||||||
|
|
|
@ -52,7 +52,7 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,
|
||||||
Raw, RemoteHost, ReqBody,
|
Raw, RemoteHost, ReqBody,
|
||||||
StdMethod (..), Verb, addHeader)
|
StdMethod (..), Verb, addHeader)
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.API.Internal.Test.ComprehensiveAPI
|
||||||
import Servant.Server (ServantErr (..), Server, err401, err404,
|
import Servant.Server (ServantErr (..), Server, err401, err403, err404,
|
||||||
serve, serveWithContext, Context((:.), EmptyContext))
|
serve, serveWithContext, Context((:.), EmptyContext))
|
||||||
import Test.Hspec (Spec, context, describe, it,
|
import Test.Hspec (Spec, context, describe, it,
|
||||||
shouldBe, shouldContain)
|
shouldBe, shouldContain)
|
||||||
|
@ -606,11 +606,10 @@ type instance AuthServerData (AuthProtect "auth") = ()
|
||||||
|
|
||||||
genAuthContext :: Context '[AuthHandler Request ()]
|
genAuthContext :: Context '[AuthHandler Request ()]
|
||||||
genAuthContext =
|
genAuthContext =
|
||||||
let authHandler = (\req ->
|
let authHandler = \req -> case lookup "Auth" (requestHeaders req) of
|
||||||
if elem ("Auth", "secret") (requestHeaders req)
|
Just "secret" -> return ()
|
||||||
then return ()
|
Just _ -> throwE err403
|
||||||
else throwE err401
|
Nothing -> throwE err401
|
||||||
)
|
|
||||||
in mkAuthHandler authHandler :. EmptyContext
|
in mkAuthHandler authHandler :. EmptyContext
|
||||||
|
|
||||||
genAuthSpec :: Spec
|
genAuthSpec :: Spec
|
||||||
|
@ -622,6 +621,9 @@ genAuthSpec = do
|
||||||
it "returns 401 when missing headers" $ do
|
it "returns 401 when missing headers" $ do
|
||||||
get "/auth" `shouldRespondWith` 401
|
get "/auth" `shouldRespondWith` 401
|
||||||
|
|
||||||
|
it "returns 403 on wrong passwords" $ do
|
||||||
|
THW.request methodGet "/auth" [("Auth","wrong")] "" `shouldRespondWith` 403
|
||||||
|
|
||||||
it "returns 200 with the right header" $ do
|
it "returns 200 with the right header" $ do
|
||||||
THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200
|
THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
name: servant
|
name: servant
|
||||||
version: 0.6
|
version: 0.6.1
|
||||||
synopsis: A family of combinators for defining webservices APIs
|
synopsis: A family of combinators for defining webservices APIs
|
||||||
description:
|
description:
|
||||||
A family of combinators for defining webservices APIs and serving them
|
A family of combinators for defining webservices APIs and serving them
|
||||||
|
@ -96,6 +96,7 @@ test-suite spec
|
||||||
Servant.API.ContentTypesSpec
|
Servant.API.ContentTypesSpec
|
||||||
Servant.API.ResponseHeadersSpec
|
Servant.API.ResponseHeadersSpec
|
||||||
Servant.Utils.LinksSpec
|
Servant.Utils.LinksSpec
|
||||||
|
Servant.Utils.MapSpec
|
||||||
build-depends:
|
build-depends:
|
||||||
base == 4.*
|
base == 4.*
|
||||||
, aeson
|
, aeson
|
||||||
|
|
20
servant/src/Servant/Utils/Map.hs
Normal file
20
servant/src/Servant/Utils/Map.hs
Normal file
|
@ -0,0 +1,20 @@
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
module Servant.Utils.Map (mapLeaves) where
|
||||||
|
|
||||||
|
import Servant.API
|
||||||
|
|
||||||
|
class Mappable s t a b where
|
||||||
|
mapLeaves :: (forall x . a x -> b x) -> s -> t
|
||||||
|
|
||||||
|
instance Mappable (a x) (b x) a b where
|
||||||
|
mapLeaves f a = f a
|
||||||
|
|
||||||
|
instance Mappable s t a b => Mappable (arg -> s) (arg -> t) a b where
|
||||||
|
mapLeaves f s = mapLeaves f $ s
|
||||||
|
|
||||||
|
instance (Mappable left left' a b, Mappable right right' a b) => Mappable (left :<|> right) (left' :<|> right') a b where
|
||||||
|
mapLeaves f (left :<|> right) = mapLeaves f left :<|> mapLeaves f right
|
27
servant/test/Servant/Utils/MapSpec.hs
Normal file
27
servant/test/Servant/Utils/MapSpec.hs
Normal file
|
@ -0,0 +1,27 @@
|
||||||
|
module Servant.Utils.MapSpec where
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
|
||||||
|
import Data.Functor.Identity
|
||||||
|
import Servant.API
|
||||||
|
import Servant.Utils.Map
|
||||||
|
spec :: Spec
|
||||||
|
spec = describe "Map" $ do
|
||||||
|
it "maps " $ do
|
||||||
|
let foo :: Bool -> Int -> String
|
||||||
|
foo _ b = show b
|
||||||
|
|
||||||
|
bar :: () -> String -> Int -> Double
|
||||||
|
bar _ _ i = fromIntegral i
|
||||||
|
|
||||||
|
foobar = foo :<|> bar
|
||||||
|
|
||||||
|
convert :: (Int -> a) -> Identity a
|
||||||
|
convert f = Identity $ f 42
|
||||||
|
|
||||||
|
foo' :: Bool -> Identity String
|
||||||
|
bar' :: () -> String -> Identity Double
|
||||||
|
foo' :<|> bar' = mapLeaves convert foobar
|
||||||
|
|
||||||
|
foo' True `shouldBe` Identity "42"
|
||||||
|
bar' () "" `shouldBe` Identity (42 :: Double)
|
|
@ -1,10 +1,10 @@
|
||||||
servant
|
servant
|
||||||
servant-cassava
|
servant-server
|
||||||
servant-client
|
servant-client
|
||||||
|
servant-cassava
|
||||||
servant-docs
|
servant-docs
|
||||||
servant-foreign
|
servant-foreign
|
||||||
servant-js
|
servant-js
|
||||||
servant-server
|
|
||||||
servant-blaze
|
servant-blaze
|
||||||
servant-lucid
|
servant-lucid
|
||||||
servant-mock
|
servant-mock
|
||||||
|
|
Loading…
Reference in New Issue
Block a user