f39d57c · typeable/servant

git.iko.soy/typeable/servant

add HttpVersion, IsSecure, RemoteHost and Vault combinators with instances for all interpretations (all but the server ones being 'ignore that combinator')

tighter version bounds for network cleanup document the new combinators servant-server: add some tests for HttpVersion, IsSecure, RemoteHost and Vault update changelogs address Julian's feedback remove vault test in servant-server servant-server tests: -Werror friendly

commitf39d57c6b3a964de34a3a51eefb7ae93e7279651 authorAlp Mestanogullari <alpmestan@gmail.com> dateTue 23 Jun 2015, 10:34 (11 years ago) parent490a84c

17 files changed+271−12

compare with master

unifiedsplit

servant-client/CHANGELOG.md+5 servant-client/src/Servant/Client.hs+17 servant-docs/CHANGELOG.md+5 servant-docs/src/Servant/Docs/Internal.hs+15 servant-jquery/CHANGELOG.md+5 servant-jquery/src/Servant/JQuery/Internal.hs+24 servant-server/CHANGELOG.md+5 servant-server/servant-server.cabal+2 servant-server/src/Servant/Server/Internal.hs+34−6 servant-server/test/Servant/ServerSpec.hs+36−3 servant/CHANGELOG.md+5 servant/servant.cabal+5 servant/src/Servant/API.hs+12−3 servant/src/Servant/API/HttpVersion.hs+19 servant/src/Servant/API/IsSecure.hs+37 servant/src/Servant/API/RemoteHost.hs+25 servant/src/Servant/API/Vault.hs+20

servant-client/CHANGELOG.md+5

@@ -1,3 +1,8 @@

1+HEAD

2+----

4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

160.4.1

27-----

38* The `HasClient` instance for `Delete cts ()` now does not care at all about content types provided.

servant-client/src/Servant/Client.hs+17

@@ -669,3 +669,20 @@ instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout

669669

670670 where p = symbolVal (Proxy :: Proxy path)

671671

672+instance HasClient api => HasClient (Vault :> api) where

673+ type Client (Vault :> api) = Client api

674+

675+ clientWithRoute Proxy req baseurl =

676+ clientWithRoute (Proxy :: Proxy api) req baseurl

677+

678+instance HasClient api => HasClient (RemoteHost :> api) where

679+ type Client (RemoteHost :> api) = Client api

680+

681+ clientWithRoute Proxy req baseurl =

682+ clientWithRoute (Proxy :: Proxy api) req baseurl

683+

684+instance HasClient api => HasClient (IsSecure :> api) where

685+ type Client (IsSecure :> api) = Client api

686+

687+ clientWithRoute Proxy req baseurl =

688+ clientWithRoute (Proxy :: Proxy api) req baseurl

servant-docs/CHANGELOG.md+5

@@ -1,3 +1,8 @@

1+HEAD

2+----

4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

160.4

27---

38* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body

servant-docs/src/Servant/Docs/Internal.hs+15

@@ -900,3 +900,18 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh

900900 endpoint' = endpoint & path <>~ [symbolVal pa]

901901 pa = Proxy :: Proxy path

902902

903+instance HasDocs sublayout => HasDocs (RemoteHost :> sublayout) where

904+ docsFor Proxy ep =

905+ docsFor (Proxy :: Proxy sublayout) ep

906+

907+instance HasDocs sublayout => HasDocs (IsSecure :> sublayout) where

908+ docsFor Proxy ep =

909+ docsFor (Proxy :: Proxy sublayout) ep

910+

911+instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where

912+ docsFor Proxy ep =

913+ docsFor (Proxy :: Proxy sublayout) ep

914+

915+instance HasDocs sublayout => HasDocs (Vault :> sublayout) where

916+ docsFor Proxy ep =

917+ docsFor (Proxy :: Proxy sublayout) ep

servant-jquery/CHANGELOG.md+5

@@ -1,3 +1,8 @@

1+HEAD

2+----

4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

160.4

27---

38* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body

servant-jquery/src/Servant/JQuery/Internal.hs+24

@@ -338,3 +338,27 @@ instance (KnownSymbol path, HasJQ sublayout)

338338 & funcName %~ (str <>)

339339

340340 where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)

341+

342+instance HasJQ sublayout => HasJQ (RemoteHost :> sublayout) where

343+ type JQ (RemoteHost :> sublayout) = JQ sublayout

344+

345+ jqueryFor Proxy req =

346+ jqueryFor (Proxy :: Proxy sublayout) req

347+

348+instance HasJQ sublayout => HasJQ (IsSecure :> sublayout) where

349+ type JQ (IsSecure :> sublayout) = JQ sublayout

