2082abf · servant · git.iko.soy

.travis.yml+11−17

@@ -3,33 +3,27 @@ sudo: false

33language: c

44

55env:

6− - GHCVER=7.8.4 CABALVER=1.22

7− - GHCVER=7.10.3 CABALVER=1.22

8− - GHCVER=8.0.1 CABALVER=1.24

6+ - STACK_YAML=stack-ghc-7.8.4.yaml

7+ - STACK_YAML=stack.yaml

8+ - STACK_YAML=stack-ghc-8.0.1.yaml

99

1010addons:

1111 apt:

12− sources:

13− - hvr-ghc

1412 packages:

15− - ghc-7.8.4

16− - ghc-7.10.3

17− - ghc-8.0.1

18− - cabal-install-1.22

19− - cabal-install-1.24

2013 - libgmp-dev

2114

2215install:

23− - (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc)

24− - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

25− - ghc --version

26− - cabal --version

27− - travis_retry cabal update

28− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

16+ - mkdir -p ~/.local/bin

17+ - export PATH=$HOME/.local/bin:$PATH

18+ - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'

19+ - stack --version

20+ - stack setup --no-terminal

21+ - (cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc)

2922

3023script:

31− - ./travis.sh

24+ - if [ "$TRAVIS_EVENT_TYPE" = "cron" ] ; then ./scripts/ci-cron.sh ; else stack test --ghc-options=-Werror --no-terminal ; fi

3225

3326cache:

3427 directories:

3528 - $HOME/.tinc/cache

29+ - $HOME/.stack

CONTRIBUTING.md+2−1

@@ -8,9 +8,10 @@ repository. You can use `cabal`:

88./scripts/test-all.sh # Run all the tests

99```

1010

11−`stack`:

11+Or `stack`:

1212

1313```shell

14+stack setup # Downloads and installs a proper GHC version if necessary

1415stack build # Install and build packages

1516stack test # Run all the tests

1617```

doc/requirements.txt+1−1

@@ -17,7 +17,7 @@ recommonmark==0.4.0

1717singledispatch==3.4.0.3

1818six==1.10.0

1919snowballstemmer==1.2.1

20−Sphinx==1.3.4

20+Sphinx==1.3.6

2121sphinx-autobuild==0.5.2

2222sphinx-rtd-theme==0.1.9

2323tornado==4.3

doc/tutorial/ApiType.lhs+10−2

@@ -58,6 +58,14 @@ Let's break that down:

5858 is equivalent to `/list-all/users`. This means that sometimes `:>` is somehow

5959 equivalent to `/`, but sometimes it just lets you chain another combinator.

6060

61+Tip: If your endpoint responds to `/` (the root path), just omit any combinators

62+that introduce path segments. E.g. the following api has only one endpoint on `/`:

63+

64+``` haskell

65+type RootEndpoint =

66+ Get '[JSON] User

67+```

68+

6169We can also describe APIs with multiple endpoints by using the `:<|>`

6270combinators. Here's an example:

6371

@@ -311,8 +319,8 @@ Which is used like so:

311319

312320``` haskell

313321type ProtectedAPI12

314− = UserAPI -- this is public

315− :<|> BasicAuth "my-real" User :> UserAPI2 -- this is protected by auth

322+ = UserAPI -- this is public

323+ :<|> BasicAuth "my-realm" User :> UserAPI2 -- this is protected by auth

316324```

317325

318326### Interoperability with `wai`: `Raw`

doc/tutorial/Client.lhs+10−17

@@ -15,11 +15,10 @@ need to have some language extensions and imports:

1515

1616module Client where

1717

18−import Control.Monad.Trans.Except (ExceptT, runExceptT)

1918import Data.Aeson

2019import Data.Proxy

2120import GHC.Generics

22−import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)

21+import Network.HTTP.Client (newManager, defaultManagerSettings)

2322import Servant.API

2423import Servant.Client

2524```

@@ -71,19 +70,13 @@ What we are going to get with **servant-client** here is 3 functions, one to que

7170``` haskell

7271position :: Int -- ^ value for "x"

7372 -> Int -- ^ value for "y"

74− -> Manager -- ^ the HTTP client to use

75− -> BaseUrl -- ^ the URL at which the API can be found

76− -> ExceptT ServantError IO Position

73+ -> ClientM Position

7774

7875hello :: Maybe String -- ^ an optional value for "name"

79− -> Manager -- ^ the HTTP client to use

80− -> BaseUrl -- ^ the URL at which the API can be found

81− -> ExceptT ServantError IO HelloMessage

76+ -> ClientM HelloMessage

8277

8378marketing :: ClientInfo -- ^ value for the request body

84− -> Manager -- ^ the HTTP client to use

85− -> BaseUrl -- ^ the URL at which the API can be found

86− -> ExceptT ServantError IO Email

79+ -> ClientM Email

8780```

8881

8982Each function makes available as an argument any value that the response may

@@ -120,17 +113,17 @@ data BaseUrl = BaseUrl

120113That's it. Let's now write some code that uses our client functions.

121114

122115``` haskell

123−queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)

124−queries manager baseurl = do

125− pos <- position 10 10 manager baseurl

126− message <- hello (Just "servant") manager baseurl

127− em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl

116+queries :: ClientM (Position, HelloMessage, Email)

117+queries = do

118+ pos <- position 10 10

119+ message <- hello (Just "servant")

120+ em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])

128121 return (pos, message, em)

129122

130123run :: IO ()

131124run = do

132125 manager <- newManager defaultManagerSettings

133− res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))

126+ res <- runClientM queries (ClientEnv manager (BaseUrl Http "localhost" 8081 ""))

134127 case res of

135128 Left err -> putStrLn $ "Error: " ++ show err

136129 Right (pos, message, em) -> do

doc/tutorial/Javascript.lhs+312−22

@@ -151,21 +151,120 @@ so we need a `Proxy` for our API type `API'` without its `Raw` endpoint.

151151

152152Very similarly to how one can derive haskell functions, we can derive the

153153javascript with just a simple function call to `jsForAPI` from

154−`Servant.JQuery`.

154+`Servant.JS`.

155155

156156``` haskell

157−apiJS :: Text

158−apiJS = jsForAPI api vanillaJS

157+apiJS1 :: Text

158+apiJS1 = jsForAPI api jquery

159159```

160160

161161This `Text` contains 2 Javascript functions, 'getPoint' and 'getBooks':

162162

163163``` javascript

164+

165+var getPoint = function(onSuccess, onError)

166+{

167+ $.ajax(

168+ { url: '/point'

169+ , success: onSuccess

170+ , error: onError

171+ , type: 'GET'

172+ });

173+}

174+

175+var getBooks = function(q, onSuccess, onError)

176+{

177+ $.ajax(

178+ { url: '/books' + '?q=' + encodeURIComponent(q)

179+ , success: onSuccess

180+ , error: onError

181+ , type: 'GET'

182+ });

183+}

184+```

185+

186+We created a directory `static` that contains two static files: `index.html`,

187+which is the entrypoint to our little web application; and `ui.js`, which

188+contains some hand-written javascript. This javascript code assumes the two

189+generated functions `getPoint` and `getBooks` in scope. Therefore we need to

190+write the generated javascript into a file:

191+

192+``` haskell

193+writeJSFiles :: IO ()

194+writeJSFiles = do

195+ T.writeFile "static/api.js" apiJS1

196+ jq <- T.readFile =<< Language.Javascript.JQuery.file

197+ T.writeFile "static/jq.js" jq

198+```

199+

200+(We're also writing the jquery library into a file, as it's also used by

201+`ui.js`.) `static/api.js` will be included in `index.html` and the two

202+generated functions will therefore be available in `ui.js`.

203+

204+And we're good to go. You can start the `main` function of this file and go to

205+`http://localhost:8000/`. Start typing in the name of one of the authors in our

206+database or part of a book title, and check out how long it takes to

207+approximate pi using the method mentioned above.

208+

209+## Customizations

210+

211+Instead of calling `jquery`, you can call its variant `jqueryWith`.

212+Here are the type definitions

213+

214+```haskell ignore

215+jquery :: JavaScriptGenerator

216+jqueryWith :: CommonGeneratorOptions -> JavaScriptGenerator

217+```

218+

219+The `CommonGeneratorOptions` will let you define different behaviors to

220+change how functions are generated. Here is the definition of currently

221+available options:

222+

223+```haskell ignore

224+data CommonGeneratorOptions = CommonGeneratorOptions

225+ {

226+ -- | function generating function names

227+ functionNameBuilder :: FunctionName -> Text

228+ -- | name used when a user want to send the request body (to let you redefine it)

229+ , requestBody :: Text

230+ -- | name of the callback parameter when the request was successful

231+ , successCallback :: Text

232+ -- | name of the callback parameter when the request reported an error

233+ , errorCallback :: Text

234+ -- | namespace on which we define the js function (empty mean local var)

235+ , moduleName :: Text

236+ -- | a prefix that should be prepended to the URL in the generated JS

237+ , urlPrefix :: Text

238+ }

239+```

240+

241+This pattern is available with all supported backends, and default values are provided.

242+

243+## Vanilla support

244+

245+If you don't use JQuery for your application, you can reduce your

246+dependencies to simply use the `XMLHttpRequest` object from the standard API.

247+

248+Use the same code as before but simply replace the previous `apiJS` with

249+the following one:

250+

251+``` haskell

252+apiJS2 :: Text

253+apiJS2 = jsForAPI api vanillaJS

254+```

255+

256+The rest is *completely* unchanged.

257+

258+The output file is a bit different, but it has the same parameters,

259+

260+``` javascript

261+

262+

164263var getPoint = function(onSuccess, onError)

165264{

166265 var xhr = new XMLHttpRequest();

167266 xhr.open('GET', '/point', true);

168− xhr.setRequestHeader("Accept","application/json");

267+ xhr.setRequestHeader(\"Accept\",\"application/json\");

169268 xhr.onreadystatechange = function (e) {

170269 if (xhr.readyState == 4) {

171270 if (xhr.status == 204 || xhr.status == 205) {

@@ -186,7 +285,7 @@ var getBooks = function(q, onSuccess, onError)

186285{

187286 var xhr = new XMLHttpRequest();

188287 xhr.open('GET', '/books' + '?q=' + encodeURIComponent(q), true);

189− xhr.setRequestHeader("Accept","application/json");

288+ xhr.setRequestHeader(\"Accept\",\"application/json\");

190289 xhr.onreadystatechange = function (e) {

191290 if (xhr.readyState == 4) {

192291 if (xhr.status == 204 || xhr.status == 205) {

@@ -202,27 +301,218 @@ var getBooks = function(q, onSuccess, onError)

202301 }

203302 xhr.send(null);

204303}

304+

305+

205306```

206307

207−We created a directory `static` that contains two static files: `index.html`,

208−which is the entrypoint to our little web application; and `ui.js`, which

209−contains some hand-written javascript. This javascript code assumes the two

210−generated functions `getPoint` and `getBooks` in scope. Therefore we need to

211−write the generated javascript into a file:

308+And that's all, your web service can of course be accessible from those

309+two clients at the same time!

310+

311+## Axios support

312+

313+### Simple usage

314+

315+If you use Axios library for your application, we support that too!

316+

317+Use the same code as before but simply replace the previous `apiJS` with

318+the following one:

212319

213320``` haskell

214−writeJSFiles :: IO ()

215−writeJSFiles = do

216− T.writeFile "static/api.js" apiJS

217− jq <- T.readFile =<< Language.Javascript.JQuery.file

218− T.writeFile "static/jq.js" jq

321+apiJS3 :: Text

322+apiJS3 = jsForAPI api $ axios defAxiosOptions

219323```

220324

221−(We're also writing the jquery library into a file, as it's also used by

222−`ui.js`.) `static/api.js` will be included in `index.html` and the two

223−generated functions will therefore be available in `ui.js`.

325+The rest is *completely* unchanged.

326+

327+The output file is a bit different,

328+

329+``` javascript

330+

331+

332+var getPoint = function()

333+{

334+ return axios({ url: '/point'

335+ , method: 'get'

336+ });

337+}

338+

339+

340+

341+var getBooks = function(q)

342+{

343+ return axios({ url: '/books' + '?q=' + encodeURIComponent(q)

344+ , method: 'get'

345+ });

346+}

347+

348+```

349+

350+**Caution:** In order to support the promise style of the API, there are no onSuccess

351+nor onError callback functions.

352+

353+### Defining Axios configuration

354+

355+Axios lets you define a 'configuration' to determine the behavior of the

356+program when the AJAX request is sent.

357+

358+We mapped this into a configuration

359+

