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

Merge pull request #753 from DaveCTurner/issue-753

Browse source 
Add a type representing an empty API
This commit is contained in:
Oleg Grenrus 2017-05-17 11:54:10 +03:00 committed by GitHub
commit 1ccb0ef812
19 changed files with 154 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
doc/tutorial/ApiType.lhs
View file

@ -321,11 +321,33 @@ data BasicAuth (realm :: Symbol) (userData :: *)
Which is used like so:
``` haskell
type ProtectedAPI12
type ProtectedAPI11
= UserAPI -- this is public
:<|> BasicAuth "my-realm" User :> UserAPI2 -- this is protected by auth
```
### Empty APIs
Sometimes it is useful to be able to generalise an API over the type of some
part of it:
``` haskell
type UserAPI12 innerAPI
= UserAPI -- this is the fixed bit of the API
:<|> "inner" :> innerAPI -- this lets us put various other APIs under /inner
```
If there is a case where you do not have anything extra to serve, you can use
the `EmptyAPI` combinator to indicate this:
``` haskell
type UserAPI12Alone = UserAPI12 EmptyAPI
```
This also works well as a placeholder for unfinished parts of an API while it
is under development, for when you know that there should be _something_ there
but you don't yet know what. Think of it as similar to the unit type `()`.
### Interoperability with `wai`: `Raw`
Finally, we also include a combinator named `Raw` that provides an escape hatch
@ -334,7 +356,7 @@ you want to plug a [wai `Application`](http://hackage.haskell.org/package/wai)
into your webservice:
``` haskell
type UserAPI11 = "users" :> Get '[JSON] [User]
type UserAPI13 = "users" :> Get '[JSON] [User]
-- a /users endpoint
:<|> Raw

13
doc/tutorial/Client.lhs
View file

@ -93,6 +93,19 @@ position :<|> hello :<|> marketing = client api
`client api` returns client functions for our _entire_ API, combined with `:<|>`, which we can pattern match on as above. You could say `client` "calculates" the correct type and number of client functions for the API type it is given (via a `Proxy`), as well as their implementations.
If you have an `EmptyAPI` in your API, servant-client will hand you a value of
type `EmptyClient` in the corresponding slot, where `data EmptyClient =
EmptyClient`, as a way to indicate that you can't do anything useful with it.
``` haskell ignore
type API' = API :<|> EmptyAPI
api' :: Proxy API'
api' = Proxy
(position' :<|> hello' :<|> marketing') :<|> EmptyClient = client api'
```
``` haskell ignore
-- | URI scheme to use
data Scheme =

2
doc/tutorial/Docs.lhs
View file

@ -89,6 +89,8 @@ instance ToSample Email where
```
Types that are used as request or response bodies have to instantiate the `ToSample` typeclass which lets you specify one or more examples of values. `Capture`s and `QueryParam`s have to instantiate their respective `ToCapture` and `ToParam` classes and provide a name and some information about the concrete meaning of that argument, as illustrated in the code above.
The `EmptyAPI` combinator needs no special treatment as it generates no
documentation: an empty API has no endpoints to document.
With all of this, we can derive docs for our API.

3
doc/tutorial/Javascript.lhs
View file

@ -149,6 +149,9 @@ Why two different API types, proxies and servers though? Simply because we
don't want to generate javascript functions for the `Raw` part of our API type,
so we need a `Proxy` for our API type `API'` without its `Raw` endpoint.
The `EmptyAPI` combinator needs no special treatment as it generates no
Javascript functions: an empty API has no endpoints to access.
Very similarly to how one can derive haskell functions, we can derive the
javascript with just a simple function call to `jsForAPI` from
`Servant.JS`.

11
doc/tutorial/Server.lhs
View file

@ -1020,6 +1020,17 @@ serverFor = error "..."
-- or the mailing list if you get stuck!
```
When your API contains the `EmptyAPI` combinator, you'll want to use
`emptyServer` in the corresponding slot for your server, which will simply fail
with 404 whenever a request reaches it:
``` haskell
type CombinedAPI2 = API :<|> "empty" :> EmptyAPI
server11 :: Server CombinedAPI2
server11 = server3 :<|> emptyServer
```
## Using another monad for your handlers
Remember how `Server` turns combinators for HTTP methods into `Handler`? Well, actually, there's more to that. `Server` is actually a

18
servant-client/src/Servant/Client.hs
View file

@ -24,6 +24,7 @@ module Servant.Client
, ClientEnv (ClientEnv)
, mkAuthenticateReq
, ServantError(..)
, EmptyClient(..)
, module Servant.Common.BaseUrl
) where
@ -88,6 +89,23 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
clientWithRoute (Proxy :: Proxy a) req :<|>
clientWithRoute (Proxy :: Proxy b) req
-- | Singleton type representing a client for an empty API.
data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
--
-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
-- > :<|> "nothing" :> EmptyAPI
-- >
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getAllBooks :: ClientM [Book]
-- > (getAllBooks :<|> EmptyClient) = client myApi
instance HasClient EmptyAPI where
type Client EmptyAPI = EmptyClient
clientWithRoute Proxy _ = EmptyClient
-- | If you use a 'Capture' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'Capture'.

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

@ -111,6 +111,8 @@ type Api =
Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
:<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
:<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent
:<|> "empty" :> EmptyAPI
api :: Proxy Api
api = Proxy
@ -130,6 +132,7 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)
getDeleteContentType :: SCR.ClientM NoContent
getGet
:<|> getDeleteEmpty
:<|> getCapture
@ -142,7 +145,8 @@ getGet
:<|> getRawFailure
:<|> getMultiple
:<|> getRespHeaders
:<|> getDeleteContentType = client api
:<|> getDeleteContentType
:<|> EmptyClient = client api
server :: Application
server = serve api (
@ -162,7 +166,7 @@ server = serve api (
:<|> (\ a b c d -> return (a, b, c, d))
:<|> (return $ addHeader 1729 $ addHeader "eg2" True)
:<|> return NoContent
)
:<|> emptyServer)
type FailApi =

4
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -683,6 +683,10 @@ instance OVERLAPPABLE_
p2 :: Proxy b
p2 = Proxy
-- | The generated docs for @'EmptyAPI'@ are empty.
instance HasDocs EmptyAPI where
docsFor Proxy _ _ = emptyAPI
-- | @"books" :> 'Capture' "isbn" Text@ will appear as
-- @/books/:isbn@ in the docs.
instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)

4
servant-docs/test/Servant/DocsSpec.hs
View file

@ -104,6 +104,9 @@ spec = describe "Servant.Docs" $ do
it "contains request body samples" $
md `shouldContain` "17"
it "does not generate any docs mentioning the 'empty-api' path" $
md `shouldNotContain` "empty-api"
-- * APIs
@ -128,6 +131,7 @@ instance MimeRender PlainText Int where
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
:<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
:<|> Header "X-Test" Int :> Put '[JSON] Int
:<|> "empty-api" :> EmptyAPI
data TT = TT1 | TT2 deriving (Show, Eq)
data UT = UT1 | UT2 deriving (Show, Eq)

10
servant-foreign/src/Servant/Foreign/Internal.hs
View file

@ -187,6 +187,13 @@ instance (HasForeign lang ftype a, HasForeign lang ftype b)
foreignFor lang ftype (Proxy :: Proxy a) req
:<|> foreignFor lang ftype (Proxy :: Proxy b) req
data EmptyForeignAPI = EmptyForeignAPI
instance HasForeign lang ftype EmptyAPI where
type Foreign ftype EmptyAPI = EmptyForeignAPI
foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
=> HasForeign lang ftype (Capture sym t :> api) where
type Foreign ftype (Capture sym t :> api) = Foreign ftype api
@ -349,6 +356,9 @@ instance HasForeign lang ftype api
class GenerateList ftype reqs where
generateList :: reqs -> [Req ftype]
instance GenerateList ftype EmptyForeignAPI where
generateList _ = []
instance GenerateList ftype (Req ftype) where
generateList r = [r]

3
servant-foreign/test/Servant/ForeignSpec.hs
View file

@ -57,13 +57,14 @@ type TestApi
:<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
:<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
:<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]
:<|> "test" :> EmptyAPI
testApi :: [Req String]
testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
listFromAPISpec :: Spec
listFromAPISpec = describe "listFromAPI" $ do
it "generates 4 endpoints for TestApi" $ do
it "generates 5 endpoints for TestApi" $ do
length testApi `shouldBe` 5
let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi

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

@ -17,6 +17,8 @@ module Servant.Server
, -- * Handlers for all standard combinators
HasServer(..)
, Server
, EmptyServer
, emptyServer
, Handler (..)
, runHandler
@ -219,8 +221,8 @@ layoutWithContext p context =
--
-- >>> import Control.Monad.Reader
-- >>> import qualified Control.Category as C
-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw
-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :: ServerT ReaderAPI (Reader String)
-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String :<|> Raw :<|> EmptyAPI
-- >>> let readerServer = return 1797 :<|> ask :<|> Tagged (error "raw server") :<|> emptyServer :: ServerT ReaderAPI (Reader String)
-- >>> let nt = generalizeNat C.. (runReaderTNat "hi") :: Reader String :~> Handler
-- >>> let mainServer = enter nt readerServer :: Server ReaderAPI
--

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

@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@ -32,7 +33,7 @@ import Data.Maybe (fromMaybe, mapMaybe)
import Data.Either (partitionEithers)
import Data.String (fromString)
import Data.String.Conversions (cs, (<>))
import Data.Tagged (Tagged, untag)
import Data.Tagged (Tagged(..), untag)
import qualified Data.Text as T
import Data.Typeable
import GHC.TypeLits (KnownNat, KnownSymbol, natVal,
@ -52,7 +53,7 @@ import Web.HttpApiData (FromHttpApiData, parseHeader,
parseUrlPieceMaybe,
parseUrlPieces)
import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,
CaptureAll, Verb,
CaptureAll, Verb, EmptyAPI,
ReflectMethod(reflectMethod),
IsSecure(..), Header, QueryFlag,
QueryParam, QueryParams, Raw,
@ -532,6 +533,24 @@ instance HasServer api context => HasServer (HttpVersion :> api) context where
route Proxy context subserver =
route (Proxy :: Proxy api) context (passToServer subserver httpVersion)
-- | Singleton type representing a server that serves an empty API.
data EmptyServer = EmptyServer deriving (Typeable, Eq, Show, Bounded, Enum)
-- | Server for `EmptyAPI`
emptyServer :: ServerT EmptyAPI m
emptyServer = Tagged EmptyServer
-- | The server for an `EmptyAPI` is `emptyAPIServer`.
--
-- > type MyApi = "nothing" :> EmptyApi
-- >
-- > server :: Server MyApi
-- > server = emptyAPIServer
instance HasServer EmptyAPI context where
type ServerT EmptyAPI m = Tagged m EmptyServer
route Proxy _ _ = StaticRouter mempty mempty
-- | Basic Authentication
instance ( KnownSymbol realm
, HasServer api context

9
servant-server/test/Servant/ServerSpec.hs
View file

@ -42,14 +42,14 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,
Headers, HttpVersion,
IsSecure (..), JSON,
NoContent (..), Patch, PlainText,
Post, Put,
Post, Put, EmptyAPI,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody,
StdMethod (..), Verb, addHeader)
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Server (Server, Handler, Tagged (..), err401, err403,
err404, serve, serveWithContext,
Context((:.), EmptyContext))
Context((:.), EmptyContext), emptyServer)
import Test.Hspec (Spec, context, describe, it,
shouldBe, shouldContain)
import qualified Test.Hspec.Wai as THW
@ -609,6 +609,7 @@ type MiscCombinatorsAPI
= "version" :> HttpVersion :> Get '[JSON] String
:<|> "secure" :> IsSecure :> Get '[JSON] String
:<|> "host" :> RemoteHost :> Get '[JSON] String
:<|> "empty" :> EmptyAPI
miscApi :: Proxy MiscCombinatorsAPI
miscApi = Proxy
@ -617,6 +618,7 @@ miscServ :: Server MiscCombinatorsAPI
miscServ = versionHandler
:<|> secureHandler
:<|> hostHandler
:<|> emptyServer
where versionHandler = return . show
secureHandler Secure = return "secure"
@ -635,6 +637,9 @@ miscCombinatorSpec = with (return $ serve miscApi miscServ) $
it "Checks that hspec-wai issues request from 0.0.0.0" $
go "/host" "\"0.0.0.0:0\""
it "Doesn't serve anything from the empty API" $
Test.Hspec.Wai.get "empty" `shouldRespondWith` 404
where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res
-- }}}

1
servant/servant.cabal
View file

@ -36,6 +36,7 @@ library
Servant.API.BasicAuth
Servant.API.Capture
Servant.API.ContentTypes
Servant.API.Empty
Servant.API.Experimental.Auth
Servant.API.Header
Servant.API.HttpVersion

3
servant/src/Servant/API.hs
View file

@ -5,6 +5,8 @@ module Servant.API (
-- | Type-level combinator for expressing subrouting: @':>'@
module Servant.API.Alternative,
-- | Type-level combinator for alternative endpoints: @':<|>'@
module Servant.API.Empty,
-- | Type-level combinator for an empty API: @'EmptyAPI'@
-- * Accessing information from the request
module Servant.API.Capture,
@ -66,6 +68,7 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
MimeRender (..), NoContent (NoContent),
MimeUnrender (..), OctetStream,
PlainText)
import Servant.API.Empty (EmptyAPI (..))
import Servant.API.Experimental.Auth (AuthProtect)
import Servant.API.Header (Header (..))
import Servant.API.HttpVersion (HttpVersion (..))

12
servant/src/Servant/API/Empty.hs Normal file
View file

@ -0,0 +1,12 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Empty(EmptyAPI(..)) where
import Data.Typeable (Typeable)
import Prelude ()
import Prelude.Compat
-- | An empty API: one which serves nothing. Morally speaking, this should be
-- the unit of ':<|>'. Implementors of interpretations of API types should
-- treat 'EmptyAPI' as close to the unit as possible.
data EmptyAPI = EmptyAPI deriving (Typeable, Eq, Show, Bounded, Enum)

3
servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
View file

@ -37,7 +37,8 @@ type ComprehensiveAPIWithoutRaw =
Verb 'POST 204 '[JSON] NoContent :<|>
Verb 'POST 204 '[JSON] Int :<|>
WithNamedContext "foo" '[] GET :<|>
CaptureAll "foo" Int :> GET
CaptureAll "foo" Int :> GET :<|>
EmptyAPI
comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
comprehensiveAPIWithoutRaw = Proxy

7
servant/test/Servant/Utils/LinksSpec.hs
View file

@ -25,6 +25,7 @@ type TestApi =
:<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] NoContent
:<|> "delete" :> Header "ponies" String :> Delete '[JSON] NoContent
:<|> "raw" :> Raw
:<|> NoEndpoint
apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
@ -98,6 +99,11 @@ spec = describe "Servant.Utils.Links" $ do
-- ...Could not deduce...
-- ...
--
-- >>> apiLink (Proxy :: Proxy NoEndpoint)
-- ...
-- ...No instance for...
-- ...
--
-- sanity check
-- >>> toUrlPiece $ apiLink (Proxy :: Proxy AllGood)
-- "get"
@ -107,3 +113,4 @@ type WrongContentType = "get" :> Get '[OctetStream] NoContent
type WrongMethod = "get" :> Post '[JSON] NoContent
type NotALink = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool
type AllGood = "get" :> Get '[JSON] NoContent
type NoEndpoint = "empty" :> EmptyAPI