350+

351+ jqueryFor Proxy req =

352+ jqueryFor (Proxy :: Proxy sublayout) req

353+

354+instance HasJQ sublayout => HasJQ (Vault :> sublayout) where

355+ type JQ (Vault :> sublayout) = JQ sublayout

356+

357+ jqueryFor Proxy req =

358+ jqueryFor (Proxy :: Proxy sublayout) req

359+

360+instance HasJQ sublayout => HasJQ (HttpVersion :> sublayout) where

361+ type JQ (HttpVersion :> sublayout) = JQ sublayout

362+

363+ jqueryFor Proxy req =

364+ jqueryFor (Proxy :: Proxy sublayout) req

servant-server/CHANGELOG.md+5

@@ -1,3 +1,8 @@

1+HEAD

2+----

4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

160.4.1

27-----

38* Bump attoparsec upper bound to < 0.14

servant-server/servant-server.cabal+2

@@ -52,6 +52,7 @@ library

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

5353 , mtl >= 2 && < 3

5454 , mmorph >= 1

55+ , network >= 2.6 && < 2.7

5556 , safe >= 0.3 && < 0.4

5657 , servant == 0.4.*

5758 , split >= 0.2 && < 0.3

@@ -63,6 +64,7 @@ library

6364 , wai >= 3.0 && < 3.1

6465 , wai-app-static >= 3.0 && < 3.2

6566 , warp >= 3.0 && < 3.1

67+

6668 hs-source-dirs: src

6769 default-language: Haskell2010

6870 ghc-options: -Wall

servant-server/src/Servant/Server/Internal.hs+34−6

@@ -35,15 +35,17 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)

3535import Data.Typeable

3636import GHC.TypeLits (KnownSymbol, symbolVal)

3737import Network.HTTP.Types hiding (Header, ResponseHeaders)

38+import Network.Socket (SockAddr)

3839import Network.Wai (Application, lazyRequestBody,

3940 rawQueryString, requestHeaders,

40− requestMethod, responseLBS)

41+ requestMethod, responseLBS, remoteHost,

42+ isSecure, vault, httpVersion)

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

42− Delete, Get, Header,

43− MatrixFlag, MatrixParam, MatrixParams,

44− Patch, Post, Put, QueryFlag,

45− QueryParam, QueryParams, Raw,

46− ReqBody)

44+ Delete, Get, Header,

45+ IsSecure(..), MatrixFlag, MatrixParam,

46+ MatrixParams, Patch, Post, Put,

47+ QueryFlag, QueryParam, QueryParams,

48+ Raw, RemoteHost, ReqBody, Vault)

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

4850 AllCTRender (..),

4951 AllCTUnrender (..))

@@ -721,5 +723,31 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout

721723 (route (Proxy :: Proxy sublayout) subserver)

722724 where proxyPath = Proxy :: Proxy path

723725

726+instance HasServer api => HasServer (RemoteHost :> api) where

727+ type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m

728+

729+ route Proxy subserver = WithRequest $ \req ->

730+ route (Proxy :: Proxy api) (feedTo subserver $ remoteHost req)

731+

732+instance HasServer api => HasServer (IsSecure :> api) where

733+ type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m

734+

735+ route Proxy subserver = WithRequest $ \req ->

736+ route (Proxy :: Proxy api) (feedTo subserver $ secure req)

737+

738+ where secure req = if isSecure req then Secure else NotSecure

739+

740+instance HasServer api => HasServer (Vault :> api) where

741+ type ServerT (Vault :> api) m = Vault -> ServerT api m

742+

743+ route Proxy subserver = WithRequest $ \req ->

744+ route (Proxy :: Proxy api) (feedTo subserver $ vault req)

745+

746+instance HasServer api => HasServer (HttpVersion :> api) where

747+ type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m

748+

749+ route Proxy subserver = WithRequest $ \req ->

750+ route (Proxy :: Proxy api) (feedTo subserver $ httpVersion req)

751+

724752ct_wildcard :: B.ByteString

725753ct_wildcard = "*" <> "/" <> "*" -- Because CPP

servant-server/test/Servant/ServerSpec.hs+36−3