360+``` haskell

361+data AxiosOptions = AxiosOptions

362+ { -- | indicates whether or not cross-site Access-Control requests

363+ -- should be made using credentials

364+ withCredentials :: !Bool

365+ -- | the name of the cookie to use as a value for xsrf token

366+ , xsrfCookieName :: !(Maybe Text)

367+ -- | the name of the header to use as a value for xsrf token

368+ , xsrfHeaderName :: !(Maybe Text)

369+ }

370+```

371+

372+## Angular support

373+

374+### Simple usage

375+

376+You can apply the same procedure as with `vanillaJS` and `jquery`, and

377+generate top level functions.

378+

379+The difference is that `angular` Generator always takes an argument.

380+

381+``` haskell

382+apiJS4 :: Text

383+apiJS4 = jsForAPI api $ angular defAngularOptions

384+```

385+

386+The generated code will be a bit different than previous generators. An extra

387+argument `$http` will be added to let Angular magical Dependency Injector

388+operate.

389+

390+**Caution:** In order to support the promise style of the API, there are no onSuccess

391+nor onError callback functions.

392+

393+``` javascript

394+

395+

396+var getPoint = function($http)

397+{

398+ return $http(

399+ { url: '/point'

400+ , method: 'GET'

401+ });

402+}

403+

404+

405+

406+var getBooks = function($http, q)

407+{

408+ return $http(

409+ { url: '/books' + '?q=' + encodeURIComponent(q)

410+ , method: 'GET'

411+ });

412+}

413+

414+```

415+

416+You can then build your controllers easily

417+

418+``` javascript

419+

420+app.controller("MyController", function($http) {

421+ this.getPoint = getPoint($http)

422+ .success(/* Do something */)

423+ .error(/* Report error */);

424+

425+ this.getPoint = getBooks($http, q)

426+ .success(/* Do something */)

427+ .error(/* Report error */);

428+});

429+```

430+

431+### Service generator

432+

433+You can also generate automatically a service to wrap the whole API as

434+a single Angular service:

435+

436+``` javascript

437+app.service('MyService', function($http) {

438+ return ({

439+ postCounter: function()

440+ {

441+ return $http(

442+ { url: '/counter'

443+ , method: 'POST'

444+ });

445+ },

446+ getCounter: function()

447+ {

448+ return $http(

449+ { url: '/books' + '?q=' + encodeURIComponent(q), true);

450+ , method: 'GET'

451+ });

452+ }

453+ });

454+});

455+```

456+

457+To do so, you just have to use an alternate generator.

458+

459+``` haskell

460+apiJS5 :: Text

461+apiJS5 = jsForAPI api $ angularService defAngularOptions

462+```

463+

464+Again, it is possible to customize some portions with the options.

465+

466+``` haskell

467+data AngularOptions = AngularOptions

468+ { -- | When generating code with wrapInService, name of the service to generate, default is 'app'

469+ serviceName :: Text

470+ , -- | beginning of the service definition

471+ prologue :: Text -> Text -> Text

472+ , -- | end of the service definition

473+ epilogue :: Text

474+ }

475+```

476+

477+# Custom function name builder

478+

479+Servant comes with three name builders included:

480+

481+- camelCase (the default)

482+- concatCase

483+- snakeCase

484+

485+Keeping the JQuery as an example, let's see the impact:

486+

487+``` haskell

488+apiJS6 :: Text

489+apiJS6 = jsForAPI api $ jqueryWith defCommonGeneratorOptions { functionNameBuilder= snakeCase }

490+```

491+

492+This `Text` contains 2 Javascript functions:

493+

494+``` javascript

495+

496+

497+var get_point = function(onSuccess, onError)

498+{

499+ $.ajax(

500+ { url: '/point'

501+ , success: onSuccess

502+ , error: onError

503+ , type: 'GET'

504+ });

505+}

506+

507+var get_books = function(q, onSuccess, onError)

508+{

509+ $.ajax(

510+ { url: '/books' + '?q=' + encodeURIComponent(q)

511+ , success: onSuccess

512+ , error: onError

513+ , type: 'GET'

514+ });

515+}

516+

517+```

224518

225−And we're good to go. You can start the `main` function of this file and go to

226−`http://localhost:8000/`. Start typing in the name of one of the authors in our

227−database or part of a book title, and check out how long it takes to

228−approximate pi using the method mentioned above.

doc/tutorial/test/JavascriptSpec.hs+5−2

@@ -15,7 +15,10 @@ spec = do

1515 describe "apiJS" $ do

1616 it "is contained verbatim in Javascript.lhs" $ do

1717 code <- readFile "Javascript.lhs"

18− cs apiJS `shouldSatisfy` (`isInfixOf` code)

18+ cs apiJS1 `shouldSatisfy` (`isInfixOf` code)

19+ cs apiJS3 `shouldSatisfy` (`isInfixOf` code)

20+ cs apiJS4 `shouldSatisfy` (`isInfixOf` code)

21+ cs apiJS6 `shouldSatisfy` (`isInfixOf` code)

1922

2023 describe "writeJSFiles" $ do

2124 it "[not a test] write apiJS to static/api.js" $ do

@@ -24,7 +27,7 @@ spec = do

2427 describe "app" $ with (return app) $ do

2528 context "/api.js" $ do

2629 it "delivers apiJS" $ do

27− get "/api.js" `shouldRespondWith` (fromString (cs apiJS))

30+ get "/api.js" `shouldRespondWith` (fromString (cs apiJS1))

2831

2932 context "/" $ do

3033 it "delivers something" $ do

doc/tutorial/tutorial.cabal+6−6

@@ -1,5 +1,5 @@

11name: tutorial

2−version: 0.8

2+version: 0.9

33synopsis: The servant tutorial

44homepage: http://haskell-servant.readthedocs.org/

55license: BSD3

@@ -25,11 +25,11 @@ library

2525 , directory

2626 , blaze-markup

2727 , containers

28− , servant == 0.8.*

29− , servant-server == 0.8.*

30− , servant-client == 0.8.*

31− , servant-docs == 0.8.*

32− , servant-js == 0.8.*

28+ , servant == 0.9.*

29+ , servant-server == 0.9.*

30+ , servant-client == 0.9.*

31+ , servant-docs == 0.9.*

32+ , servant-js == 0.9.*

3333 , warp

3434 , http-media

3535 , lucid

travis.sh → scripts/ci-cron.shrenamed+8−1

@@ -1,8 +1,15 @@

11#!/usr/bin/env bash

22

3+set -o nounset

34set -o errexit

5+set -o verbose

46

5−for package in $(cat sources.txt) doc/tutorial ; do

7+export PATH=$(stack path --bin-path):$PATH

8+

9+stack install cabal-install

10+cabal update

11+

12+for package in $(cat sources.txt) ; do

613 echo testing $package

714 pushd $package

815 tinc

servant-client/CHANGELOG.md+7

@@ -1,3 +1,10 @@

1+0.9

2+---

3+

4+* BACKWARDS INCOMPATIBLE: `client` now returns a ClientM which is a Reader for

5+ BasicEnv. BasicEnv comprises the HttpManager and BaseUrl that have had to be

6+ passed to each method returned by `client`.

7+

180.7.1

29-----

310

servant-client/servant-client.cabal+9−6

@@ -1,5 +1,5 @@

11name: servant-client

2−version: 0.8

2+version: 0.9

33synopsis: automatical derivation of querying functions for servant webservices

44description:

55 This library lets you derive automatically Haskell functions that

@@ -45,23 +45,24 @@ library

4545 Servant.Client.PerformRequest.GHC

4646 build-depends:

4747 base >= 4.7 && < 4.10

48− , aeson >= 0.7 && < 0.12

48+ , aeson >= 0.7 && < 1.1

4949 , attoparsec >= 0.12 && < 0.14

5050 , base64-bytestring >= 1.0.0.1 && < 1.1

5151 , bytestring >= 0.10 && < 0.11

5252 , exceptions >= 0.8 && < 0.9

53− , http-api-data >= 0.1 && < 0.3

53+ , http-api-data >= 0.3 && < 0.4

5454 , http-client >= 0.4.18.1 && < 0.6

5555 , http-client-tls >= 0.2.2 && < 0.4

5656 , http-media >= 0.6.2 && < 0.7

5757 , http-types >= 0.8.6 && < 0.10

5858 , network-uri >= 2.6 && < 2.7

5959 , safe >= 0.3.9 && < 0.4

60− , servant == 0.8.*

60+ , servant == 0.9.*

6161 , string-conversions >= 0.3 && < 0.5

6262 , text >= 1.2 && < 1.3

6363 , transformers >= 0.3 && < 0.6

6464 , transformers-compat >= 0.4 && < 0.6

65+ , mtl

6566 if impl(ghcjs)

6667 build-depends:

6768 ghcjs-base

@@ -106,14 +107,16 @@ test-suite spec

106107 , bytestring

107108 , deepseq

108109 , hspec >= 2.2.1 && < 2.3

110+ , http-api-data

109111 , http-client

110112 , http-media

111113 , http-types

112114 , HUnit

115+ , mtl

113116 , network >= 2.6

114117 , QuickCheck >= 2.7

115− , servant == 0.8.*

116− , servant-server == 0.8.*

118+ , servant == 0.9.*

119+ , servant-server == 0.9.*

117120 , text

118121 , wai

119122 , warp

servant-client/src/Servant/Client.hs+48−14

@@ -20,6 +20,8 @@ module Servant.Client

2020 , client

2121 , HasClient(..)

2222 , ClientM

23+ , runClientM

24+ , ClientEnv (ClientEnv)

2325 , mkAuthenticateReq

2426 , ServantError(..)

2527 , module Servant.Common.BaseUrl

@@ -34,7 +36,7 @@ import Data.Proxy

3436import Data.String.Conversions

3537import Data.Text (unpack)

3638import GHC.TypeLits

37−import Network.HTTP.Client (Manager, Response)

39+import Network.HTTP.Client (Response)

3840import Network.HTTP.Media

3941import qualified Network.HTTP.Types as H

4042import qualified Network.HTTP.Types.Header as HTTP

@@ -119,21 +121,53 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient api)

119121

120122 where p = unpack (toUrlPiece val)

121123

124+-- | If you use a 'CaptureAll' in one of your endpoints in your API,

125+-- the corresponding querying function will automatically take an

126+-- additional argument of a list of the type specified by your

127+-- 'CaptureAll'. That function will take care of inserting a textual

128+-- representation of this value at the right place in the request

129+-- path.

130+--

131+-- You can control how these values are turned into text by specifying

132+-- a 'ToHttpApiData' instance of your type.

133+--

134+-- Example:

135+--

136+-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile

137+-- >

138+-- > myApi :: Proxy

139+-- > myApi = Proxy

140+--

141+-- > getSourceFile :: [Text] -> Manager -> BaseUrl -> ClientM SourceFile

142+-- > getSourceFile = client myApi

143+-- > -- then you can use "getSourceFile" to query that endpoint

144+instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)

145+ => HasClient (CaptureAll capture a :> sublayout) where

146+

147+ type Client (CaptureAll capture a :> sublayout) =

148+ [a] -> Client sublayout

149+

150+ clientWithRoute Proxy req vals =

151+ clientWithRoute (Proxy :: Proxy sublayout)

