servant 0.12.1 → 0.13
raw patch · 18 files changed
+622/−112 lines, 18 filesdep +singleton-booldep −directorydep −filemanipdep −filepathdep ~QuickCheckdep ~aesondep ~attoparsec
Dependencies added: singleton-bool
Dependencies removed: directory, filemanip, filepath, url
Dependency ranges changed: QuickCheck, aeson, attoparsec, base, base-compat, bytestring, case-insensitive, doctest, hspec, http-api-data, http-media, http-types, mmorph, mtl, network-uri, quickcheck-instances, semigroups, string-conversions, tagged, text, vault
Files
- CHANGELOG.md +77/−0
- servant.cabal +65/−46
- src/Servant/API.hs +27/−5
- src/Servant/API/Capture.hs +6/−4
- src/Servant/API/ContentTypes.hs +3/−3
- src/Servant/API/Description.hs +45/−5
- src/Servant/API/Header.hs +9/−8
- src/Servant/API/Internal/Test/ComprehensiveAPI.hs +4/−1
- src/Servant/API/Modifiers.hs +150/−0
- src/Servant/API/QueryParam.hs +8/−3
- src/Servant/API/ReqBody.hs +12/−3
- src/Servant/API/ResponseHeaders.hs +16/−7
- src/Servant/API/Stream.hs +117/−0
- src/Servant/API/Sub.hs +1/−1
- src/Servant/API/Verbs.hs +1/−1
- src/Servant/Utils/Enter.hs +0/−1
- src/Servant/Utils/Links.hs +60/−15
- test/Servant/Utils/LinksSpec.hs +21/−9
CHANGELOG.md view
@@ -1,5 +1,82 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.13+----++### Significant changes++- Streaming endpoint support.+ ([#836](https://github.com/haskell-servant/servant/pull/836))++ ```haskell+ type StreamApi f = "streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)+ ```++ See tutorial for more details+ - [A web API as a type - StreamGet and StreamPost](http://haskell-servant.readthedocs.io/en/release-0.13/tutorial/ApiType.html#streamget-and-streampost)+ - [Serving an API - streaming endpoints](http://haskell-servant.readthedocs.io/en/release-0.13/tutorial/Server.html#streaming-endpoints)+ - [Querying an API - Querying Streaming APIs](http://haskell-servant.readthedocs.io/en/release-0.13/tutorial/Client.html#querying-streaming-apis)++- *servant* Add `Servant.API.Modifiers`+ ([#873](https://github.com/haskell-servant/servant/pull/873)+ [#903](https://github.com/haskell-servant/servant/pull/903))++ `QueryParam`, `Header` and `ReqBody` understand modifiers:+ - `Required` or `Optional` (resulting in `a` or `Maybe a` in handlers)+ - `Strict` or `Lenient` (resulting in `a` or `Either String a` in handlers)++ Also you can use `Description` as a modifier, but it doesn't yet work+ with `servant-docs`, only `servant-swagger`. [There is an issue.](https://github.com/haskell-servant/servant/issues/902)++- *servant-client* Support `http-client`’s `CookieJar`+ ([#897](https://github.com/haskell-servant/servant/pull/897)+ [#883](https://github.com/haskell-servant/servant/pull/883))++ `ClientM` preserves cookies between requests,+ if given initial `CookieJar`.+ To migrate from older code, change `ClientEnv` constructor+ to `mkClientEnv` which makes `ClientEnv` without `CookieJar`.++- *servant* Mono-kind-ise modifiers, resulting in better error messages.+ ([#887](https://github.com/haskell-servant/servant/issues/887)+ [#890](https://github.com/haskell-servant/servant/pull/890))++- *servant* Add `TypeError ... => HasServer`s instances in GHC-8.2 for+ not saturated modifiers (`Capture "foo" :> ...`) or `->` in place of `:>`.+ ([#893](https://github.com/haskell-servant/servant/pull/893))++- *Cookbook* example projects at+ http://haskell-servant.readthedocs.io/en/master/cookbook/index.html+ ([#867](https://github.com/haskell-servant/servant/pull/867)+ [#892](https://github.com/haskell-servant/servant/pull/882))++- *Experimental work* `servant-client-ghcjs`+ ([#818](https://github.com/haskell-servant/servant/pull/818)+ [#869](https://github.com/haskell-servant/servant/pull/869))++### Other changes++- *servant* Links aren't double escaped+ ([#878](https://github.com/haskell-servant/servant/pull/878))++- Dependency updates+ ([#900](https://github.com/haskell-servant/servant/pull/900)+ [#898](https://github.com/haskell-servant/servant/pull/898)+ [#895](https://github.com/haskell-servant/servant/pull/895)+ [#872](https://github.com/haskell-servant/servant/pull/872))++- Documentation updates+ ([#875](https://github.com/haskell-servant/servant/pull/875)+ [#861](https://github.com/haskell-servant/servant/pull/861))++- Refactorings+ ([#899](https://github.com/haskell-servant/servant/pull/899)+ [#896](https://github.com/haskell-servant/servant/pull/896)+ [#889](https://github.com/haskell-servant/servant/pull/889)+ [#891](https://github.com/haskell-servant/servant/pull/891)+ [#892](https://github.com/haskell-servant/servant/pull/892)+ [#885](https://github.com/haskell-servant/servant/pull/885))+ 0.12.1 ------
servant.cabal view
@@ -1,5 +1,5 @@ name: servant-version: 0.12.1+version: 0.13 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them@@ -21,7 +21,7 @@ GHC==7.8.4 GHC==7.10.3 GHC==8.0.2- GHC==8.2.1+ GHC==8.2.2 extra-source-files: include/*.h CHANGELOG.md@@ -49,11 +49,13 @@ Servant.API.HttpVersion Servant.API.Internal.Test.ComprehensiveAPI Servant.API.IsSecure+ Servant.API.Modifiers Servant.API.QueryParam Servant.API.Raw Servant.API.RemoteHost Servant.API.ReqBody Servant.API.ResponseHeaders+ Servant.API.Stream Servant.API.Sub Servant.API.TypeLevel Servant.API.Vault@@ -61,29 +63,39 @@ Servant.API.WithNamedContext Servant.Utils.Links Servant.Utils.Enter++ -- Bundled with GHC: Lower bound to not force re-installs+ -- text and mtl are bundled starting with GHC-8.4+ --+ -- note: mtl lower bound is so low because of GHC-7.8 build-depends:- base >= 4.7 && < 4.11- , base-compat >= 0.9 && < 0.10- , aeson >= 0.7 && < 1.3- , attoparsec >= 0.12 && < 0.14- , bytestring >= 0.10 && < 0.11- , case-insensitive >= 1.2 && < 1.3- , http-api-data >= 0.3 && < 0.4- , http-media >= 0.4 && < 0.8- , http-types >= 0.8 && < 0.12- , natural-transformation >= 0.4 && < 0.5- , mtl >= 2.0 && < 2.3- , mmorph >= 1 && < 1.2- , tagged >= 0.7.3 && < 0.9- , text >= 1 && < 1.3- , string-conversions >= 0.3 && < 0.5- , network-uri >= 2.6 && < 2.7- , vault >= 0.3 && < 0.4+ base >= 4.7 && < 4.11+ , bytestring >= 0.10.4.0 && < 0.11+ , mtl >= 2.1 && < 2.3+ , text >= 1.2.3.0 && < 1.3 if !impl(ghc >= 8.0) build-depends:- semigroups >= 0.16 && < 0.19+ semigroups >= 0.18.3 && < 0.19 + -- Other dependencies: Lower bound around what is in the latest Stackage LTS.+ -- Here can be exceptions if we really need features from the newer versions.+ build-depends: + base-compat >= 0.9.3 && < 0.10+ , aeson >= 1.2.3.0 && < 1.3+ , attoparsec >= 0.13.2.0 && < 0.14+ , case-insensitive >= 1.2.0.10 && < 1.3+ , http-api-data >= 0.3.7.1 && < 0.4+ , http-media >= 0.7.1.1 && < 0.8+ , http-types >= 0.12 && < 0.13+ , natural-transformation >= 0.4 && < 0.5+ , mmorph >= 1.1.0 && < 1.2+ , tagged >= 0.8.5 && < 0.9+ , singleton-bool >= 0.1.2.0 && < 0.2+ , string-conversions >= 0.4.0.1 && < 0.5+ , network-uri >= 2.6.1.0 && < 2.7+ , vault >= 0.3.0.7 && < 0.4+ hs-source-dirs: src default-language: Haskell2010 other-extensions: CPP@@ -122,42 +134,49 @@ Servant.API.ResponseHeadersSpec Servant.Utils.LinksSpec Servant.Utils.EnterSpec- build-tool-depends:- hspec-discover:hspec-discover++ -- Dependencies inherited from the library. No need to specify bounds. build-depends:- base == 4.*+ base , base-compat , aeson- , aeson-compat >=0.3.3 && <0.4 , attoparsec , bytestring- , hspec == 2.*- , QuickCheck- , quickcheck-instances , servant , string-conversions , text- , url if !impl(ghc >= 8.0) build-depends:- semigroups >= 0.16 && < 0.19+ semigroups + -- Additonal dependencies+ build-depends:+ aeson-compat >= 0.3.3 && < 0.4+ , hspec >= 2.4.4 && < 2.5+ , QuickCheck >= 2.10.1 && < 2.12+ , quickcheck-instances >= 0.3.16 && < 0.4++ build-tool-depends:+ hspec-discover:hspec-discover >= 2.4.4 && < 2.5+ test-suite doctests- build-depends: base- , servant- , doctest- , filemanip- , directory- , filepath- , hspec- type: exitcode-stdio-1.0- main-is: test/doctests.hs- buildable: True- default-language: Haskell2010- ghc-options: -Wall -threaded- if impl(ghc >= 8.2)- x-doctest-options: -fdiagnostics-color=never- include-dirs: include- x-doctest-source-dirs: test- x-doctest-modules: Servant.Utils.LinksSpec+ build-depends:+ base+ , servant+ , doctest >= 0.13.0 && <0.14++ -- We test Links failure with doctest, so we need extra dependencies+ build-depends:+ hspec >= 2.4.4 && < 2.5++ type: exitcode-stdio-1.0+ main-is: test/doctests.hs+ buildable: True+ default-language: Haskell2010+ ghc-options: -Wall -threaded+ if impl(ghc >= 8.2)+ x-doctest-options: -fdiagnostics-color=never+ include-dirs: include+ x-doctest-source-dirs: test+ x-doctest-modules: Servant.Utils.LinksSpec
src/Servant/API.hs view
@@ -7,6 +7,8 @@ -- | Type-level combinator for alternative endpoints: @':<|>'@ module Servant.API.Empty, -- | Type-level combinator for an empty API: @'EmptyAPI'@+ module Servant.API.Modifiers,+ -- | Type-level modifiers for 'QueryParam', 'Header' and 'ReqBody'. -- * Accessing information from the request module Servant.API.Capture,@@ -31,6 +33,9 @@ -- * Actual endpoints, distinguished by HTTP method module Servant.API.Verbs, + -- * Streaming endpoints, distinguished by HTTP method+ module Servant.API.Stream,+ -- * Authentication module Servant.API.BasicAuth, @@ -61,11 +66,15 @@ -- * Utilities module Servant.Utils.Links, -- | Type-safe internal URIs+ + -- * Re-exports+ If,+ SBool (..), SBoolI (..) ) where import Servant.API.Alternative ((:<|>) (..)) import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))-import Servant.API.Capture (Capture, CaptureAll)+import Servant.API.Capture (Capture, Capture', CaptureAll) import Servant.API.ContentTypes (Accept (..), FormUrlEncoded, JSON, MimeRender (..), NoContent (NoContent),@@ -74,19 +83,29 @@ import Servant.API.Description (Description, Summary) import Servant.API.Empty (EmptyAPI (..)) import Servant.API.Experimental.Auth (AuthProtect)-import Servant.API.Header (Header (..))+import Servant.API.Header (Header, Header') import Servant.API.HttpVersion (HttpVersion (..)) import Servant.API.IsSecure (IsSecure (..))-import Servant.API.QueryParam (QueryFlag, QueryParam,+import Servant.API.Modifiers (Required, Optional, Lenient, Strict)+import Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam', QueryParams) import Servant.API.Raw (Raw)+import Servant.API.Stream (Stream, StreamGet, StreamPost,+ StreamGenerator (..),+ ToStreamGenerator (..),+ ResultStream(..), BuildFromStream (..),+ ByteStringParser (..),+ FramingRender (..), BoundaryStrategy (..),+ FramingUnrender (..),+ NewlineFraming,+ NetstringFraming) import Servant.API.RemoteHost (RemoteHost)-import Servant.API.ReqBody (ReqBody)+import Servant.API.ReqBody (ReqBody, ReqBody') import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader, BuildHeadersTo (buildHeadersTo), GetHeaders (getHeaders), HList (..), Headers (..),- getHeadersHList, getResponse)+ getHeadersHList, getResponse, ResponseHeader (..)) import Servant.API.Sub ((:>)) import Servant.API.Vault (Vault) import Servant.API.Verbs (PostCreated, Delete, DeleteAccepted,@@ -112,3 +131,6 @@ URI (..), safeLink) import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))++import Data.Type.Bool (If)+import Data.Singletons.Bool (SBool (..), SBoolI (..))
src/Servant/API/Capture.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-}-module Servant.API.Capture (Capture, CaptureAll) where+module Servant.API.Capture (Capture, Capture', CaptureAll) where import Data.Typeable (Typeable) import GHC.TypeLits (Symbol)@@ -12,9 +12,11 @@ -- -- >>> -- GET /books/:isbn -- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book-data Capture (sym :: Symbol) a- deriving (Typeable)+type Capture = Capture' '[] -- todo +-- | 'Capture' which can be modified. For example with 'Description'.+data Capture' (mods :: [*]) (sym :: Symbol) (a :: *)+ deriving (Typeable) -- | Capture all remaining values from the request path under a certain type -- @a@.@@ -23,7 +25,7 @@ -- -- >>> -- GET /src/* -- >>> type MyAPI = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile-data CaptureAll (sym :: Symbol) a+data CaptureAll (sym :: Symbol) (a :: *) deriving (Typeable) -- $setup
src/Servant/API/ContentTypes.hs view
@@ -282,7 +282,7 @@ , AllMimeRender (ctyp' ': ctyps) a ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where allMimeRender _ a =- (map (, bs) $ NE.toList $ contentTypes pctyp)+ map (, bs) (NE.toList $ contentTypes pctyp) ++ allMimeRender pctyps a where bs = mimeRender pctyp a@@ -317,10 +317,10 @@ , AllMimeUnrender ctyps a ) => AllMimeUnrender (ctyp ': ctyps) a where allMimeUnrender _ =- (map mk $ NE.toList $ contentTypes pctyp)+ map mk (NE.toList $ contentTypes pctyp) ++ allMimeUnrender pctyps where- mk ct = (ct, \bs -> mimeUnrenderWithType pctyp ct bs)+ mk ct = (ct, mimeUnrenderWithType pctyp ct) pctyp = Proxy :: Proxy ctyp pctyps = Proxy :: Proxy ctyps
src/Servant/API/Description.hs view
@@ -1,11 +1,25 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_HADDOCK not-home #-}-module Servant.API.Description (Description, Summary) where+module Servant.API.Description (+ -- * Combinators+ Description,+ Summary,+ -- * Used as modifiers+ FoldDescription,+ FoldDescription',+ reflectDescription,+ ) where import Data.Typeable (Typeable)-import GHC.TypeLits (Symbol)+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)+import Data.Proxy (Proxy (..))+ -- | Add a short summary for (part of) API. -- -- Example:@@ -28,6 +42,32 @@ -- :} data Description (sym :: Symbol) deriving (Typeable)++-- | Fold modifier list to decide whether argument should be parsed strictly or leniently.+--+-- >>> :kind! FoldDescription '[]+-- FoldDescription '[] :: Symbol+-- = ""+--+-- >>> :kind! FoldDescription '[Required, Description "foobar", Lenient]+-- FoldDescription '[Required, Description "foobar", Lenient] :: Symbol+-- = "foobar"+--+type FoldDescription mods = FoldDescription' "" mods++-- | Implementation of 'FoldDescription'.+type family FoldDescription' (acc :: Symbol) (mods :: [*]) :: Symbol where+ FoldDescription' acc '[] = acc+ FoldDescription' acc (Description desc ': mods) = FoldDescription' desc mods+ FoldDescription' acc (mod ': mods) = FoldDescription' acc mods++-- | Reflect description to the term level.+--+-- >>> reflectDescription (Proxy :: Proxy '[Required, Description "foobar", Lenient])+-- "foobar"+--+reflectDescription :: forall mods. KnownSymbol (FoldDescription mods) => Proxy mods -> String+reflectDescription _ = symbolVal (Proxy :: Proxy (FoldDescription mods)) -- $setup -- >>> import Servant.API
src/Servant/API/Header.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Header (- Header(..),-) where+ Header, Header',+ ) where -import Data.ByteString (ByteString) import Data.Typeable (Typeable) import GHC.TypeLits (Symbol)+import Servant.API.Modifiers+ -- | Extract the given header's value as a value of type @a@.+-- I.e. header sent by client, parsed by server. -- -- Example: --@@ -18,10 +19,10 @@ -- >>> -- >>> -- GET /view-my-referer -- >>> type MyApi = "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer-data Header (sym :: Symbol) a = Header a- | MissingHeader- | UndecodableHeader ByteString- deriving (Typeable, Eq, Show, Functor)+type Header = Header' '[Optional, Strict]++data Header' (mods :: [*]) (sym :: Symbol) a+ deriving Typeable -- $setup -- >>> import Servant.API
src/Servant/API/Internal/Test/ComprehensiveAPI.hs view
@@ -22,15 +22,18 @@ type ComprehensiveAPIWithoutRaw = GET :<|> Get '[JSON] Int :<|>- Capture "foo" Int :> GET :<|>+ Capture' '[Description "example description"] "foo" Int :> GET :<|> Header "foo" Int :> GET :<|>+ Header' '[Required, Lenient] "bar" Int :> GET :<|> HttpVersion :> GET :<|> IsSecure :> GET :<|> QueryParam "foo" Int :> GET :<|>+ QueryParam' '[Required, Lenient] "bar" Int :> GET :<|> QueryParams "foo" Int :> GET :<|> QueryFlag "foo" :> GET :<|> RemoteHost :> GET :<|> ReqBody '[JSON] Int :> GET :<|>+ ReqBody' '[Lenient] '[JSON] Int :> GET :<|> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|> "foo" :> GET :<|> Vault :> GET :<|>
+ src/Servant/API/Modifiers.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Servant.API.Modifiers (+ -- * Required / optional argument+ Required, Optional,+ FoldRequired, FoldRequired',+ -- * Lenient / strict parsing+ Lenient, Strict,+ FoldLenient, FoldLenient',+ -- * Utilities+ RequiredArgument,+ foldRequiredArgument,+ unfoldRequiredArgument,+ RequestArgument,+ unfoldRequestArgument,+ ) where++import Data.Proxy (Proxy (..))+import Data.Singletons.Bool (SBool (..), SBoolI (..))+import Data.Text (Text)+import Data.Type.Bool (If)++-- | Required argument. Not wrapped.+data Required++-- | Optional argument. Wrapped in 'Maybe'.+data Optional++-- | Fold modifier list to decide whether argument is required.+--+-- >>> :kind! FoldRequired '[Required, Description "something"]+-- FoldRequired '[Required, Description "something"] :: Bool+-- = 'True+--+-- >>> :kind! FoldRequired '[Required, Optional]+-- FoldRequired '[Required, Optional] :: Bool+-- = 'False+--+-- >>> :kind! FoldRequired '[]+-- FoldRequired '[] :: Bool+-- = 'False+--+type FoldRequired mods = FoldRequired' 'False mods++-- | Implementation of 'FoldRequired'.+type family FoldRequired' (acc :: Bool) (mods :: [*]) :: Bool where+ FoldRequired' acc '[] = acc+ FoldRequired' acc (Required ': mods) = FoldRequired' 'True mods+ FoldRequired' acc (Optional ': mods) = FoldRequired' 'False mods+ FoldRequired' acc (mod ': mods) = FoldRequired' acc mods++-- | Leniently parsed argument, i.e. parsing never fail. Wrapped in @'Either' 'Text'@.+data Lenient++-- | Strictly parsed argument. Not wrapped.+data Strict++-- | Fold modifier list to decide whether argument should be parsed strictly or leniently.+--+-- >>> :kind! FoldLenient '[]+-- FoldLenient '[] :: Bool+-- = 'False+--+type FoldLenient mods = FoldLenient' 'False mods++-- | Implementation of 'FoldLenient'.+type family FoldLenient' (acc :: Bool) (mods :: [*]) :: Bool where+ FoldLenient' acc '[] = acc+ FoldLenient' acc (Lenient ': mods) = FoldLenient' 'True mods+ FoldLenient' acc (Strict ': mods) = FoldLenient' 'False mods+ FoldLenient' acc (mod ': mods) = FoldLenient' acc mods++-- | Helper type alias.+--+-- * 'Required' ↦ @a@+--+-- * 'Optional' ↦ @'Maybe' a@+--+type RequiredArgument mods a = If (FoldRequired mods) a (Maybe a)++-- | Fold a 'RequiredAgument' into a value+foldRequiredArgument+ :: forall mods a r. (SBoolI (FoldRequired mods))+ => Proxy mods+ -> (a -> r) -- ^ 'Required'+ -> (Maybe a -> r) -- ^ 'Optional'+ -> RequiredArgument mods a+ -> r+foldRequiredArgument _ f g mx =+ case (sbool :: SBool (FoldRequired mods), mx) of+ (STrue, x) -> f x+ (SFalse, x) -> g x++-- | Unfold a value into a 'RequiredArgument'.+unfoldRequiredArgument+ :: forall mods m a. (Monad m, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods))+ => Proxy mods+ -> m (RequiredArgument mods a) -- ^ error when argument is required+ -> (Text -> m (RequiredArgument mods a)) -- ^ error when argument is strictly parsed+ -> Maybe (Either Text a) -- ^ value+ -> m (RequiredArgument mods a)+unfoldRequiredArgument _ errReq errSt mex =+ case (sbool :: SBool (FoldRequired mods), mex) of+ (STrue, Nothing) -> errReq+ (SFalse, Nothing) -> return Nothing+ (STrue, Just ex) -> either errSt return ex+ (SFalse, Just ex) -> either errSt (return . Just) ex++-- | Helper type alias.+--+-- By default argument is 'Optional' and 'Strict'.+--+-- * 'Required', 'Strict' ↦ @a@+--+-- * 'Required', 'Lenient' ↦ @'Either' 'Text' a@+--+-- * 'Optional', 'Strict' ↦ @'Maybe' a@+--+-- * 'Optional', 'Lenient' ↦ @'Maybe' ('Either' 'Text' a)@+--+type RequestArgument mods a =+ If (FoldRequired mods)+ (If (FoldLenient mods) (Either Text a) a)+ (Maybe (If (FoldLenient mods) (Either Text a) a))++++-- | Unfold a value into a 'RequestArgument'.+unfoldRequestArgument+ :: forall mods m a. (Monad m, SBoolI (FoldRequired mods), SBoolI (FoldLenient mods))+ => Proxy mods+ -> m (RequestArgument mods a) -- ^ error when argument is required+ -> (Text -> m (RequestArgument mods a)) -- ^ error when argument is strictly parsed+ -> Maybe (Either Text a) -- ^ value+ -> m (RequestArgument mods a)+unfoldRequestArgument _ errReq errSt mex =+ case (sbool :: SBool (FoldRequired mods), mex, sbool :: SBool (FoldLenient mods)) of+ (STrue, Nothing, _) -> errReq+ (SFalse, Nothing, _) -> return Nothing+ (STrue, Just ex, STrue) -> return ex+ (STrue, Just ex, SFalse) -> either errSt return ex+ (SFalse, Just ex, STrue) -> return (Just ex)+ (SFalse, Just ex, SFalse) -> either errSt (return . Just) ex++-- $setup+-- >>> import Servant.API
src/Servant/API/QueryParam.hs view
@@ -3,10 +3,12 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-}-module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParams) where+module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam', QueryParams) where import Data.Typeable (Typeable) import GHC.TypeLits (Symbol)+import Servant.API.Modifiers+ -- | Lookup the value associated to the @sym@ query string parameter -- and try to extract it as a value of type @a@. --@@ -14,7 +16,10 @@ -- -- >>> -- /books?author=<author name> -- >>> type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]-data QueryParam (sym :: Symbol) a+type QueryParam = QueryParam' '[Optional, Strict]++-- | 'QueryParam' which can be 'Required', 'Lenient', or modified otherwise.+data QueryParam' (mods :: [*]) (sym :: Symbol) (a :: *) deriving Typeable -- | Lookup the values associated to the @sym@ query string parameter@@ -28,7 +33,7 @@ -- -- >>> -- /books?authors[]=<author1>&authors[]=<author2>&... -- >>> type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]-data QueryParams (sym :: Symbol) a+data QueryParams (sym :: Symbol) (a :: *) deriving Typeable -- | Lookup a potentially value-less query string parameter
src/Servant/API/ReqBody.hs view
@@ -2,16 +2,25 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-}-module Servant.API.ReqBody where+module Servant.API.ReqBody (+ ReqBody, ReqBody',+ ) where -import Data.Typeable (Typeable)+import Data.Typeable (Typeable)+import Servant.API.Modifiers+ -- | Extract the request body as a value of type @a@. -- -- Example: -- -- >>> -- POST /books -- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book-data ReqBody (contentTypes :: [*]) a+type ReqBody = ReqBody' '[Required, Strict]++-- | +--+-- /Note:/ 'ReqBody'' is always 'Required'.+data ReqBody' (mods :: [*]) (contentTypes :: [*]) (a :: *) deriving (Typeable) -- $setup
src/Servant/API/ResponseHeaders.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -23,6 +24,7 @@ -- example above). module Servant.API.ResponseHeaders ( Headers(..)+ , ResponseHeader (..) , AddHeader , addHeader , noHeader@@ -32,15 +34,16 @@ , HList(..) ) where -import Data.ByteString.Char8 as BS (pack, unlines, init)+import Data.ByteString.Char8 as BS (ByteString, pack, unlines, init)+import Data.Typeable (Typeable) import Web.HttpApiData (ToHttpApiData, toHeader, FromHttpApiData, parseHeader) import qualified Data.CaseInsensitive as CI import Data.Proxy-import GHC.TypeLits (KnownSymbol, symbolVal)+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import qualified Network.HTTP.Types.Header as HTTP -import Servant.API.Header (Header (..))+import Servant.API.Header (Header) import Prelude () import Prelude.Compat @@ -52,13 +55,19 @@ -- ^ HList of headers. } deriving (Functor) +data ResponseHeader (sym :: Symbol) a+ = Header a+ | MissingHeader+ | UndecodableHeader ByteString+ deriving (Typeable, Eq, Show, Functor)+ data HList a where HNil :: HList '[]- HCons :: Header h x -> HList xs -> HList (Header h x ': xs)+ HCons :: ResponseHeader h x -> HList xs -> HList (Header h x ': xs) type family HeaderValMap (f :: * -> *) (xs :: [*]) where HeaderValMap f '[] = '[]- HeaderValMap f (Header h x ': xs) = Header h (f x) ': (HeaderValMap f xs)+ HeaderValMap f (Header h x ': xs) = Header h (f x) ': HeaderValMap f xs class BuildHeadersTo hs where@@ -71,7 +80,7 @@ buildHeadersTo _ = HNil instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )- => BuildHeadersTo ((Header h v) ': xs) where+ => BuildHeadersTo (Header h v ': xs) where buildHeadersTo headers = let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h) matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers@@ -110,7 +119,7 @@ -- We need all these fundeps to save type inference class AddHeader h v orig new | h v orig -> new, new -> h, new -> v, new -> orig where- addOptionalHeader :: Header h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times+ addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )
+ src/Servant/API/Stream.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_HADDOCK not-home #-}++module Servant.API.Stream where++import Data.ByteString.Lazy (ByteString, empty)+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.Monoid ((<>))+import Data.Proxy (Proxy)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import Text.Read (readMaybe)+import Control.Arrow (first)+import Network.HTTP.Types.Method (StdMethod (..))++-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Steam endpoints always return response code 200 on success. Type synonyms are provided for standard methods.+data Stream (method :: k1) (framing :: *) (contentType :: *) (a :: *)+ deriving (Typeable, Generic)++type StreamGet = Stream 'GET+type StreamPost = Stream 'POST++-- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).+newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}++-- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints.+class ToStreamGenerator f a where+ toStreamGenerator :: f a -> StreamGenerator a++instance ToStreamGenerator StreamGenerator a+ where toStreamGenerator x = x++-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.+newtype ResultStream a = ResultStream (forall b. (IO (Maybe (Either String a)) -> IO b) -> IO b)++-- | BuildFromStream is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly on the client side for talking to streaming endpoints.+class BuildFromStream a b where+ buildFromStream :: ResultStream a -> b++instance BuildFromStream a (ResultStream a)+ where buildFromStream x = x++-- | The FramingRender class provides the logic for emitting a framing strategy. The strategy emits a header, followed by boundary-delimited data, and finally a termination character. For many strategies, some of these will just be empty bytestrings.+class FramingRender strategy a where+ header :: Proxy strategy -> Proxy a -> ByteString+ boundary :: Proxy strategy -> Proxy a -> BoundaryStrategy+ trailer :: Proxy strategy -> Proxy a -> ByteString++-- | The bracketing strategy generates things to precede and follow the content, as with netstrings.+-- The intersperse strategy inserts seperators between things, as with newline framing.+-- Finally, the general strategy performs an arbitrary rewrite on the content, to allow escaping rules and such.+data BoundaryStrategy = BoundaryStrategyBracket (ByteString -> (ByteString,ByteString))+ | BoundaryStrategyIntersperse ByteString+ | BoundaryStrategyGeneral (ByteString -> ByteString)++-- | A type of parser that can never fail, and has different parsing strategies (incremental, or EOF) depending if more input can be sent. The incremental parser should return `Nothing` if it would like to be sent a longer ByteString. If it returns a value, it also returns the remainder following that value.+data ByteStringParser a = ByteStringParser {+ parseIncremental :: ByteString -> Maybe (a, ByteString),+ parseEOF :: ByteString -> (a, ByteString)+}++-- | The FramingUnrender class provides the logic for parsing a framing strategy. The outer @ByteStringParser@ strips the header from a stream of bytes, and yields a parser that can handle the remainder, stepwise. Each frame may be a ByteString, or a String indicating the error state for that frame. Such states are per-frame, so that protocols that can resume after errors are able to do so. Eventually this returns an empty ByteString to indicate termination.+class FramingUnrender strategy a where+ unrenderFrames :: Proxy strategy -> Proxy a -> ByteStringParser (ByteStringParser (Either String ByteString))+++-- | A simple framing strategy that has no header or termination, and inserts a newline character between each frame.+-- This assumes that it is used with a Content-Type that encodes without newlines (e.g. JSON).+data NewlineFraming++instance FramingRender NewlineFraming a where+ header _ _ = empty+ boundary _ _ = BoundaryStrategyIntersperse "\n"+ trailer _ _ = empty++instance FramingUnrender NewlineFraming a where+ unrenderFrames _ _ = ByteStringParser (Just . (go,)) (go,)+ where go = ByteStringParser+ (\x -> case LB.break (== '\n') x of+ (h,r) -> if not (LB.null r) then Just (Right h, LB.drop 1 r) else Nothing+ )+ (\x -> case LB.break (== '\n') x of+ (h,r) -> (Right h, LB.drop 1 r)+ )+-- | The netstring framing strategy as defined by djb: <http://cr.yp.to/proto/netstrings.txt>+data NetstringFraming++instance FramingRender NetstringFraming a where+ header _ _ = empty+ boundary _ _ = BoundaryStrategyBracket $ \b -> ((<> ":") . LB.pack . show . LB.length $ b, ",")+ trailer _ _ = empty+++instance FramingUnrender NetstringFraming a where+ unrenderFrames _ _ = ByteStringParser (Just . (go,)) (go,)+ where go = ByteStringParser+ (\b -> let (i,r) = LB.break (==':') b+ in case readMaybe (LB.unpack i) of+ Just len -> if LB.length r > len+ then Just . first Right . fmap (LB.drop 1) $ LB.splitAt len . LB.drop 1 $ r+ else Nothing+ Nothing -> Just (Left ("Bad netstring frame, couldn't parse value as integer value: " ++ LB.unpack i), LB.drop 1 . LB.dropWhile (/= ',') $ r))+ (\b -> let (i,r) = LB.break (==':') b+ in case readMaybe (LB.unpack i) of+ Just len -> if LB.length r > len+ then first Right . fmap (LB.drop 1) $ LB.splitAt len . LB.drop 1 $ r+ else (Right $ LB.take len r, LB.empty)+ Nothing -> (Left ("Bad netstring frame, couldn't parse value as integer value: " ++ LB.unpack i), LB.drop 1 . LB.dropWhile (/= ',') $ r))
src/Servant/API/Sub.hs view
@@ -14,7 +14,7 @@ -- >>> -- GET /hello/world -- >>> -- returning a JSON encoded World value -- >>> type MyApi = "hello" :> "world" :> Get '[JSON] World-data (path :: k) :> a+data (path :: k) :> (a :: *) deriving (Typeable) infixr 4 :>
src/Servant/API/Verbs.hs view
@@ -23,7 +23,7 @@ -- provided, but you are free to define your own: -- -- >>> type Post204 contentTypes a = Verb 'POST 204 contentTypes a-data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) a+data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) (a :: *) deriving (Typeable, Generic) -- * 200 responses
src/Servant/Utils/Enter.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}
src/Servant/Utils/Links.hs view
@@ -1,11 +1,13 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-} -- | Type safe generation of internal links.@@ -101,8 +103,10 @@ import Data.List import Data.Monoid.Compat ( (<>) ) import Data.Proxy ( Proxy(..) )+import Data.Singletons.Bool ( SBool (..), SBoolI (..) ) import qualified Data.Text as Text import qualified Data.Text.Encoding as TE+import Data.Type.Bool (If) import GHC.TypeLits ( KnownSymbol, symbolVal ) import Network.URI ( URI(..), escapeURIString, isUnreserved ) import Prelude ()@@ -111,15 +115,23 @@ import Web.HttpApiData import Servant.API.Alternative ( (:<|>)((:<|>)) ) import Servant.API.BasicAuth ( BasicAuth )-import Servant.API.Capture ( Capture, CaptureAll )-import Servant.API.ReqBody ( ReqBody )-import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )-import Servant.API.Header ( Header )+import Servant.API.Capture ( Capture', CaptureAll )+import Servant.API.ReqBody ( ReqBody' )+import Servant.API.QueryParam ( QueryParam', QueryParams, QueryFlag )+import Servant.API.Header ( Header' )+import Servant.API.HttpVersion (HttpVersion) import Servant.API.RemoteHost ( RemoteHost )+import Servant.API.IsSecure (IsSecure)+import Servant.API.Empty (EmptyAPI (..)) import Servant.API.Verbs ( Verb ) import Servant.API.Sub ( type (:>) ) import Servant.API.Raw ( Raw )+import Servant.API.Stream ( Stream ) import Servant.API.TypeLevel+import Servant.API.Modifiers (FoldRequired)+import Servant.API.Description (Description, Summary)+import Servant.API.Vault (Vault)+import Servant.API.WithNamedContext (WithNamedContext) import Servant.API.Experimental.Auth ( AuthProtect ) -- | A safe link datatype.@@ -281,14 +293,15 @@ where seg = symbolVal (Proxy :: Proxy sym) - -- QueryParam instances-instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)- => HasLink (QueryParam sym v :> sub) where- type MkLink (QueryParam sym v :> sub) = Maybe v -> MkLink sub+instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))+ => HasLink (QueryParam' mods sym v :> sub) where+ type MkLink (QueryParam' mods sym v :> sub) = If (FoldRequired mods) v (Maybe v) -> MkLink sub toLink _ l mv = toLink (Proxy :: Proxy sub) $- maybe id (addQueryParam . SingleParam k . toQueryParam) mv l+ case sbool :: SBool (FoldRequired mods) of+ STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l+ SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l where k :: String k = symbolVal (Proxy :: Proxy sym)@@ -318,13 +331,13 @@ toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l -- Misc instances-instance HasLink sub => HasLink (ReqBody ct a :> sub) where- type MkLink (ReqBody ct a :> sub) = MkLink sub+instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where+ type MkLink (ReqBody' mods ct a :> sub) = MkLink sub toLink _ = toLink (Proxy :: Proxy sub) instance (ToHttpApiData v, HasLink sub)- => HasLink (Capture sym v :> sub) where- type MkLink (Capture sym v :> sub) = v -> MkLink sub+ => HasLink (Capture' mods sym v :> sub) where+ type MkLink (Capture' mods sym v :> sub) = v -> MkLink sub toLink _ l v = toLink (Proxy :: Proxy sub) $ addSegment (escaped . Text.unpack $ toUrlPiece v) l@@ -336,10 +349,34 @@ toLink (Proxy :: Proxy sub) $ foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs -instance HasLink sub => HasLink (Header sym a :> sub) where- type MkLink (Header sym a :> sub) = MkLink sub+instance HasLink sub => HasLink (Header' mods sym a :> sub) where+ type MkLink (Header' mods sym a :> sub) = MkLink sub toLink _ = toLink (Proxy :: Proxy sub) +instance HasLink sub => HasLink (Vault :> sub) where+ type MkLink (Vault :> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance HasLink sub => HasLink (Description s :> sub) where+ type MkLink (Description s :> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance HasLink sub => HasLink (Summary s :> sub) where+ type MkLink (Summary s :> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance HasLink sub => HasLink (HttpVersion :> sub) where+ type MkLink (HttpVersion:> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance HasLink sub => HasLink (IsSecure :> sub) where+ type MkLink (IsSecure :> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance HasLink sub => HasLink (WithNamedContext name context sub) where+ type MkLink (WithNamedContext name context sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)+ instance HasLink sub => HasLink (RemoteHost :> sub) where type MkLink (RemoteHost :> sub) = MkLink sub toLink _ = toLink (Proxy :: Proxy sub)@@ -348,6 +385,10 @@ type MkLink (BasicAuth realm a :> sub) = MkLink sub toLink _ = toLink (Proxy :: Proxy sub) +instance HasLink EmptyAPI where+ type MkLink EmptyAPI = EmptyAPI+ toLink _ _ = EmptyAPI+ -- Verb (terminal) instances instance HasLink (Verb m s ct a) where type MkLink (Verb m s ct a) = Link@@ -355,6 +396,10 @@ instance HasLink Raw where type MkLink Raw = Link+ toLink _ = id++instance HasLink (Stream m fr ct a) where+ type MkLink (Stream m fr ct a) = Link toLink _ = id -- AuthProtext instances
test/Servant/Utils/LinksSpec.hs view
@@ -1,8 +1,12 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-}+#if __GLASGOW_HASKELL__ < 709+{-# OPTIONS_GHC -fcontext-stack=41 #-}+#endif module Servant.Utils.LinksSpec where import Data.Proxy (Proxy (..))@@ -11,11 +15,13 @@ import Data.String (fromString) import Servant.API-import Servant.Utils.Links (allLinks)+import Servant.Utils.Links (allLinks, linkURI)+import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw) type TestApi = -- Capture and query params "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent+ :<|> "hi" :> Capture "name" String :> QueryParam' '[Required] "capital" Bool :> Delete '[JSON] NoContent :<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent -- Flags@@ -24,7 +30,7 @@ -- All of the verbs :<|> "get" :> Get '[JSON] NoContent :<|> "put" :> Put '[JSON] NoContent- :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] NoContent+ :<|> "post" :> ReqBody '[JSON] Bool :> Post '[JSON] NoContent :<|> "delete" :> Header "ponies" String :> Delete '[JSON] NoContent :<|> "raw" :> Raw :<|> NoEndpoint@@ -55,6 +61,11 @@ :> Delete '[JSON] NoContent) apiLink l2 "bye" (Just True) `shouldBeLink` "hello/bye?capital=true" + let l4 = Proxy :: Proxy ("hi" :> Capture "name" String+ :> QueryParam' '[Required] "capital" Bool+ :> Delete '[JSON] NoContent)+ apiLink l4 "privet" False `shouldBeLink` "hi/privet?capital=false"+ it "generates correct links for CaptureAll" $ do apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent)) ["roads", "lead", "to", "rome"]@@ -75,11 +86,12 @@ it "can generate all links for an API that has only linkable endpoints" $ do let (allNames :<|> simple) = allLinks (Proxy :: Proxy LinkableApi)- simple- `shouldBeLink` "get"- allNames ["Seneca", "Aurelius"]- `shouldBeLink` "all/Seneca/Aurelius"+ simple `shouldBeLink` "get"+ allNames ["Seneca", "Aurelius"] `shouldBeLink` "all/Seneca/Aurelius" + it "can generate all links for ComprehensiveAPIWithoutRaw" $ do+ let (firstLink :<|> _) = allLinks comprehensiveAPIWithoutRaw+ firstLink `shouldBeLink` "" -- | -- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,@@ -112,9 +124,9 @@ -- ...Could not deduce... -- ... ----- >>> apiLink (Proxy :: Proxy NoEndpoint)+-- >>> linkURI $ apiLink (Proxy :: Proxy NoEndpoint) -- ...--- ...No instance for...+-- <interactive>... -- ... -- -- sanity check@@ -124,6 +136,6 @@ type WrongReturnType = "get" :> Get '[JSON] Bool type WrongContentType = "get" :> Get '[OctetStream] NoContent type WrongMethod = "get" :> Post '[JSON] NoContent-type NotALink = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool+type NotALink = "hello" :> ReqBody '[JSON] Bool :> Get '[JSON] Bool type AllGood = "get" :> Get '[JSON] NoContent type NoEndpoint = "empty" :> EmptyAPI