git.iko.soy/typeable/servant
on master help sign in
Merge pull request #141 from haskell-servant/new-combinators

Add HttpVersion, IsSecure, RemoteHost and Vault combinators with inst…

commit3209f98985208a5632bf540ba2a9ce2a711dbd02 authorAlp Mestanogullari <alpmestan@gmail.com> dateFri 10 Jul 2015, 15:00 (11 years ago) parente450e53f39d57c
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+----
3+
4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
5+
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+----
3+
4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
5+
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+----
3+
4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
5+
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+----
3+
4+* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
5+
160.4.1
27-----
38* Bump attoparsec upper bound to < 0.14
servant-server/servant-server.cabal+2
@@ -53,6 +53,7 @@ library
5353 , network-uri >= 2.6 && < 2.7
5454 , mtl >= 2 && < 3
5555 , mmorph >= 1
56+ , network >= 2.6 && < 2.7
5657 , safe >= 0.3 && < 0.4
5758 , servant == 0.4.*
5859 , split >= 0.2 && < 0.3
@@ -64,6 +65,7 @@ library
6465 , wai >= 3.0 && < 3.1
6566 , wai-app-static >= 3.0 && < 3.2
6667 , warp >= 3.0 && < 3.1
68+
6769 hs-source-dirs: src
6870 default-language: Haskell2010
6971 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+----
3+
4+* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
5+
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 (
52
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
5+
6+import Network.HTTP.Types (HttpVersion(..))
7+
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
6+
7+import Data.Typeable
8+
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
6+
7+import Data.Typeable
8+
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
5+
6+import Data.Vault.Lazy (Vault)
7+
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