152+ (foldl' (flip appendToPath) req ps)

153+

154+ where ps = map (unpack . toUrlPiece) vals

155+

122156instance OVERLAPPABLE_

123157 -- Note [Non-Empty Content Types]

124158 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

125159 ) => HasClient (Verb method status cts' a) where

126− type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a

127− clientWithRoute Proxy req manager baseurl =

128− snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl

160+ type Client (Verb method status cts' a) = ClientM a

161+ clientWithRoute Proxy req = do

162+ snd <$> performRequestCT (Proxy :: Proxy ct) method req

129163 where method = reflectMethod (Proxy :: Proxy method)

130164

131165instance OVERLAPPING_

132166 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where

133167 type Client (Verb method status cts NoContent)

134− = Manager -> BaseUrl -> ClientM NoContent

135− clientWithRoute Proxy req manager baseurl =

136− performRequestNoBody method req manager baseurl >> return NoContent

168+ = ClientM NoContent

169+ clientWithRoute Proxy req = do

170+ performRequestNoBody method req >> return NoContent

137171 where method = reflectMethod (Proxy :: Proxy method)

138172

139173instance OVERLAPPING_

@@ -141,10 +175,10 @@ instance OVERLAPPING_

141175 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)

142176 ) => HasClient (Verb method status cts' (Headers ls a)) where

143177 type Client (Verb method status cts' (Headers ls a))

144− = Manager -> BaseUrl -> ClientM (Headers ls a)

145− clientWithRoute Proxy req manager baseurl = do

178+ = ClientM (Headers ls a)

179+ clientWithRoute Proxy req = do

146180 let method = reflectMethod (Proxy :: Proxy method)

147− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl

181+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req

148182 return $ Headers { getResponse = resp

149183 , getHeadersHList = buildHeadersTo hdrs

150184 }

@@ -153,10 +187,10 @@ instance OVERLAPPING_

153187 ( BuildHeadersTo ls, ReflectMethod method

154188 ) => HasClient (Verb method status cts (Headers ls NoContent)) where

155189 type Client (Verb method status cts (Headers ls NoContent))

156− = Manager -> BaseUrl -> ClientM (Headers ls NoContent)

157− clientWithRoute Proxy req manager baseurl = do

190+ = ClientM (Headers ls NoContent)

191+ clientWithRoute Proxy req = do

158192 let method = reflectMethod (Proxy :: Proxy method)

159− hdrs <- performRequestNoBody method req manager baseurl

193+ hdrs <- performRequestNoBody method req

160194 return $ Headers { getResponse = NoContent

161195 , getHeadersHList = buildHeadersTo hdrs

162196 }

@@ -341,7 +375,7 @@ instance (KnownSymbol sym, HasClient api)

341375-- back the full `Response`.

342376instance HasClient Raw where

343377 type Client Raw

344− = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

378+ = H.Method -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

345379

346380 clientWithRoute :: Proxy Raw -> Req -> Client Raw

347381 clientWithRoute Proxy req httpMethod = do

servant-client/src/Servant/Common/Req.hs+62−29

@@ -1,7 +1,9 @@

11{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveGeneric #-}

23{-# LANGUAGE CPP #-}

34{-# LANGUAGE OverloadedStrings #-}

45{-# LANGUAGE ScopedTypeVariables #-}

6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

57

68#if MIN_VERSION_base(4,9,0)

79{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

@@ -15,14 +17,25 @@ import Control.Applicative

1517import Control.Exception

1618import Control.Monad

1719import Control.Monad.Catch (MonadThrow)

18−import Control.Monad.IO.Class

20+

21+#if MIN_VERSION_mtl(2,2,0)

22+import Control.Monad.Except (MonadError(..))

23+#else

24+import Control.Monad.Error.Class (MonadError(..))

25+#endif

1926import Control.Monad.Trans.Except

27+

28+

29+import GHC.Generics

30+import Control.Monad.IO.Class ()

31+import Control.Monad.Reader

2032import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)

2133import Data.String

2234import Data.String.Conversions

2335import Data.Proxy

2436import Data.Text (Text)

2537import Data.Text.Encoding

38+import Data.Typeable

2639import Network.HTTP.Client hiding (Proxy, path)

2740import Network.HTTP.Media

2841import Network.HTTP.Types

@@ -68,7 +81,7 @@ setRQBody b t req = req { reqBody = Just (b, t) }

6881

6982reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

7083reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

71− setheaders . setAccept . setrqb . setQS <$> parseUrlThrow url

84+ setheaders . setAccept . setrqb . setQS <$> parseRequest url

7285

7386 where url = show $ nullURI { uriScheme = case reqScheme of

7487 Http -> "http:"

@@ -94,8 +107,18 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

94107 | not . null . reqAccept $ req] }

95108 toProperHeader (name, val) =

96109 (fromString name, encodeUtf8 val)

110+

97111#if !MIN_VERSION_http_client(0,4,30)

98− parseUrlThrow = parseUrl

112+-- 'parseRequest' is introduced in http-client-0.4.30

113+-- it differs from 'parseUrl', by not throwing exceptions on non-2xx http statuses

114+--

115+-- See for implementations:

116+-- http://hackage.haskell.org/package/http-client-0.4.30/docs/src/Network-HTTP-Client-Request.html#parseRequest

117+-- http://hackage.haskell.org/package/http-client-0.5.0/docs/src/Network-HTTP-Client-Request.html#parseRequest

118+parseRequest :: MonadThrow m => String -> m Request

119+parseRequest url = liftM disableStatusCheck (parseUrl url)

120+ where

121+ disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }

99122#endif

100123

101124

@@ -104,21 +127,40 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

104127displayHttpRequest :: Method -> String

105128displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

106129

107−type ClientM = ExceptT ServantError IO

130+data ClientEnv

131+ = ClientEnv

132+ { manager :: Manager

133+ , baseUrl :: BaseUrl

134+ }

135+

108136

109−performRequest :: Method -> Req -> Manager -> BaseUrl

137+-- | @ClientM@ is the monad in which client functions run. Contains the

138+-- 'Manager' and 'BaseUrl' used for requests in the reader environment.

139+

140+newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }

141+ deriving ( Functor, Applicative, Monad, MonadIO, Generic

142+ , MonadReader ClientEnv

143+ , MonadError ServantError

144+ )

145+

146+runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

147+runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

148+

149+

150+performRequest :: Method -> Req

110151 -> ClientM ( Int, ByteString, MediaType

111152 , [HTTP.Header], Response ByteString)

112−performRequest reqMethod req manager reqHost = do

153+performRequest reqMethod req = do

154+ m <- asks manager

155+ reqHost <- asks baseUrl

113156 partialRequest <- liftIO $ reqToRequest req reqHost

114157

115− let request = disableStatusCheck $

116− partialRequest { Client.method = reqMethod }

158+ let request = partialRequest { Client.method = reqMethod }

117159

118− eResponse <- liftIO $ performHttpRequest manager request

160+ eResponse <- liftIO $ performHttpRequest m request

119161 case eResponse of

120162 Left err ->

121− throwE . ConnectionError $ SomeException err

163+ throwError . ConnectionError $ SomeException err

122164

123165 Right response -> do

124166 let status = Client.responseStatus response

@@ -128,33 +170,24 @@ performRequest reqMethod req manager reqHost = do

128170 ct <- case lookup "Content-Type" $ Client.responseHeaders response of

129171 Nothing -> pure $ "application"//"octet-stream"

130172 Just t -> case parseAccept t of

131− Nothing -> throwE $ InvalidContentTypeHeader (cs t) body

173+ Nothing -> throwError $ InvalidContentTypeHeader (cs t) body

132174 Just t' -> pure t'

133175 unless (status_code >= 200 && status_code < 300) $

134− throwE $ FailureResponse status ct body

176+ throwError $ FailureResponse status ct body

135177 return (status_code, body, ct, hdrs, response)

136178

137−disableStatusCheck :: Request -> Request

138−#if MIN_VERSION_http_client(0,5,0)

139−disableStatusCheck req = req { checkResponse = \ _req _res -> return () }

140−#else

141−disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing }

142−#endif

143−

144−performRequestCT :: MimeUnrender ct result =>

145− Proxy ct -> Method -> Req -> Manager -> BaseUrl

179+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req

146180 -> ClientM ([HTTP.Header], result)

147−performRequestCT ct reqMethod req manager reqHost = do

181+performRequestCT ct reqMethod req = do

148182 let acceptCT = contentType ct

149183 (_status, respBody, respCT, hdrs, _response) <-

150− performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost

151− unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

184+ performRequest reqMethod (req { reqAccept = [acceptCT] })

185+ unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType respCT respBody

152186 case mimeUnrender ct respBody of

153− Left err -> throwE $ DecodeFailure err respCT respBody

187+ Left err -> throwError $ DecodeFailure err respCT respBody

154188 Right val -> return (hdrs, val)

155189

156−performRequestNoBody :: Method -> Req -> Manager -> BaseUrl

157− -> ClientM [HTTP.Header]

158−performRequestNoBody reqMethod req manager reqHost = do

159− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost

190+performRequestNoBody :: Method -> Req -> ClientM [HTTP.Header]

191+performRequestNoBody reqMethod req = do

192+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req

160193 return hdrs

servant-client/test/Servant/ClientSpec.hs+52−53

@@ -26,14 +26,13 @@ import Prelude ()

2626import Prelude.Compat

2727

2828import Control.Arrow (left)

29−import Control.Monad.Trans.Except (runExceptT, throwE)

29+import Control.Monad.Trans.Except (throwE )

3030import Data.Aeson

3131import qualified Data.ByteString.Lazy as BS

3232import Data.Char (chr, isPrint)

3333import Data.Foldable (forM_)

3434import Data.Monoid hiding (getLast)

3535import Data.Proxy

36−import qualified Data.Text as T

3736import GHC.Generics (Generic)

3837import qualified Network.HTTP.Client as C

3938import Network.HTTP.Media

@@ -46,10 +45,12 @@ import Test.HUnit

4645import Test.Hspec

4746import Test.Hspec.QuickCheck

4847import Test.QuickCheck

48+import Web.FormUrlEncoded (FromForm, ToForm)

4949

5050import Servant.API

5151import Servant.Client

5252import Servant.Client.TestServer

53+import Servant.Client.TestServer.GHC

5354import qualified Servant.Common.Req as SCR

5455import Servant.Server

5556import Servant.Server.Experimental.Auth

@@ -117,19 +118,8 @@ data Person = Person {

117118instance ToJSON Person

118119instance FromJSON Person

119120

120−instance ToFormUrlEncoded Person where

121− toFormUrlEncoded Person{..} =

122− [("name", T.pack name), ("age", T.pack (show age))]

123−

124−lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b

125−lookupEither x xs = do

126− maybe (Left $ "could not find key " <> show x) return $ lookup x xs

127−

128−instance FromFormUrlEncoded Person where

129− fromFormUrlEncoded xs = do

130− n <- lookupEither "name" xs

131− a <- lookupEither "age" xs

132− return $ Person (T.unpack n) (read $ T.unpack a)

121+instance ToForm Person where

122+instance FromForm Person where

133123

134124alice :: Person

135125alice = Person "Alice" 42

@@ -140,6 +130,7 @@ type Api =

140130 "get" :> Get '[JSON] Person

141131 :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent

142132 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person

133+ :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]

143134 :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person

144135 :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person

145136 :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]

@@ -157,24 +148,26 @@ type Api =

157148api :: Proxy Api

158149api = Proxy

159150

160−getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person

161−getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent

162−getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person

163−getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person

164−getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person

165−getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]

166−getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool

167−getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl

151+getGet :: SCR.ClientM Person

152+getDeleteEmpty :: SCR.ClientM NoContent

153+getCapture :: String -> SCR.ClientM Person

154+getCaptureAll :: [String] -> SCR.ClientM [Person]

155+getBody :: Person -> SCR.ClientM Person

156+getQueryParam :: Maybe String -> SCR.ClientM Person

157+getQueryParams :: [String] -> SCR.ClientM [Person]

158+getQueryFlag :: Bool -> SCR.ClientM Bool

159+getRawSuccess :: HTTP.Method

168160 -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)

169−getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl

161+getRawFailure :: HTTP.Method

170162 -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)

171−getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl

163+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

172164 -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])

173−getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)

174−getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent

165+getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)

166+getDeleteContentType :: SCR.ClientM NoContent

175167getGet

176168 :<|> getDeleteEmpty

177169 :<|> getCapture

170+ :<|> getCaptureAll

178171 :<|> getBody

179172 :<|> getQueryParam

180173 :<|> getQueryParams

