diff --git a/doc/tutorial/ApiType.lhs b/doc/tutorial/ApiType.lhs index d43b141d..cc2d3717 100644 --- a/doc/tutorial/ApiType.lhs +++ b/doc/tutorial/ApiType.lhs @@ -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 diff --git a/doc/tutorial/Client.lhs b/doc/tutorial/Client.lhs index 284d6e83..94aee690 100644 --- a/doc/tutorial/Client.lhs +++ b/doc/tutorial/Client.lhs @@ -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 = diff --git a/doc/tutorial/Docs.lhs b/doc/tutorial/Docs.lhs index 67f6f60c..1d428698 100644 --- a/doc/tutorial/Docs.lhs +++ b/doc/tutorial/Docs.lhs @@ -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. diff --git a/doc/tutorial/Javascript.lhs b/doc/tutorial/Javascript.lhs index 6a7aa6bb..033735ed 100644 --- a/doc/tutorial/Javascript.lhs +++ b/doc/tutorial/Javascript.lhs @@ -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`. diff --git a/doc/tutorial/Server.lhs b/doc/tutorial/Server.lhs index 0de0907b..e287a26b 100644 --- a/doc/tutorial/Server.lhs +++ b/doc/tutorial/Server.lhs @@ -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 diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index d6084edf..dfe2721c 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -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'. diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 219a178c..14e9f917 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -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 = diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 2884473c..b5088f7a 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -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) diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 054ea00a..3daffbcf 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -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) diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index ac68631c..fd12befd 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -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] diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs index d88c1abb..3bc572a5 100644 --- a/servant-foreign/test/Servant/ForeignSpec.hs +++ b/servant-foreign/test/Servant/ForeignSpec.hs @@ -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 diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs index 47fdf0cf..66e0ef9b 100644 --- a/servant-server/src/Servant/Server.hs +++ b/servant-server/src/Servant/Server.hs @@ -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 -- diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 31d7b751..d336fb0f 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -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 diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 3db3e27c..0a641559 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -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 -- }}} diff --git a/servant/servant.cabal b/servant/servant.cabal index 14229d16..3e126d66 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -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 diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 08594137..f1a0e64b 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -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 (..)) diff --git a/servant/src/Servant/API/Empty.hs b/servant/src/Servant/API/Empty.hs new file mode 100644 index 00000000..efc79356 --- /dev/null +++ b/servant/src/Servant/API/Empty.hs @@ -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) diff --git a/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs b/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs index e7c15633..0f39a910 100644 --- a/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs +++ b/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs @@ -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 diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs index 05abd67a..b8dbcee7 100644 --- a/servant/test/Servant/Utils/LinksSpec.hs +++ b/servant/test/Servant/Utils/LinksSpec.hs @@ -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