@@ -37,9 +37,9 @@ import Test.Hspec.Wai (get, liftIO, matchHeaders,

3737import Servant.API ((:<|>) (..), (:>),

3838 addHeader, Capture,

3939 Delete, Get, Header (..), Headers,

40− JSON, MatrixFlag, MatrixParam,

41− MatrixParams, Patch, PlainText,

42− Post, Put, QueryFlag, QueryParam,

40+ HttpVersion, IsSecure(..), JSON, MatrixFlag,

41+ MatrixParam, MatrixParams, Patch, PlainText,

42+ Post, Put, RemoteHost, QueryFlag, QueryParam,

4343 QueryParams, Raw, ReqBody)

4444import Servant.Server (Server, serve, ServantErr(..), err404)

4545import Servant.Server.Internal.RoutingApplication

@@ -93,6 +93,7 @@ spec = do

9393 prioErrorsSpec

9494 errorsSpec

9595 responseHeadersSpec

96+ miscReqCombinatorsSpec

9697

9798

9899type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal

@@ -667,3 +668,35 @@ errorsSpec = do

667668 nf <> he `shouldBe` he

668669 nf <> ib `shouldBe` ib

669670 nf <> wm `shouldBe` wm

671+

672+type MiscCombinatorsAPI

673+ = "version" :> HttpVersion :> Get '[JSON] String

674+ :<|> "secure" :> IsSecure :> Get '[JSON] String

675+ :<|> "host" :> RemoteHost :> Get '[JSON] String

676+

677+miscApi :: Proxy MiscCombinatorsAPI

678+miscApi = Proxy

679+

680+miscServ :: Server MiscCombinatorsAPI

681+miscServ = versionHandler

682+ :<|> secureHandler

683+ :<|> hostHandler

684+

685+ where versionHandler = return . show

686+ secureHandler Secure = return "secure"

687+ secureHandler NotSecure = return "not secure"

688+ hostHandler = return . show

689+

690+miscReqCombinatorsSpec :: Spec

691+miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $

692+ describe "Misc. combinators for request inspection" $ do

693+ it "Successfully gets the HTTP version specified in the request" $

694+ go "/version" "\"HTTP/1.0\""

695+

696+ it "Checks that hspec-wai uses HTTP, not HTTPS" $

697+ go "/secure" "\"not secure\""

698+

699+ it "Checks that hspec-wai issues request from 0.0.0.0" $

700+ go "/host" "\"0.0.0.0:0\""

701+

702+ where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res

servant/CHANGELOG.md+5

@@ -1,3 +1,8 @@

1+HEAD

2+----

4+* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

160.4.2

27-----

38* Fix missing cases for `Patch` in `safeLink`

servant/servant.cabal+5

@@ -34,15 +34,19 @@ library

3434 Servant.API.Delete

3535 Servant.API.Get

3636 Servant.API.Header

37+ Servant.API.HttpVersion

38+ Servant.API.IsSecure

3739 Servant.API.Patch

3840 Servant.API.Post

3941 Servant.API.Put

4042 Servant.API.QueryParam

4143 Servant.API.MatrixParam

4244 Servant.API.Raw

45+ Servant.API.RemoteHost

4346 Servant.API.ReqBody

4447 Servant.API.ResponseHeaders

4548 Servant.API.Sub

49+ Servant.API.Vault

4650 Servant.Common.Text

4751 Servant.Utils.Links

4852 build-depends:

@@ -57,6 +61,7 @@ library

5761 , text >= 1 && < 2

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

5963 , network-uri >= 2.6

64+ , vault >= 0.3 && <0.4

6065 hs-source-dirs: src

6166 default-language: Haskell2010

6267 other-extensions: CPP

servant/src/Servant/API.hs+12−3

@@ -1,6 +1,3 @@

1−{-# LANGUAGE TypeFamilies #-}

2−{-# LANGUAGE TypeOperators #-}

3−{-# LANGUAGE UndecidableInstances #-}

41module Servant.API (

63 -- * Combinators

@@ -14,12 +11,20 @@ module Servant.API (

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

1512 module Servant.API.Header,

1613 -- | Retrieving specific headers from the request

14+ module Servant.API.HttpVersion,

15+ -- | Retrieving the HTTP version of the request

1716 module Servant.API.QueryParam,

1817 -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@

1918 module Servant.API.ReqBody,

2019 -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@

2120 module Servant.API.MatrixParam,

2221 -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@

22+ module Servant.API.RemoteHost,

23+ -- | Retrieving the IP of the client

24+ module Servant.API.IsSecure,

25+ -- | Is the request made through HTTPS?

26+ module Servant.API.Vault,

27+ -- | Access the location for arbitrary data to be shared by applications and middleware

2328

2429 -- * Actual endpoints, distinguished by HTTP method

2530 module Servant.API.Get,

@@ -64,6 +69,8 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,

6469import Servant.API.Delete (Delete)

6570import Servant.API.Get (Get)

6671import Servant.API.Header (Header (..))

72+import Servant.API.HttpVersion (HttpVersion(..))

73+import Servant.API.IsSecure (IsSecure(..))

6774import Servant.API.MatrixParam (MatrixFlag, MatrixParam,

6875 MatrixParams)

6976import Servant.API.Patch (Patch)

@@ -72,6 +79,7 @@ import Servant.API.Put (Put)

7279import Servant.API.QueryParam (QueryFlag, QueryParam,

7380 QueryParams)

7481import Servant.API.Raw (Raw)

82+import Servant.API.RemoteHost (RemoteHost)

7583import Servant.API.ReqBody (ReqBody)

7684import Servant.API.ResponseHeaders (AddHeader (addHeader),

7785 BuildHeadersTo (buildHeadersTo),

@@ -79,6 +87,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),

7987 HList (..), Headers (..),

8088 getHeadersHList, getResponse)

8189import Servant.API.Sub ((:>))

90+import Servant.API.Vault (Vault)

8291import Servant.Common.Text (FromText (..), ToText (..))

8392import Servant.Utils.Links (HasLink (..), IsElem, IsElem',

8493 URI (..), safeLink)

servant/src/Servant/API/HttpVersion.hsnew file+19

@@ -0,0 +1,19 @@

1+module Servant.API.HttpVersion

2+ ( -- $httpversion

3+ HttpVersion(..)

4+ ) where

6+import Network.HTTP.Types (HttpVersion(..))

8+-- $httpversion

9+--

10+-- | You can directly use the 'HttpVersion' type from @Network.HTTP.Types@

11+-- if your request handlers need it to compute a response. This would

12+-- make the request handlers take an argument of type 'HttpVersion'.

13+--

14+-- Example:

15+--

16+-- >>> type API = HttpVersion :> Get '[JSON] String

17+

18+-- $setup

19+-- >>> import Servant.API

servant/src/Servant/API/IsSecure.hsnew file+37

@@ -0,0 +1,37 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+module Servant.API.IsSecure

3+ ( -- $issecure

4+ IsSecure(..)

5+ ) where

7+import Data.Typeable

9+-- | Was this request made over an SSL connection?

10+--

11+-- Note that this value will not tell you if the client originally

12+-- made this request over SSL, but rather whether the current

13+-- connection is SSL. The distinction lies with reverse proxies.

14+-- In many cases, the client will connect to a load balancer over SSL,

15+-- but connect to the WAI handler without SSL. In such a case,

16+-- the handlers would get 'NotSecure', but from a user perspective,

17+-- there is a secure connection.

18+data IsSecure = Secure -- ^ the connection to the server

19+ -- is secure (HTTPS)

20+ | NotSecure -- ^ the connection to the server

21+ -- is not secure (HTTP)

22+ deriving Typeable

23+

24+-- $issecure

25+--

26+-- | Use 'IsSecure' whenever your request handlers need to know whether

27+-- the connection to the server is secure or not.

28+-- This would make the request handlers receive an argument of type 'IsSecure',

29+-- whose value can be one of 'Secure' (HTTPS) or 'NotSecure' (HTTP).

30+--

31+-- Example:

32+--

33+-- >>> type API = "sensitive-data" :> IsSecure :> Get '[JSON] NationSecrets

34+

35+-- $setup

36+-- >>> import Servant.API

37+-- >>> data NationSecrets

servant/src/Servant/API/RemoteHost.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+module Servant.API.RemoteHost

3+ ( -- $remotehost

4+ RemoteHost

5+ ) where

7+import Data.Typeable

9+-- | Provides access to the host or IP address

10+-- from which the HTTP request was sent.

11+data RemoteHost deriving Typeable

12+

13+-- $remotehost

14+--

15+-- | Use 'RemoteHost' whenever your request handlers need the host or IP address

16+-- from which the client issued the HTTP request. The corresponding handlers

17+-- receive arguments of type @SockAddr@ (from @Network.Socket@).

18+--

19+-- Example:

20+--

21+-- >>> -- POST /record-ip

22+-- >>> type API = "record-ip" :> RemoteHost :> Post '[] ()

23+

24+-- $setup

25+-- >>> import Servant.API

servant/src/Servant/API/Vault.hsnew file+20

@@ -0,0 +1,20 @@

1+module Servant.API.Vault

2+ ( -- $vault

3+ Vault

4+ ) where

6+import Data.Vault.Lazy (Vault)

8+-- $vault

9+--

10+-- | Use 'Vault' in your API types to provide access to the 'Vault'

11+-- of the request, which is a location shared by middlewares and applications

12+-- to store arbitrary data. See 'Vault' for more details on how to actually

13+-- use the vault in your handlers

14+--

15+-- Example:

16+--

17+-- >>> type API = Vault :> Get '[JSON] String

18+

19+-- $setup

20+-- >>> import Servant.API