@@ -190,6 +183,7 @@ server = TestServer "server" $ serve api (

190183 return alice

191184 :<|> return NoContent

192185 :<|> (\ name -> return $ Person name 0)

186+ :<|> (\ names -> return (zipWith Person names [0..]))

193187 :<|> return

194188 :<|> (\ name -> case name of

195189 Just "alice" -> return alice

@@ -275,38 +269,42 @@ sucessSpec :: Spec

275269sucessSpec = around (withTestServer "server") $ do

276270

277271 it "Servant.API.Get" $ \baseUrl -> do

278− (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice

272+ (left show <$> (runClientM getGet (ClientEnv manager baseUrl))) `shouldReturn` Right alice

279273

280274 describe "Servant.API.Delete" $ do

281275 it "allows empty content type" $ \baseUrl -> do

282− (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent

276+ (left show <$> (runClientM getDeleteEmpty (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent

283277

284278 it "allows content type" $ \baseUrl -> do

285− (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent

279+ (left show <$> (runClientM getDeleteContentType (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent

286280

287281 it "Servant.API.Capture" $ \baseUrl -> do

288− (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)

282+ (left show <$> (runClientM (getCapture "Paula") (ClientEnv manager baseUrl))) `shouldReturn` Right (Person "Paula" 0)

283+

284+ it "Servant.API.CaptureAll" $ \baseUrl -> do

285+ let expected = [(Person "Paula" 0), (Person "Peta" 1)]

286+ (left show <$> (runClientM (getCaptureAll ["Paula", "Peta"]) (ClientEnv manager baseUrl))) `shouldReturn` Right expected

289287

290288 it "Servant.API.ReqBody" $ \baseUrl -> do

291289 let p = Person "Clara" 42

292− (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p

290+ (left show <$> runClientM (getBody p) (ClientEnv manager baseUrl)) `shouldReturn` Right p

293291

294292 it "Servant.API.QueryParam" $ \baseUrl -> do

295− left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice

296− Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)

293+ left show <$> runClientM (getQueryParam (Just "alice")) (ClientEnv manager baseUrl) `shouldReturn` Right alice

294+ Left FailureResponse{..} <- runClientM (getQueryParam (Just "bob")) (ClientEnv manager baseUrl)

297295 responseStatus `shouldBe` HTTP.Status 400 "bob not found"

298296

299297 it "Servant.API.QueryParam.QueryParams" $ \baseUrl -> do

300− (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []

301− (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))

298+ (left show <$> runClientM (getQueryParams []) (ClientEnv manager baseUrl)) `shouldReturn` Right []

299+ (left show <$> runClientM (getQueryParams ["alice", "bob"]) (ClientEnv manager baseUrl))

302300 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

303301

304302 context "Servant.API.QueryParam.QueryFlag" $

305303 forM_ [False, True] $ \ flag -> it (show flag) $ \baseUrl -> do

306− (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag

304+ (left show <$> runClientM (getQueryFlag flag) (ClientEnv manager baseUrl)) `shouldReturn` Right flag

307305

308306 it "Servant.API.Raw on success" $ \baseUrl -> do

309− res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)

307+ res <- runClientM (getRawSuccess HTTP.methodGet) (ClientEnv manager baseUrl)

310308 case res of

311309 Left e -> assertFailure $ show e

312310 Right (code, body, ct, _, response) -> do

@@ -315,7 +313,7 @@ sucessSpec = around (withTestServer "server") $ do

315313 C.responseStatus response `shouldBe` HTTP.ok200

316314

317315 it "Servant.API.Raw should return a Left in case of failure" $ \baseUrl -> do

318− res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)

316+ res <- runClientM (getRawFailure HTTP.methodGet) (ClientEnv manager baseUrl)

319317 case res of

320318 Right _ -> assertFailure "expected Left, but got Right"

321319 Left e -> do

@@ -323,7 +321,7 @@ sucessSpec = around (withTestServer "server") $ do

323321 Servant.Client.responseBody e `shouldBe` "rawFailure"

324322

325323 it "Returns headers appropriately" $ \baseUrl -> do

326− res <- runExceptT (getRespHeaders manager baseUrl)

324+ res <- runClientM getRespHeaders (ClientEnv manager baseUrl)

327325 case res of

328326 Left e -> assertFailure $ show e

329327 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

@@ -332,7 +330,7 @@ sucessSpec = around (withTestServer "server") $ do

332330 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \baseUrl ->

333331 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->

334332 ioProperty $ do

335− result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)

333+ result <- left show <$> runClientM (getMultiple cap num flag body) (ClientEnv manager baseUrl)

336334 return $

337335 result === Right (cap, num, flag, body)

338336

@@ -358,9 +356,9 @@ errorSpec =

358356 it "reports error statuses correctly" $ \baseUrl -> do

359357 let delete :<|> get :<|> post :<|> put =

360358 client errorApi

361− actions = map (\ f -> f manager baseUrl) [delete, get, post, put]

359+ actions = [delete, get, post, put]

362360 forM_ actions $ \ clientAction -> do

363− Left FailureResponse{..} <- runExceptT clientAction

361+ Left FailureResponse{..} <- runClientM clientAction (ClientEnv manager baseUrl)

364362 responseStatus `shouldBe` HTTP.Status 500 "error message"

365363

366364basicAuthSpec :: Spec

@@ -370,14 +368,14 @@ basicAuthSpec = around (withTestServer "basicAuthServer") $ do

370368 it "Authenticates a BasicAuth protected server appropriately" $ \baseUrl -> do

371369 let getBasic = client basicAuthAPI

372370 let basicAuthData = BasicAuthData "servant" "server"

373− (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice

371+ (left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice

374372

375373 context "Authentication is rejected when requests are not authenticated properly" $ do

376374

377375 it "Authenticates a BasicAuth protected server appropriately" $ \baseUrl -> do

378376 let getBasic = client basicAuthAPI

379377 let basicAuthData = BasicAuthData "not" "password"

380− Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)

378+ Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)

381379 responseStatus `shouldBe` HTTP.Status 403 "Forbidden"

382380

383381genAuthSpec :: Spec

@@ -387,14 +385,14 @@ genAuthSpec = around (withTestServer "genAuthServer") $ do

387385 it "Authenticates a AuthProtect protected server appropriately" $ \baseUrl -> do

388386 let getProtected = client genAuthAPI

389387 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)

390− (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice

388+ (left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice

391389

392390 context "Authentication is rejected when requests are not authenticated properly" $ do

393391

394392 it "Authenticates a AuthProtect protected server appropriately" $ \baseUrl -> do

395393 let getProtected = client genAuthAPI

396394 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)

397− Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)

395+ Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)

398396 responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")

399397

400398failSpec :: Spec

@@ -403,35 +401,36 @@ failSpec = around (withTestServer "failServer") $ do

403401 context "client returns errors appropriately" $ do

404402 it "reports FailureResponse" $ \baseUrl -> do

405403 let (_ :<|> getDeleteEmpty :<|> _) = client api

406− Left res <- runExceptT (getDeleteEmpty manager baseUrl)

404+ Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)

407405 case res of

408406 FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()

409407 _ -> fail $ "expected 404 response, but got " <> show res

410408

411409 it "reports DecodeFailure" $ \baseUrl -> do

412410 let (_ :<|> _ :<|> getCapture :<|> _) = client api

413− Left res <- runExceptT (getCapture "foo" manager baseUrl)

411+ Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)

414412 case res of

415413 DecodeFailure _ ("application/json") _ -> return ()

416414 _ -> fail $ "expected DecodeFailure, but got " <> show res

417415

418416 it "reports ConnectionError" $ \_ -> do

419417 let (getGetWrongHost :<|> _) = client api

420− Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))

418+ Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))

421419 case res of

422420 ConnectionError _ -> return ()

423421 _ -> fail $ "expected ConnectionError, but got " <> show res

424422

425423 it "reports UnsupportedContentType" $ \baseUrl -> do

426424 let (getGet :<|> _ ) = client api

427− Left res <- runExceptT (getGet manager baseUrl)

425+ Left res <- runClientM getGet (ClientEnv manager baseUrl)

428426 case res of

429427 UnsupportedContentType ("application/octet-stream") _ -> return ()

430428 _ -> fail $ "expected UnsupportedContentType, but got " <> show res

431429

432430 it "reports InvalidContentTypeHeader" $ \baseUrl -> do

433− let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api

434− Left res <- runExceptT (getBody alice manager baseUrl)

431+ let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api

432+ Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)

433+

435434 case res of

436435 InvalidContentTypeHeader "fooooo" _ -> return ()

437436 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

servant-docs/servant-docs.cabal+2−4

@@ -1,5 +1,5 @@

11name: servant-docs

2−version: 0.8

2+version: 0.9

33synopsis: generate API docs for your servant webservice

44description:

55 Library for generating API docs from a servant API definition.

@@ -36,13 +36,12 @@ library

3636 , aeson

3737 , aeson-pretty

3838 , bytestring

39− , bytestring-conversion

4039 , case-insensitive

4140 , hashable

4241 , http-media >= 0.6

4342 , http-types >= 0.7

4443 , lens

45− , servant == 0.8.*

44+ , servant == 0.9.*

4645 , string-conversions

4746 , text

4847 , unordered-containers

@@ -61,7 +60,6 @@ executable greet-docs

6160 build-depends:

6261 base

6362 , aeson

64− , bytestring-conversion

6563 , lens

6664 , servant

6765 , servant-docs

servant-docs/src/Servant/Docs/Internal.hs+18−3

@@ -25,7 +25,6 @@ import Control.Arrow (second)

2525import Control.Lens (makeLenses, mapped, over, traversed, view, (%~),

2626 (&), (.~), (<>~), (^.), (|>))

2727import qualified Control.Monad.Omega as Omega

28−import Data.ByteString.Conversion (ToByteString, toByteString)

2928import Data.ByteString.Lazy.Char8 (ByteString)

3029import qualified Data.ByteString.Char8 as BSC

3130import qualified Data.CaseInsensitive as CI

@@ -461,12 +460,12 @@ class AllHeaderSamples ls where

461460instance AllHeaderSamples '[] where

462461 allHeaderToSample _ = []

463462

464−instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)

463+instance (ToHttpApiData l, AllHeaderSamples ls, ToSample l, KnownSymbol h)

465464 => AllHeaderSamples (Header h l ': ls) where

466465 allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) :

467466 allHeaderToSample (Proxy :: Proxy ls)

468467 where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h)

469− mkHeader (Just x) = (headerName, cs $ toByteString x)

468+ mkHeader (Just x) = (headerName, cs $ toHeader x)

470469 mkHeader Nothing = (headerName, "<no header sample provided>")

471470

472471-- | Synthesise a sample value of a type, encoded in the specified media types.

@@ -702,6 +701,22 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)

702701 symP = Proxy :: Proxy sym

703702

704703

704+-- | @"books" :> 'CaptureAll' "isbn" Text@ will appear as

705+-- @/books/:isbn@ in the docs.

706+instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)

707+ => HasDocs (CaptureAll sym a :> sublayout) where

708+

709+ docsFor Proxy (endpoint, action) =

710+ docsFor sublayoutP (endpoint', action')

711+

712+ where sublayoutP = Proxy :: Proxy sublayout

713+ captureP = Proxy :: Proxy (CaptureAll sym a)

714+

715+ action' = over captures (|> toCapture captureP) action

716+ endpoint' = over path (\p -> p ++ [":" ++ symbolVal symP]) endpoint

717+ symP = Proxy :: Proxy sym

718+

719+

705720instance OVERLAPPABLE_

706721 (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status

707722 , ReflectMethod method)

servant-docs/test/Servant/DocsSpec.hs+2

@@ -34,6 +34,8 @@ instance ToParam (QueryFlag "foo") where

3434 toParam = error "unused"

3535instance ToCapture (Capture "foo" Int) where

3636 toCapture = error "unused"

37+instance ToCapture (CaptureAll "foo" Int) where

38+ toCapture = error "unused"

3739

3840-- * specs

3941

servant-foreign/servant-foreign.cabal+2−2

@@ -1,5 +1,5 @@

11name: servant-foreign

2−version: 0.8

2+version: 0.9

33synopsis: Helpers for generating clients for servant APIs in any programming language

44description:

55 Helper types and functions for generating client functions for servant APIs in any programming language

@@ -32,7 +32,7 @@ library

3232 , Servant.Foreign.Inflections

3333 build-depends: base == 4.*

3434 , lens == 4.*

35− , servant == 0.8.*

35+ , servant == 0.9.*

3636 , text >= 1.2 && < 1.3

3737 , http-types

3838 hs-source-dirs: src

servant-foreign/src/Servant/Foreign/Internal.hs+15

@@ -211,6 +211,21 @@ instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype ap

211211 { _argName = PathSegment str

212212 , _argType = ftype }

213213

214+instance (KnownSymbol sym, HasForeignType lang ftype [t], HasForeign lang ftype sublayout)

215+ => HasForeign lang ftype (CaptureAll sym t :> sublayout) where

216+ type Foreign ftype (CaptureAll sym t :> sublayout) = Foreign ftype sublayout

217+

218+ foreignFor lang Proxy Proxy req =

219+ foreignFor lang Proxy (Proxy :: Proxy sublayout) $

220+ req & reqUrl . path <>~ [Segment (Cap arg)]

221+ & reqFuncName . _FunctionName %~ (++ ["by", str])

222+ where

223+ str = pack . symbolVal $ (Proxy :: Proxy sym)

224+ ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [t])

225+ arg = Arg

226+ { _argName = PathSegment str

227+ , _argType = ftype }

228+

214229instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)

215230 => HasForeign lang ftype (Verb method status list a) where

216231 type Foreign ftype (Verb method status list a) = Req ftype

servant-foreign/test/Servant/ForeignSpec.hs+16−2

@@ -46,6 +46,7 @@ type TestApi

4646 :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent

4747 :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent

4848 :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent

49+ :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]

4950

5051testApi :: [Req String]

5152testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)

@@ -53,9 +54,9 @@ testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: P

5354listFromAPISpec :: Spec

5455listFromAPISpec = describe "listFromAPI" $ do

5556 it "generates 4 endpoints for TestApi" $ do

56− length testApi `shouldBe` 4

57+ length testApi `shouldBe` 5

5758

58− let [getReq, postReq, putReq, deleteReq] = testApi

59+ let [getReq, postReq, putReq, deleteReq, captureAllReq] = testApi

5960

6061 it "collects all info for get request" $ do

6162 shouldBe getReq $ defReq

@@ -106,3 +107,16 @@ listFromAPISpec = describe "listFromAPI" $ do

106107 , _reqReturnType = Just "voidX"

107108 , _reqFuncName = FunctionName ["delete", "test", "by", "id"]

108109 }

110+

111+ it "collects all info for capture all request" $ do

112+ shouldBe captureAllReq $ defReq

113+ { _reqUrl = Url

114+ [ Segment $ Static "test"

115+ , Segment $ Cap (Arg "ids" "listX of intX") ]

116+ []

117+ , _reqMethod = "GET"

118+ , _reqHeaders = []

119+ , _reqBody = Nothing

120+ , _reqReturnType = Just "listX of intX"

121+ , _reqFuncName = FunctionName ["get", "test", "by", "ids"]

122+ }

servant-js/README.md+2−2

@@ -78,8 +78,8 @@ server counter = counterPlusOne counter -- (+1) on the TVar

7878 :<|> currentValue counter -- read the TVar

7979

8080server' :: TVar Counter -> Server TestApi'

81−server counter = server counter

82− :<|> serveDirectory www -- serve static files

81+server' counter = server counter

82+ :<|> serveDirectory www -- serve static files

8383

8484runServer :: TVar Counter -- ^ shared variable for the counter

8585 -> Int -- ^ port the server should listen on

servant-js/examples/counter.hs+2−1

@@ -1,6 +1,7 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE DeriveGeneric #-}

33{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE OverloadedStrings #-}

45{-# LANGUAGE TypeOperators #-}

56

67import Control.Concurrent.STM

@@ -92,7 +93,7 @@ main = do

9293

9394 writeJSForAPI testApi (angular defAngularOptions) (www </> "angular" </> "api.js")

9495

95− writeJSForAPI testApi axios (www </> "axios" </> "api.js")

96+ writeJSForAPI testApi (axios defAxiosOptions) (www </> "axios" </> "api.js")

9697

9798 writeServiceJS (www </> "angular" </> "api.service.js")

9899

servant-js/servant-js.cabal+6−6

@@ -1,5 +1,5 @@

11name: servant-js

2−version: 0.8

2+version: 0.9

33synopsis: Automatically derive javascript functions to query servant webservices.

44description:

55 Automatically derive javascript functions to query servant webservices.

@@ -45,8 +45,8 @@ library

4545 , base-compat >= 0.9

4646 , charset >= 0.3

4747 , lens >= 4

48− , servant-foreign == 0.8.*

49− , servant == 0.8.*

48+ , servant-foreign == 0.9.*

49+ , servant == 0.9.*

5050 , text >= 1.2 && < 1.3

5151

5252 hs-source-dirs: src

@@ -65,11 +65,11 @@ executable counter

6565 buildable: False

6666

6767 build-depends: base >= 4.7 && < 5

68− , aeson >= 0.7 && < 0.12

68+ , aeson >= 0.7 && < 1.1

6969 , filepath >= 1

7070 , lens >= 4

71− , servant == 0.8.*

72− , servant-server == 0.8.*

71+ , servant == 0.9.*

72+ , servant-server == 0.9.*

7373 , servant-js

7474 , stm

7575 , transformers

servant-js/src/Servant/JS.hs+1

@@ -112,6 +112,7 @@ module Servant.JS

112112 , javascript

113113 , NoTypes

114114 , GenerateList(..)

115+ , FunctionName(..)

115116 ) where

116117

117118import Prelude hiding (writeFile)

servant-js/test/Servant/JSSpec.hs+1−1

@@ -33,7 +33,7 @@ import Servant.JSSpec.CustomHeaders

3333-- * comprehensive api

3434

3535-- This declaration simply checks that all instances are in place.

36−_ = jsForAPI comprehensiveAPI vanillaJS :: Text

36+_ = jsForAPI comprehensiveAPIWithoutRaw vanillaJS :: Text

3737

3838-- * specs

3939

servant-mock/.ghcideleted−1

@@ -1 +0,0 @@

1−:set -Wall -itest -isrc -optP-include -optPdist/build/autogen/cabal_macros.h -Iinclude

servant-mock/LICENSEdeleted−30

@@ -1,30 +0,0 @@

2−

4−

5−Redistribution and use in source and binary forms, with or without

6−modification, are permitted provided that the following conditions are met:

7−

8− * Redistributions of source code must retain the above copyright

9− notice, this list of conditions and the following disclaimer.

10−

11− * Redistributions in binary form must reproduce the above

12− copyright notice, this list of conditions and the following

13− disclaimer in the documentation and/or other materials provided

14− with the distribution.

15−

16− * Neither the name of Alp Mestanogullari nor the names of other

17− contributors may be used to endorse or promote products derived

18− from this software without specific prior written permission.

19−

20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

servant-mock/Setup.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Distribution.Simple

2−main = defaultMain

servant-mock/example/main.hsdeleted−26

@@ -1,26 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE TypeOperators #-}

5−

6−{-# OPTIONS_GHC -fno-warn-unused-binds #-}

7−

8−import Data.Aeson

9−import GHC.Generics

10−import Network.Wai.Handler.Warp

11−import Servant

12−import Servant.Mock

13−import Test.QuickCheck.Arbitrary

14−

15−newtype User = User { username :: String }

16− deriving (Eq, Show, Arbitrary, Generic)

17−

18−instance ToJSON User

19−

20−type API = "user" :> Get '[JSON] User

21−

22−api :: Proxy API

23−api = Proxy

24−

25−main :: IO ()

26−main = run 8080 (serve api $ mock api Proxy)

servant-mock/include/overlapping-compat.hdeleted−8

@@ -1,8 +0,0 @@

1−#if __GLASGOW_HASKELL__ >= 710

2−#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}

3−#define OVERLAPPING_ {-# OVERLAPPING #-}

4−#else

5−{-# LANGUAGE OverlappingInstances #-}

6−#define OVERLAPPABLE_

7−#define OVERLAPPING_

8−#endif

servant-mock/servant-mock.cabaldeleted−73

@@ -1,73 +0,0 @@

1−name: servant-mock

2−version: 0.8

3−synopsis: Derive a mock server for free from your servant API types

4−description:

5− Derive a mock server for free from your servant API types

6− .

7− See the @Servant.Mock@ module for the documentation and an example.

8−homepage: http://github.com/haskell-servant/servant

9−license: BSD3

10−license-file: LICENSE

11−author: Servant Contributors

12−maintainer: haskell-servant-maintainers@googlegroups.com

13−copyright: 2015-2016 Servant Contributors

14−category: Web

15−build-type: Simple

16−extra-source-files: include/*.h

17−cabal-version: >=1.10

18−bug-reports: http://github.com/haskell-servant/servant/issues

19−source-repository head

20− type: git

21− location: http://github.com/haskell-servant/servant.git

22−

23−flag example

24− description: Build the example too

25− default: True

26−

27−library

28− exposed-modules:

29− Servant.Mock

30− build-depends:

31− base >=4.7 && <5,

32− bytestring >= 0.10 && <0.11,

33− http-types >= 0.8 && <0.10,

34− servant == 0.8.*,

35− servant-server == 0.8.*,

36− transformers >= 0.3 && <0.6,

37− QuickCheck >= 2.7 && <2.9,

38− wai >= 3.0 && <3.3

39− hs-source-dirs: src

40− default-language: Haskell2010

41− include-dirs: include

42− ghc-options: -Wall

43−

44−executable mock-app

45− main-is: main.hs

46− hs-source-dirs: example

47− default-language: Haskell2010

48− build-depends: aeson, base, servant-mock, servant-server, QuickCheck, warp

49− if flag(example)

50− buildable: True

51− else

52− buildable: False

53− ghc-options: -Wall

54−

55−test-suite spec

56− type: exitcode-stdio-1.0

57− ghc-options: -Wall

58− default-language: Haskell2010

59− hs-source-dirs: test

60− main-is: Spec.hs

61− other-modules:

62− Servant.MockSpec

63− build-depends:

64− base,

65− hspec,

66− hspec-wai,

67− QuickCheck,

68− servant,

69− servant-server,

70− servant-mock,

71− aeson,

72− bytestring-conversion,

73− wai

servant-mock/src/Servant/Mock.hsdeleted−185

@@ -1,185 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE FlexibleInstances #-}

5−{-# LANGUAGE MultiParamTypeClasses #-}

6−{-# LANGUAGE PolyKinds #-}

7−{-# LANGUAGE ScopedTypeVariables #-}

8−{-# LANGUAGE TypeFamilies #-}

9−{-# LANGUAGE TypeOperators #-}

10−{-# OPTIONS_GHC -fno-warn-orphans #-}

11−

12−#include "overlapping-compat.h"

13−

14−-- |

15−-- Module : Servant.Mock

16−-- Copyright : 2015 Alp Mestanogullari

17−-- License : BSD3

18−--

19−-- Maintainer : Alp Mestanogullari <alpmestan@gmail.com>

20−-- Stability : experimental

21−-- Portability : portable

22−--

23−-- Automatically derive a mock webserver that implements some API type,

24−-- just from the said API type's definition.

25−--

26−-- Using this module couldn't be simpler. Given some API type, like:

27−--

28−-- > type API = "user" :> Get '[JSON] User

29−--

30−-- that describes your web application, all you have to do is define

31−-- a 'Proxy' to it:

32−--

33−-- > myAPI :: Proxy API

34−-- > myAPI = Proxy

35−--

36−-- and call 'mock', which has the following type:

37−--

38−-- @

39−-- 'mock' :: 'HasMock' api context => 'Proxy' api -> 'Proxy' context -> 'Server' api

40−-- @

41−--

42−-- What this says is, given some API type @api@ that it knows it can

43−-- "mock", 'mock' hands you an implementation of the API type. It does so

44−-- by having each request handler generate a random value of the

45−-- appropriate type (@User@ in our case). All you need for this to work is

46−-- to provide 'Arbitrary' instances for the data types returned as response

47−-- bodies, hence appearing next to 'Delete', 'Get', 'Patch', 'Post' and 'Put'.

48−--

49−-- To put this all to work and run the mock server, just call 'serve' on the

50−-- result of 'mock' to get an 'Application' that you can then run with warp.

51−--

52−-- @

53−-- main :: IO ()

54−-- main = Network.Wai.Handler.Warp.run 8080 $

55−-- 'serve' myAPI ('mock' myAPI Proxy)

56−-- @

57−module Servant.Mock ( HasMock(..) ) where

58−

59−#if !MIN_VERSION_base(4,8,0)

60−import Control.Applicative

61−#endif

62−import Control.Monad.IO.Class

63−import Data.ByteString.Lazy.Char8 (pack)

64−import Data.Proxy

65−import GHC.TypeLits

66−import Network.HTTP.Types.Status

67−import Network.Wai

68−import Servant

69−import Servant.API.ContentTypes

70−import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)

71−import Test.QuickCheck.Gen (Gen, generate)

72−

73−-- | 'HasMock' defines an interpretation of API types

74−-- than turns them into random-response-generating

75−-- request handlers, hence providing an instance for

76−-- all the combinators of the core /servant/ library.

77−class HasServer api context => HasMock api context where

78− -- | Calling this method creates request handlers of

79− -- the right type to implement the API described by

80− -- @api@ that just generate random response values of

81− -- the right type. E.g:

82− --

83− -- @

84− -- type API = "user" :> Get '[JSON] User

85− -- :<|> "book" :> Get '[JSON] Book

86− --

87− -- api :: Proxy API

88− -- api = Proxy

89− --

90− -- -- let's say we will start with the frontend,

91− -- -- and hence need a placeholder server

92− -- server :: Server API

93− -- server = mock api Proxy

94− -- @

95− --

96− -- What happens here is that @'Server' API@

97− -- actually "means" 2 request handlers, of the following types:

98− --

99− -- @

100− -- getUser :: Handler User

101− -- getBook :: Handler Book

102− -- @

103− --

104− -- So under the hood, 'mock' uses the 'IO' bit to generate

105− -- random values of type 'User' and 'Book' every time these

106− -- endpoints are requested.

107− mock :: Proxy api -> Proxy context -> Server api

108−

109−instance (HasMock a context, HasMock b context) => HasMock (a :<|> b) context where

110− mock _ context = mock (Proxy :: Proxy a) context :<|> mock (Proxy :: Proxy b) context

111−

112−instance (KnownSymbol path, HasMock rest context) => HasMock (path :> rest) context where

113− mock _ = mock (Proxy :: Proxy rest)

114−

115−instance (KnownSymbol s, FromHttpApiData a, HasMock rest context) => HasMock (Capture s a :> rest) context where

116− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

117−

118−instance (AllCTUnrender ctypes a, HasMock rest context) => HasMock (ReqBody ctypes a :> rest) context where

119− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

120−

121−instance HasMock rest context => HasMock (RemoteHost :> rest) context where

122− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

123−

124−instance HasMock rest context => HasMock (IsSecure :> rest) context where

125− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

126−

127−instance HasMock rest context => HasMock (Vault :> rest) context where

128− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

129−

130−instance HasMock rest context => HasMock (HttpVersion :> rest) context where

131− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

132−

133−instance (KnownSymbol s, FromHttpApiData a, HasMock rest context)

134− => HasMock (QueryParam s a :> rest) context where

135− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

136−

137−instance (KnownSymbol s, FromHttpApiData a, HasMock rest context)

138− => HasMock (QueryParams s a :> rest) context where

139− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

140−

141−instance (KnownSymbol s, HasMock rest context) => HasMock (QueryFlag s :> rest) context where

142− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

143−

144−instance (KnownSymbol h, FromHttpApiData a, HasMock rest context) => HasMock (Header h a :> rest) context where

145− mock _ context = \_ -> mock (Proxy :: Proxy rest) context

146−

147−instance (Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)

148− => HasMock (Verb method status ctypes a) context where

149− mock _ _ = mockArbitrary

150−

151−instance OVERLAPPING_

152− (GetHeaders (Headers headerTypes a), Arbitrary (HList headerTypes),

153− Arbitrary a, KnownNat status, ReflectMethod method, AllCTRender ctypes a)

154− => HasMock (Verb method status ctypes (Headers headerTypes a)) context where

155− mock _ _ = mockArbitrary

156−

157−instance HasMock Raw context where

158− mock _ _ = \_req respond -> do

159− bdy <- genBody

160− respond $ responseLBS status200 [] bdy

161−

162− where genBody = pack <$> generate (vector 100 :: Gen [Char])

163−

164−instance (HasContextEntry context (NamedContext name subContext), HasMock rest subContext) =>

165− HasMock (WithNamedContext name subContext rest) context where

166−

167− mock _ _ = mock (Proxy :: Proxy rest) (Proxy :: Proxy subContext)

168−

169−mockArbitrary :: (MonadIO m, Arbitrary a) => m a

170−mockArbitrary = liftIO (generate arbitrary)

171−

172−-- utility instance

173−instance (Arbitrary (HList ls), Arbitrary a)

174− => Arbitrary (Headers ls a) where

175− arbitrary = Headers <$> arbitrary <*> arbitrary

176−

177−instance Arbitrary (HList '[]) where

178− arbitrary = pure HNil

179−

180−instance (Arbitrary a, Arbitrary (HList hs))

181− => Arbitrary (HList (Header h a ': hs)) where

182− arbitrary = HCons <$> fmap Header arbitrary <*> arbitrary

183−

184−instance Arbitrary NoContent where

185− arbitrary = pure NoContent

servant-mock/test/Servant/MockSpec.hsdeleted−85

@@ -1,85 +0,0 @@

1−{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE DeriveGeneric #-}

4−{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE OverloadedStrings #-}

6−{-# LANGUAGE TypeOperators #-}

7−

8−module Servant.MockSpec where

9−

10−import Data.Aeson as Aeson

11−import Data.ByteString.Conversion.To

12−import Data.Proxy

13−import Data.String

14−import GHC.Generics

15−import Network.Wai

16−import Servant.API

17−import Test.Hspec hiding (pending)

18−import Test.Hspec.Wai

19−import Test.QuickCheck

20−

21−import Servant

22−import Servant.API.Internal.Test.ComprehensiveAPI

23−import Servant.Mock

24−

25−-- This declaration simply checks that all instances are in place.

26−_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedContext "foo" '[]])

27−

28−data Body

29− = Body

30− | ArbitraryBody

31− deriving (Generic)

32−

33−instance ToJSON Body

34−

35−instance Arbitrary Body where

36− arbitrary = return ArbitraryBody

37−

38−data TestHeader

39− = TestHeader

40− | ArbitraryHeader

41− deriving (Show)

42−

43−instance ToByteString TestHeader where

44− builder = fromString . show

45−

46−instance Arbitrary TestHeader where

47− arbitrary = return ArbitraryHeader

48−

49−spec :: Spec

50−spec = do

51− describe "mock" $ do

52− context "Get" $ do

53− let api :: Proxy (Get '[JSON] Body)

54− api = Proxy

55− app = serve api (mock api Proxy)

56− with (return app) $ do

57− it "serves arbitrary response bodies" $ do

58− get "/" `shouldRespondWith` 200{

59− matchBody = Just $ Aeson.encode ArbitraryBody

60− }

61−

62− context "response headers" $ do

63− let withHeader :: Proxy (Get '[JSON] (Headers '[Header "foo" TestHeader] Body))

64− withHeader = Proxy

65− withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))

66− withoutHeader = Proxy

67− toApp :: (HasMock api '[]) => Proxy api -> IO Application

68− toApp api = return $ serve api (mock api (Proxy :: Proxy '[]))

69− with (toApp withHeader) $ do

70− it "serves arbitrary response bodies" $ do

71− get "/" `shouldRespondWith` 200{

72− matchHeaders = return $ MatchHeader $ \ h ->

73− if h == [("Content-Type", "application/json"), ("foo", "ArbitraryHeader")]

74− then Nothing

75− else Just ("headers not correct\n")

76− }

77−

78− with (toApp withoutHeader) $ do

79− it "works for no additional headers" $ do

80− get "/" `shouldRespondWith` 200{

81− matchHeaders = return $ MatchHeader $ \ h ->

82− if h == [("Content-Type", "application/json")]

83− then Nothing

84− else Just ("headers not correct\n")

85− }

servant-mock/test/Spec.hsdeleted−1

@@ -1 +0,0 @@

1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

servant-mock/tinc.yamldeleted−5

@@ -1,5 +0,0 @@

1−dependencies:

2− - name: servant

3− path: ../servant

4− - name: servant-server

5− path: ../servant-server

servant-server/servant-server.cabal+5−5

@@ -1,5 +1,5 @@

11name: servant-server

2−version: 0.8

2+version: 0.9

33synopsis: A family of combinators for defining webservices APIs and serving them

44description:

55 A family of combinators for defining webservices APIs and serving them

@@ -47,18 +47,18 @@ library

4747 build-depends:

4848 base >= 4.7 && < 4.10

4949 , base-compat >= 0.9 && < 0.10

50− , aeson >= 0.7 && < 0.12

50+ , aeson >= 0.7 && < 1.1

5151 , attoparsec >= 0.12 && < 0.14

5252 , base64-bytestring >= 1.0 && < 1.1

5353 , bytestring >= 0.10 && < 0.11

5454 , containers >= 0.5 && < 0.6

55− , http-api-data >= 0.1 && < 0.3

55+ , http-api-data >= 0.3 && < 0.4

5656 , http-types >= 0.8 && < 0.10

5757 , network-uri >= 2.6 && < 2.7

5858 , mtl >= 2 && < 2.3

5959 , network >= 2.6 && < 2.7

6060 , safe >= 0.3 && < 0.4

61− , servant == 0.8.*

61+ , servant == 0.9.*

6262 , split >= 0.2 && < 0.3

6363 , string-conversions >= 0.3 && < 0.5

6464 , system-filepath >= 0.4 && < 0.5

@@ -99,6 +99,7 @@ test-suite spec

9999 hs-source-dirs: test

100100 main-is: Spec.hs

101101 other-modules:

102+ Servant.ArbitraryMonadServerSpec

102103 Servant.Server.ErrorSpec

103104 Servant.Server.Internal.ContextSpec

104105 Servant.Server.RouterSpec

@@ -113,7 +114,6 @@ test-suite spec

113114 , aeson

114115 , base64-bytestring

115116 , bytestring

116− , bytestring-conversion

117117 , directory

118118 , exceptions

119119 , hspec == 2.*

servant-server/src/Servant/Server/Internal.hs+42−9

@@ -42,16 +42,16 @@ import Network.Wai (Application, Request, Response,

4242 responseLBS, vault)

4343import Prelude ()

4444import Prelude.Compat

45−import Web.HttpApiData (FromHttpApiData)

46−import Web.HttpApiData.Internal (parseHeaderMaybe,

45+import Web.HttpApiData (FromHttpApiData, parseHeaderMaybe,

4746 parseQueryParamMaybe,

48− parseUrlPieceMaybe)

49−

47+ parseUrlPieceMaybe,

48+ parseUrlPieces)

5049import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,

51− Verb, ReflectMethod(reflectMethod),

52− IsSecure(..), Header,

53− QueryFlag, QueryParam, QueryParams,

54− Raw, RemoteHost, ReqBody, Vault,

50+ CaptureAll, Verb,

51+ ReflectMethod(reflectMethod),

52+ IsSecure(..), Header, QueryFlag,

53+ QueryParam, QueryParams, Raw,

54+ RemoteHost, ReqBody, Vault,

5555 WithNamedContext)

5656import Servant.API.ContentTypes (AcceptHeader (..),

5757 AllCTRender (..),

@@ -128,11 +128,44 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)

128128 CaptureRouter $

129129 route (Proxy :: Proxy api)

130130 context

131− (addCapture d $ \ txt -> case parseUrlPieceMaybe txt :: Maybe a of

131+ (addCapture d $ \ txt -> case parseUrlPieceMaybe txt of

132132 Nothing -> delayedFail err400

133133 Just v -> return v

134134 )

135135

136+-- | If you use 'CaptureAll' in one of the endpoints for your API,

137+-- this automatically requires your server-side handler to be a

138+-- function that takes an argument of a list of the type specified by

139+-- the 'CaptureAll'. This lets servant worry about getting values from

140+-- the URL and turning them into values of the type you specify.

141+--

142+-- You can control how they'll be converted from 'Text' to your type

143+-- by simply providing an instance of 'FromHttpApiData' for your type.

144+--

145+-- Example:

146+--

147+-- > type MyApi = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile

148+-- >

149+-- > server :: Server MyApi

150+-- > server = getSourceFile

151+-- > where getSourceFile :: [Text] -> Handler Book

152+-- > getSourceFile pathSegments = ...

153+instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context)

154+ => HasServer (CaptureAll capture a :> sublayout) context where

155+

156+ type ServerT (CaptureAll capture a :> sublayout) m =

157+ [a] -> ServerT sublayout m

158+

159+ route Proxy context d =

160+ CaptureAllRouter $

161+ route (Proxy :: Proxy sublayout)

162+ context

163+ (addCapture d $ \ txts -> case parseUrlPieces txts of

164+ Left _ -> delayedFail err400

165+ Right v -> return v

166+ )

167+

168+

136169allowedMethodHead :: Method -> Request -> Bool

137170allowedMethodHead method request = method == methodGet && requestMethod request == methodHead

138171

servant-server/src/Servant/Server/Internal/Router.hs+10

@@ -31,6 +31,9 @@ data Router' env a =

3131 | CaptureRouter (Router' (Text, env) a)

3232 -- ^ first path component is passed to the child router in its

3333 -- environment and removed afterwards

34+ | CaptureAllRouter (Router' ([Text], env) a)

35+ -- ^ all path components are passed to the child router in its

36+ -- environment and are removed afterwards

3437 | RawRouter (env -> a)

3538 -- ^ to be used for routes we do not know anything about

3639 | Choice (Router' env a) (Router' env a)

@@ -90,6 +93,9 @@ routerStructure (StaticRouter m ls) =

9093routerStructure (CaptureRouter router) =

9194 CaptureRouterStructure $

9295 routerStructure router

96+routerStructure (CaptureAllRouter router) =

97+ CaptureRouterStructure $

98+ routerStructure router

9399routerStructure (RawRouter _) =

94100 RawRouterStructure

95101routerStructure (Choice r1 r2) =

@@ -163,6 +169,10 @@ runRouterEnv router env request respond =

163169 first : rest

164170 -> let request' = request { pathInfo = rest }

165171 in runRouterEnv router' (first, env) request' respond

172+ CaptureAllRouter router' ->

173+ let segments = pathInfo request

174+ request' = request { pathInfo = [] }

175+ in runRouterEnv router' (segments, env) request' respond

166176 RawRouter app ->

167177 app env request respond

168178 Choice r1 r2 ->

servant-server/src/Servant/Server/Internal/RoutingApplication.hs+2−3

@@ -11,7 +11,6 @@ module Servant.Server.Internal.RoutingApplication where

1111import Control.Monad (ap, liftM)

1212import Control.Monad.Trans (MonadIO(..))

1313import Control.Monad.Trans.Except (runExceptT)

14−import Data.Text (Text)

1514import Network.Wai (Application, Request,

1615 Response, ResponseReceived)

1716import Prelude ()

@@ -161,8 +160,8 @@ withRequest f = DelayedIO (\ req -> runDelayedIO (f req) req)

161160

162161-- | Add a capture to the end of the capture block.

163162addCapture :: Delayed env (a -> b)

164− -> (Text -> DelayedIO a)

165− -> Delayed (Text, env) b

163+ -> (captured -> DelayedIO a)

164+ -> Delayed (captured, env) b

166165addCapture Delayed{..} new =

167166 Delayed

168167 { capturesD = \ (txt, env) -> (,) <$> capturesD env <*> new txt

servant-server/test/Servant/ServerSpec.hs+56−2

@@ -17,7 +17,6 @@ import Control.Monad (forM_, when, unless)

1717import Control.Monad.Trans.Except (throwE)

1818import Data.Aeson (FromJSON, ToJSON, decode', encode)

1919import qualified Data.ByteString.Base64 as Base64

20−import Data.ByteString.Conversion ()

2120import Data.Char (toUpper)

2221import Data.Monoid

2322import Data.Proxy (Proxy (Proxy))

@@ -39,7 +38,7 @@ import Network.Wai.Test (defaultRequest, request,

3938 simpleHeaders, simpleStatus)

4039import Servant.API ((:<|>) (..), (:>), AuthProtect,

4140 BasicAuth, BasicAuthData(BasicAuthData),

42− Capture, Delete, Get, Header (..),

41+ Capture, CaptureAll, Delete, Get, Header (..),

4342 Headers, HttpVersion,

4443 IsSecure (..), JSON,

4544 NoContent (..), Patch, PlainText,

@@ -216,6 +215,58 @@ captureSpec = do

216215 it "strips the captured path snippet from pathInfo" $ do

217216 get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))

218217

218+-- }}}

219+------------------------------------------------------------------------------

220+-- * captureAllSpec {{{

221+------------------------------------------------------------------------------

222+

223+type CaptureAllApi = CaptureAll "legs" Integer :> Get '[JSON] Animal

224+captureAllApi :: Proxy CaptureAllApi

225+captureAllApi = Proxy

226+captureAllServer :: [Integer] -> Handler Animal

227+captureAllServer legs = case sum legs of

228+ 4 -> return jerry

229+ 2 -> return tweety

230+ 0 -> return beholder

231+ _ -> throwE err404

232+

233+captureAllSpec :: Spec

234+captureAllSpec = do

235+ describe "Servant.API.CaptureAll" $ do

236+ with (return (serve captureAllApi captureAllServer)) $ do

237+

238+ it "can capture a single element of the 'pathInfo'" $ do

239+ response <- get "/2"

240+ liftIO $ decode' (simpleBody response) `shouldBe` Just tweety

241+

242+ it "can capture multiple elements of the 'pathInfo'" $ do

243+ response <- get "/2/2"

244+ liftIO $ decode' (simpleBody response) `shouldBe` Just jerry

245+

246+ it "can capture arbitrarily many elements of the 'pathInfo'" $ do

247+ response <- get "/1/1/0/1/0/1"

248+ liftIO $ decode' (simpleBody response) `shouldBe` Just jerry

249+

250+ it "can capture when there are no elements in 'pathInfo'" $ do

251+ response <- get "/"

252+ liftIO $ decode' (simpleBody response) `shouldBe` Just beholder

253+

254+ it "returns 400 if the decoding fails" $ do

255+ get "/notAnInt" `shouldRespondWith` 400

256+

257+ it "returns 400 if the decoding fails, regardless of which element" $ do

258+ get "/1/0/0/notAnInt/3/" `shouldRespondWith` 400

259+

260+ it "returns 400 if the decoding fails, even when it's multiple elements" $ do

261+ get "/1/0/0/notAnInt/3/orange/" `shouldRespondWith` 400

262+

263+ with (return (serve

264+ (Proxy :: Proxy (CaptureAll "segments" String :> Raw))

265+ (\ _captured request_ respond ->

266+ respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do

267+ it "consumes everything from pathInfo" $ do

268+ get "/captured/foo/bar/baz" `shouldRespondWith` (fromString (show ([] :: [Int])))

269+

219270-- }}}

220271------------------------------------------------------------------------------

221272-- * queryParamSpec {{{

@@ -644,4 +695,7 @@ jerry = Animal "Mouse" 4

644695

645696tweety :: Animal

646697tweety = Animal "Bird" 2

698+

699+beholder :: Animal

700+beholder = Animal "Beholder" 0

647701-- }}}

servant/CHANGELOG.md+12

@@ -1,3 +1,15 @@

1+0.9

2+---

3+

4+* Added Eq, Show, Read, Generic and Ord instances to IsSecure

5+* BACKWARDS INCOMPATIBLE: replace use of `ToFromByteString` with `To/FromHttpApiData` for `GetHeaders/BuildHeadersTo`

6+* BACKWARDS INCOMPATIBLE: Moved `From/ToFormUrlEncoded` classes, which were renamed to `From/ToForm` to `http-api-data`

7+

8+0.8.1

9+----

10+

11+* Add `CaptureAll` combinator. Captures all of the remaining segments in a URL.

12+

1130.8

214---

315

servant/servant.cabal+3−4

@@ -1,5 +1,5 @@

11name: servant

2−version: 0.8

2+version: 0.9

33synopsis: A family of combinators for defining webservices APIs

44description:

55 A family of combinators for defining webservices APIs and serving them

@@ -51,12 +51,11 @@ library

5151 build-depends:

5252 base >= 4.7 && < 4.10

5353 , base-compat >= 0.9 && < 0.10

54− , aeson >= 0.7 && < 0.12

54+ , aeson >= 0.7 && < 1.1

5555 , attoparsec >= 0.12 && < 0.14

5656 , bytestring >= 0.10 && < 0.11

57− , bytestring-conversion >= 0.3 && < 0.4

5857 , case-insensitive >= 1.2 && < 1.3

59− , http-api-data >= 0.1 && < 0.3

58+ , http-api-data >= 0.3 && < 0.4

6059 , http-media >= 0.4 && < 0.7

6160 , http-types >= 0.8 && < 0.10

6261 , mtl >= 2.0 && < 2.3

servant/src/Servant/API.hs+4−4

@@ -8,7 +8,7 @@ module Servant.API (

88

99 -- * Accessing information from the request

1010 module Servant.API.Capture,

11− -- | Capturing parts of the url path as parsed values: @'Capture'@

11+ -- | Capturing parts of the url path as parsed values: @'Capture'@ and @'CaptureAll'@

1212 module Servant.API.Header,

1313 -- | Retrieving specific headers from the request

1414 module Servant.API.HttpVersion,

@@ -60,12 +60,12 @@ module Servant.API (

6060

6161import Servant.API.Alternative ((:<|>) (..))

6262import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))

63−import Servant.API.Capture (Capture)

63+import Servant.API.Capture (Capture, CaptureAll)

6464import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

65− FromFormUrlEncoded (..), JSON,

65+ JSON,

6666 MimeRender (..), NoContent (NoContent),

6767 MimeUnrender (..), OctetStream,

68− PlainText, ToFormUrlEncoded (..))

68+ PlainText)

6969import Servant.API.Experimental.Auth (AuthProtect)

7070import Servant.API.Header (Header (..))

7171import Servant.API.HttpVersion (HttpVersion (..))

servant/src/Servant/API/Capture.hs+14−1

@@ -2,7 +2,7 @@

22{-# LANGUAGE DeriveDataTypeable #-}

33{-# LANGUAGE PolyKinds #-}

44{-# OPTIONS_HADDOCK not-home #-}

5−module Servant.API.Capture (Capture) where

5+module Servant.API.Capture (Capture, CaptureAll) where

66

77import Data.Typeable (Typeable)

88import GHC.TypeLits (Symbol)

@@ -15,9 +15,22 @@ import GHC.TypeLits (Symbol)

1515data Capture (sym :: Symbol) a

1616 deriving (Typeable)

1717

18+

19+-- | Capture all remaining values from the request path under a certain type

20+-- @a@.

21+--

22+-- Example:

23+--

24+-- >>> -- GET /src/*

25+-- >>> type MyAPI = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile

26+data CaptureAll (sym :: Symbol) a

27+ deriving (Typeable)

28+

1829-- $setup

1930-- >>> import Servant.API

2031-- >>> import Data.Aeson

2132-- >>> import Data.Text

2233-- >>> data Book

2334-- >>> instance ToJSON Book where { toJSON = undefined }

35+-- >>> data SourceFile

36+-- >>> instance ToJSON SourceFile where { toJSON = undefined }

servant/src/Servant/API/ContentTypes.hs+9−55

@@ -66,8 +66,6 @@ module Servant.API.ContentTypes

6666 , AllMime(..)

6767 , AllMimeRender(..)

6868 , AllMimeUnrender(..)

69− , FromFormUrlEncoded(..)

70− , ToFormUrlEncoded(..)

7169 , eitherDecodeLenient

7270 , canHandleAcceptH

7371 ) where

@@ -82,10 +80,8 @@ import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,

8280import qualified Data.ByteString as BS

8381import Data.ByteString.Lazy (ByteString, fromStrict,

8482 toStrict)

85−import qualified Data.ByteString.Lazy as B

8683import qualified Data.ByteString.Lazy.Char8 as BC

8784import Data.Maybe (isJust)

88−import Data.Monoid.Compat

8985import Data.String.Conversions (cs)

9086import qualified Data.Text as TextS

9187import qualified Data.Text.Encoding as TextS

@@ -94,8 +90,9 @@ import qualified Data.Text.Lazy.Encoding as TextL

9490import Data.Typeable

9591import GHC.Generics (Generic)

9692import qualified Network.HTTP.Media as M

97−import Network.URI (escapeURIString,

98− isUnreserved, unEscapeString)

93+import Web.FormUrlEncoded (FromForm, ToForm,

94+ urlEncodeAsForm,

95+ urlDecodeAsForm)

9996import Prelude ()

10097import Prelude.Compat

10198

@@ -290,12 +287,12 @@ instance OVERLAPPABLE_

290287 ToJSON a => MimeRender JSON a where

291288 mimeRender _ = encode

292289

293−-- | @encodeFormUrlEncoded . toFormUrlEncoded@

290+-- | @urlEncodeAsForm@

294291-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

295292-- holds if every element of x is non-null (i.e., not @("", "")@)

296293instance OVERLAPPABLE_

297− ToFormUrlEncoded a => MimeRender FormUrlEncoded a where

298− mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded

294+ ToForm a => MimeRender FormUrlEncoded a where

295+ mimeRender _ = urlEncodeAsForm

299296

300297-- | `TextL.encodeUtf8`

301298instance MimeRender PlainText TextL.Text where

@@ -348,11 +345,11 @@ eitherDecodeLenient input =

348345instance FromJSON a => MimeUnrender JSON a where

349346 mimeUnrender _ = eitherDecodeLenient

350347

351−-- | @decodeFormUrlEncoded >=> fromFormUrlEncoded@

348+-- | @urlDecodeAsForm@

352349-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

353350-- holds if every element of x is non-null (i.e., not @("", "")@)

354−instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where

355− mimeUnrender _ = decodeFormUrlEncoded >=> fromFormUrlEncoded

351+instance FromForm a => MimeUnrender FormUrlEncoded a where

352+ mimeUnrender _ = left TextS.unpack . urlDecodeAsForm

356353

357354-- | @left show . TextL.decodeUtf8'@

358355instance MimeUnrender PlainText TextL.Text where

@@ -375,49 +372,6 @@ instance MimeUnrender OctetStream BS.ByteString where

375372 mimeUnrender _ = Right . toStrict

376373

377374

378−--------------------------------------------------------------------------

379−-- * FormUrlEncoded

380−

381−-- | A type that can be converted to @application/x-www-form-urlencoded@

382−class ToFormUrlEncoded a where

383− toFormUrlEncoded :: a -> [(TextS.Text, TextS.Text)]

384−

385−instance ToFormUrlEncoded [(TextS.Text, TextS.Text)] where

386− toFormUrlEncoded = id

387−

388−-- | A type that can be converted from @application/x-www-form-urlencoded@,

389−-- with the possibility of failure.

390−class FromFormUrlEncoded a where

391− fromFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> Either String a

392−

393−instance FromFormUrlEncoded [(TextS.Text, TextS.Text)] where

394− fromFormUrlEncoded = return

395−

396−encodeFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> ByteString

397−encodeFormUrlEncoded xs =

398− let escape :: TextS.Text -> ByteString

399− escape = cs . escapeURIString isUnreserved . cs

400− encodePair :: (TextS.Text, TextS.Text) -> ByteString

401− encodePair (k, "") = escape k

402− encodePair (k, v) = escape k <> "=" <> escape v

403− in B.intercalate "&" $ map encodePair xs

404−

405−decodeFormUrlEncoded :: ByteString -> Either String [(TextS.Text, TextS.Text)]

406−decodeFormUrlEncoded "" = return []

407−decodeFormUrlEncoded q = do

408− let xs :: [TextS.Text]

409− xs = TextS.splitOn "&" . cs $ q

410− parsePair :: TextS.Text -> Either String (TextS.Text, TextS.Text)

411− parsePair p =

412− case TextS.splitOn "=" p of

413− [k,v] -> return ( unescape k

414− , unescape v

415− )

416− [k] -> return ( unescape k, "" )

417− _ -> Left $ "not a valid pair: " <> cs p

418− unescape :: TextS.Text -> TextS.Text

419− unescape = cs . unEscapeString . cs . TextS.intercalate "%20" . TextS.splitOn "+"

420− mapM parsePair xs

421375

422376-- $setup

423377-- >>> import Servant.API

servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs+11−4

@@ -13,6 +13,13 @@ import Servant.API

1313type GET = Get '[JSON] NoContent

1414

1515type ComprehensiveAPI =

16+ ComprehensiveAPIWithoutRaw :<|>

17+ Raw

18+

19+comprehensiveAPI :: Proxy ComprehensiveAPI

20+comprehensiveAPI = Proxy

21+

22+type ComprehensiveAPIWithoutRaw =

1623 GET :<|>

1724 Get '[JSON] Int :<|>

1825 Capture "foo" Int :> GET :<|>

@@ -22,7 +29,6 @@ type ComprehensiveAPI =

2229 QueryParam "foo" Int :> GET :<|>

2330 QueryParams "foo" Int :> GET :<|>

2431 QueryFlag "foo" :> GET :<|>

25−-- Raw :<|>

2632 RemoteHost :> GET :<|>

2733 ReqBody '[JSON] Int :> GET :<|>

2834 Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>

@@ -30,7 +36,8 @@ type ComprehensiveAPI =

3036 Vault :> GET :<|>

3137 Verb 'POST 204 '[JSON] NoContent :<|>

3238 Verb 'POST 204 '[JSON] Int :<|>

33− WithNamedContext "foo" '[] GET

39+ WithNamedContext "foo" '[] GET :<|>

40+ CaptureAll "foo" Int :> GET

3441

35−comprehensiveAPI :: Proxy ComprehensiveAPI

36−comprehensiveAPI = Proxy

42+comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw

43+comprehensiveAPIWithoutRaw = Proxy

servant/src/Servant/API/IsSecure.hs+3−1

@@ -1,10 +1,12 @@

11{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveGeneric #-}

23module Servant.API.IsSecure

34 ( -- $issecure

45 IsSecure(..)

56 ) where

67

78import Data.Typeable

9+import GHC.Generics (Generic)

810

911-- | Was this request made over an SSL connection?

1012--

@@ -19,7 +21,7 @@ data IsSecure = Secure -- ^ the connection to the server

1921 -- is secure (HTTPS)

2022 | NotSecure -- ^ the connection to the server

2123 -- is not secure (HTTP)

22− deriving Typeable

24+ deriving (Eq, Show, Read, Generic, Ord, Typeable)

2325

2426-- $issecure

2527--

servant/src/Servant/API/ResponseHeaders.hs+12−12

@@ -31,8 +31,8 @@ module Servant.API.ResponseHeaders

3131 ) where

3232

3333import Data.ByteString.Char8 as BS (pack, unlines, init)

34−import Data.ByteString.Conversion (ToByteString, toByteString',

35− FromByteString, fromByteString)

34+import Web.HttpApiData (ToHttpApiData, toHeader,

35+ FromHttpApiData, parseHeader)

3636import qualified Data.CaseInsensitive as CI

3737import Data.Proxy

3838import GHC.TypeLits (KnownSymbol, symbolVal)

@@ -68,17 +68,17 @@ class BuildHeadersTo hs where

6868instance OVERLAPPING_ BuildHeadersTo '[] where

6969 buildHeadersTo _ = HNil

7070

71−instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h )

71+instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )

7272 => BuildHeadersTo ((Header h v) ': xs) where

7373 buildHeadersTo headers =

7474 let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)

7575 matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers

7676 in case matching of

7777 [] -> MissingHeader `HCons` buildHeadersTo headers

78− xs -> case fromByteString (BS.init $ BS.unlines xs) of

79− Nothing -> UndecodableHeader (BS.init $ BS.unlines xs)

78+ xs -> case parseHeader (BS.init $ BS.unlines xs) of

79+ Left _err -> UndecodableHeader (BS.init $ BS.unlines xs)

8080 `HCons` buildHeadersTo headers

81− Just h -> Header h `HCons` buildHeadersTo headers

81+ Right h -> Header h `HCons` buildHeadersTo headers

8282

8383-- * Getting

8484

@@ -88,18 +88,18 @@ class GetHeaders ls where

8888instance OVERLAPPING_ GetHeaders (HList '[]) where

8989 getHeaders _ = []

9090

91−instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) )

91+instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) )

9292 => GetHeaders (HList (Header h x ': xs)) where

9393 getHeaders hdrs = case hdrs of

94− Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest

95− UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest

94+ Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest

95+ UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest

9696 MissingHeader `HCons` rest -> getHeaders rest

9797 where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)

9898

9999instance OVERLAPPING_ GetHeaders (Headers '[] a) where

100100 getHeaders _ = []

101101

102−instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v )

102+instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )

103103 => GetHeaders (Headers (Header h v ': rest) a) where

104104 getHeaders hs = getHeaders $ getHeadersHList hs

105105

@@ -111,11 +111,11 @@ class AddHeader h v orig new

111111 addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times

112112

113113

114−instance OVERLAPPING_ ( KnownSymbol h, ToByteString v )

114+instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v )

115115 => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where

116116 addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)

117117

118−instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v

118+instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v

119119 , new ~ (Headers '[Header h v] a) )

120120 => AddHeader h v a new where

121121 addHeader a resp = Headers resp (HCons (Header a) HNil)

servant/src/Servant/Utils/Links.hs+10−1

@@ -107,7 +107,7 @@ import Prelude.Compat

107107

108108import Web.HttpApiData

109109import Servant.API.BasicAuth ( BasicAuth )

110−import Servant.API.Capture ( Capture )

110+import Servant.API.Capture ( Capture, CaptureAll )

111111import Servant.API.ReqBody ( ReqBody )

112112import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )

113113import Servant.API.Header ( Header )

@@ -163,6 +163,8 @@ type family IsElem endpoint api :: Constraint where

163163 IsElem sa (ReqBody y x :> sb) = IsElem sa sb

164164 IsElem (Capture z y :> sa) (Capture x y :> sb)

165165 = IsElem sa sb

166+ IsElem (CaptureAll z y :> sa) (CaptureAll x y :> sb)

167+ = IsElem sa sb

166168 IsElem sa (QueryParam x y :> sb) = IsElem sa sb

167169 IsElem sa (QueryParams x y :> sb) = IsElem sa sb

168170 IsElem sa (QueryFlag x :> sb) = IsElem sa sb

@@ -284,6 +286,13 @@ instance (ToHttpApiData v, HasLink sub)

284286 toLink (Proxy :: Proxy sub) $

285287 addSegment (escape . Text.unpack $ toUrlPiece v) l

286288

289+instance (ToHttpApiData v, HasLink sub)

290+ => HasLink (CaptureAll sym v :> sub) where

291+ type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub

292+ toLink _ l vs =

293+ toLink (Proxy :: Proxy sub) $

294+ foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs

295+

287296instance HasLink sub => HasLink (Header sym a :> sub) where

288297 type MkLink (Header sym a :> sub) = MkLink sub

289298 toLink _ = toLink (Proxy :: Proxy sub)

servant/test/Servant/API/ContentTypesSpec.hs−17

@@ -11,7 +11,6 @@ module Servant.API.ContentTypesSpec where

1111import Prelude ()

1212import Prelude.Compat

1313

14−import Control.Arrow

1514import Data.Aeson

1615import Data.ByteString.Char8 (ByteString, append, pack)

1716import qualified Data.ByteString.Lazy as BSL

@@ -25,7 +24,6 @@ import Data.String.Conversions (cs)

2524import qualified Data.Text as TextS

2625import qualified Data.Text.Lazy as TextL

2726import GHC.Generics

28−import Network.URL (exportParams, importParams)

2927import Test.Hspec

3028import Test.QuickCheck

3129import "quickcheck-instances" Test.QuickCheck.Instances ()

@@ -68,21 +66,6 @@ spec = describe "Servant.API.ContentTypes" $ do

6866 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do

6967 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)

7068

71− describe "The FormUrlEncoded Content-Type type" $ do

72− let p = Proxy :: Proxy FormUrlEncoded

73−

74− it "has mimeUnrender reverse mimeRender" $ do

75− property $ \x -> mempty `notElem` x

76− ==> mimeUnrender p (mimeRender p x) == Right (x::[(TextS.Text,TextS.Text)])

77−

78− it "has mimeUnrender reverse exportParams (Network.URL)" $ do

79− property $ \x -> mempty `notElem` x

80− ==> (mimeUnrender p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])

81−

82− it "has importParams (Network.URL) reverse mimeRender" $ do

83− property $ \x -> mempty `notElem` x

84− ==> (fmap (map (cs *** cs)) . importParams . cs . mimeRender p $ x) == Just (x::[(TextS.Text,TextS.Text)])

85−

8669 describe "The PlainText Content-Type type" $ do

8770 let p = Proxy :: Proxy PlainText

8871

servant/test/Servant/Utils/LinksSpec.hs+5

@@ -13,6 +13,7 @@ import Servant.API

1313type TestApi =

1414 -- Capture and query params

1515 "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent

16+ :<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent

1617

1718 -- Flags

1819 :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] NoContent

@@ -46,6 +47,10 @@ spec = describe "Servant.Utils.Links" $ do

4647 :> Delete '[JSON] NoContent)

4748 apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"

4849

50+ it "generates correct links for CaptureAll" $ do

51+ apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))

52+ ["roads", "lead", "to", "rome"]

53+ `shouldBeURI` "all/roads/lead/to/rome"

4954

5055 it "generates correct links for query flags" $ do

5156 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"

sources.txt−1

@@ -4,4 +4,3 @@ servant-client

44servant-docs

55servant-foreign

66servant-js

7−servant-mock

stack-ghc-7.8.4.yaml+2−6

@@ -5,7 +5,6 @@ packages:

55- servant-docs/

66- servant-foreign/

77- servant-js/

8−- servant-mock/

98- servant-server/

109extra-deps:

1110- base-compat-0.9.1

@@ -16,13 +15,10 @@ extra-deps:

1615- hspec-core-2.2.3

1716- hspec-discover-2.2.3

1817- hspec-expectations-0.7.2

19−- http-api-data-0.2.2

18+- http-api-data-0.3

2019- primitive-0.6.1.0

21−- servant-0.7.1

22−- servant-client-0.7.1

23−- servant-docs-0.7.1

24−- servant-server-0.7.1

2520- should-not-typecheck-2.1.0

2621- time-locale-compat-0.1.1.1

22+- uri-bytestring-0.2.2.0

2723- wai-app-static-3.1.5

2824resolver: lts-2.22

stack-ghc-8.0.1.yaml+3−2

@@ -5,7 +5,8 @@ packages:

55- servant-docs/

66- servant-foreign/

77- servant-js/

8−- servant-mock/

98- servant-server/

10−extra-deps: []

9+extra-deps:

10+- http-api-data-0.3

11+- uri-bytestring-0.2.2.0

1112flags: {}

stack.yaml+1−1

@@ -5,8 +5,8 @@ packages:

55- servant-docs/

66- servant-foreign/

77- servant-js/

8−- servant-mock/

98- servant-server/

109- doc/tutorial

1110extra-deps:

11+- http-api-data-0.3

1212resolver: lts-6.0