eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge pull request #141 from haskell-servant/new-combinators

Browse Source 
Add HttpVersion, IsSecure, RemoteHost and Vault combinators with inst…
This commit is contained in:
Alp Mestanogullari 2015-07-10 15:00:19 +02:00
commit 3209f98985
17 changed files with 271 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
servant-client/CHANGELOG.md
View File

@ -1,3 +1,8 @@
HEAD
----
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
0.4.1
-----
* The `HasClient` instance for `Delete cts ()` now does not care at all about content types provided.

17
servant-client/src/Servant/Client.hs
View File

@ -669,3 +669,20 @@ instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout
where p = symbolVal (Proxy :: Proxy path)
instance HasClient api => HasClient (Vault :> api) where
type Client (Vault :> api) = Client api
clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy api) req baseurl
instance HasClient api => HasClient (RemoteHost :> api) where
type Client (RemoteHost :> api) = Client api
clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy api) req baseurl
instance HasClient api => HasClient (IsSecure :> api) where
type Client (IsSecure :> api) = Client api
clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy api) req baseurl

5
servant-docs/CHANGELOG.md
View File

@ -1,3 +1,8 @@
HEAD
----
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
0.4
---
* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body

15
servant-docs/src/Servant/Docs/Internal.hs
View File

@ -900,3 +900,18 @@ instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) wh
endpoint' = endpoint & path <>~ [symbolVal pa]
pa = Proxy :: Proxy path
instance HasDocs sublayout => HasDocs (RemoteHost :> sublayout) where
docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep
instance HasDocs sublayout => HasDocs (IsSecure :> sublayout) where
docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep
instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where
docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep
instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
docsFor Proxy ep =
docsFor (Proxy :: Proxy sublayout) ep

5
servant-jquery/CHANGELOG.md
View File

@ -1,3 +1,8 @@
HEAD
----
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
0.4
---
* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body

24
servant-jquery/src/Servant/JQuery/Internal.hs
View File

@ -338,3 +338,27 @@ instance (KnownSymbol path, HasJQ sublayout)
& funcName %~ (str <>)
where str = map (\c -> if c == '.' then '_' else c) $ symbolVal (Proxy :: Proxy path)
instance HasJQ sublayout => HasJQ (RemoteHost :> sublayout) where
type JQ (RemoteHost :> sublayout) = JQ sublayout
jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) req
instance HasJQ sublayout => HasJQ (IsSecure :> sublayout) where
type JQ (IsSecure :> sublayout) = JQ sublayout
jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) req
instance HasJQ sublayout => HasJQ (Vault :> sublayout) where
type JQ (Vault :> sublayout) = JQ sublayout
jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) req
instance HasJQ sublayout => HasJQ (HttpVersion :> sublayout) where
type JQ (HttpVersion :> sublayout) = JQ sublayout
jqueryFor Proxy req =
jqueryFor (Proxy :: Proxy sublayout) req

5
servant-server/CHANGELOG.md
View File

@ -1,3 +1,8 @@
HEAD
----
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
0.4.1
-----
* Bump attoparsec upper bound to < 0.14

2
servant-server/servant-server.cabal
View File

@ -53,6 +53,7 @@ library
, network-uri >= 2.6 && < 2.7
, mtl >= 2 && < 3
, mmorph >= 1
, network >= 2.6 && < 2.7
, safe >= 0.3 && < 0.4
, servant == 0.4.*
, split >= 0.2 && < 0.3
@ -64,6 +65,7 @@ library
, wai >= 3.0 && < 3.1
, wai-app-static >= 3.0 && < 3.2
, warp >= 3.0 && < 3.1
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall

40
servant-server/src/Servant/Server/Internal.hs
View File

@ -35,15 +35,17 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Typeable
import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types hiding (Header, ResponseHeaders)
import Network.Socket (SockAddr)
import Network.Wai (Application, lazyRequestBody,
rawQueryString, requestHeaders,
requestMethod, responseLBS)
requestMethod, responseLBS, remoteHost,
isSecure, vault, httpVersion)
import Servant.API ((:<|>) (..), (:>), Capture,
Delete, Get, Header,
MatrixFlag, MatrixParam, MatrixParams,
Patch, Post, Put, QueryFlag,
QueryParam, QueryParams, Raw,
ReqBody)
Delete, Get, Header,
IsSecure(..), MatrixFlag, MatrixParam,
MatrixParams, Patch, Post, Put,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody, Vault)
import Servant.API.ContentTypes (AcceptHeader (..),
AllCTRender (..),
AllCTUnrender (..))
@ -721,5 +723,31 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
(route (Proxy :: Proxy sublayout) subserver)
where proxyPath = Proxy :: Proxy path
instance HasServer api => HasServer (RemoteHost :> api) where
type ServerT (RemoteHost :> api) m = SockAddr -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (feedTo subserver $ remoteHost req)
instance HasServer api => HasServer (IsSecure :> api) where
type ServerT (IsSecure :> api) m = IsSecure -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (feedTo subserver $ secure req)
where secure req = if isSecure req then Secure else NotSecure
instance HasServer api => HasServer (Vault :> api) where
type ServerT (Vault :> api) m = Vault -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (feedTo subserver $ vault req)
instance HasServer api => HasServer (HttpVersion :> api) where
type ServerT (HttpVersion :> api) m = HttpVersion -> ServerT api m
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (feedTo subserver $ httpVersion req)
ct_wildcard :: B.ByteString
ct_wildcard = "*" <> "/" <> "*" -- Because CPP

39
servant-server/test/Servant/ServerSpec.hs
View File

@ -37,9 +37,9 @@ import Test.Hspec.Wai (get, liftIO, matchHeaders,
import Servant.API ((:<|>) (..), (:>),
addHeader, Capture,
Delete, Get, Header (..), Headers,
JSON, MatrixFlag, MatrixParam,
MatrixParams, Patch, PlainText,
Post, Put, QueryFlag, QueryParam,
HttpVersion, IsSecure(..), JSON, MatrixFlag,
MatrixParam, MatrixParams, Patch, PlainText,
Post, Put, RemoteHost, QueryFlag, QueryParam,
QueryParams, Raw, ReqBody)
import Servant.Server (Server, serve, ServantErr(..), err404)
import Servant.Server.Internal.RoutingApplication
@ -93,6 +93,7 @@ spec = do
prioErrorsSpec
errorsSpec
responseHeadersSpec
miscReqCombinatorsSpec
type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
@ -667,3 +668,35 @@ errorsSpec = do
nf <> he `shouldBe` he
nf <> ib `shouldBe` ib
nf <> wm `shouldBe` wm
type MiscCombinatorsAPI
= "version" :> HttpVersion :> Get '[JSON] String
:<|> "secure" :> IsSecure :> Get '[JSON] String
:<|> "host" :> RemoteHost :> Get '[JSON] String
miscApi :: Proxy MiscCombinatorsAPI
miscApi = Proxy
miscServ :: Server MiscCombinatorsAPI
miscServ = versionHandler
:<|> secureHandler
:<|> hostHandler
where versionHandler = return . show
secureHandler Secure = return "secure"
secureHandler NotSecure = return "not secure"
hostHandler = return . show
miscReqCombinatorsSpec :: Spec
miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
describe "Misc. combinators for request inspection" $ do
it "Successfully gets the HTTP version specified in the request" $
go "/version" "\"HTTP/1.0\""
it "Checks that hspec-wai uses HTTP, not HTTPS" $
go "/secure" "\"not secure\""
it "Checks that hspec-wai issues request from 0.0.0.0" $
go "/host" "\"0.0.0.0:0\""
where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res

5
servant/CHANGELOG.md
View File

@ -1,3 +1,8 @@
HEAD
----
* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
0.4.2
-----
* Fix missing cases for `Patch` in `safeLink`

5
servant/servant.cabal
View File

@ -34,15 +34,19 @@ library
Servant.API.Delete
Servant.API.Get
Servant.API.Header
Servant.API.HttpVersion
Servant.API.IsSecure
Servant.API.Patch
Servant.API.Post
Servant.API.Put
Servant.API.QueryParam
Servant.API.MatrixParam
Servant.API.Raw
Servant.API.RemoteHost
Servant.API.ReqBody
Servant.API.ResponseHeaders
Servant.API.Sub
Servant.API.Vault
Servant.Common.Text
Servant.Utils.Links
build-depends:
@ -57,6 +61,7 @@ library
, text >= 1 && < 2
, string-conversions >= 0.3 && < 0.5
, network-uri >= 2.6
, vault >= 0.3 && <0.4
hs-source-dirs: src
default-language: Haskell2010
other-extensions: CPP

15
servant/src/Servant/API.hs
View File

@ -1,6 +1,3 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.API (
-- * Combinators
@ -14,12 +11,20 @@ module Servant.API (
-- | Capturing parts of the url path as parsed values: @'Capture'@
module Servant.API.Header,
-- | Retrieving specific headers from the request
module Servant.API.HttpVersion,
-- | Retrieving the HTTP version of the request
module Servant.API.QueryParam,
-- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@
module Servant.API.ReqBody,
-- | Accessing the request body as a JSON-encoded type: @'ReqBody'@
module Servant.API.MatrixParam,
-- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@
module Servant.API.RemoteHost,
-- | Retrieving the IP of the client
module Servant.API.IsSecure,
-- | Is the request made through HTTPS?
module Servant.API.Vault,
-- | Access the location for arbitrary data to be shared by applications and middleware
-- * Actual endpoints, distinguished by HTTP method
module Servant.API.Get,
@ -64,6 +69,8 @@ import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
import Servant.API.Delete (Delete)
import Servant.API.Get (Get)
import Servant.API.Header (Header (..))
import Servant.API.HttpVersion (HttpVersion(..))
import Servant.API.IsSecure (IsSecure(..))
import Servant.API.MatrixParam (MatrixFlag, MatrixParam,
MatrixParams)
import Servant.API.Patch (Patch)
@ -72,6 +79,7 @@ import Servant.API.Put (Put)
import Servant.API.QueryParam (QueryFlag, QueryParam,
QueryParams)
import Servant.API.Raw (Raw)
import Servant.API.RemoteHost (RemoteHost)
import Servant.API.ReqBody (ReqBody)
import Servant.API.ResponseHeaders (AddHeader (addHeader),
BuildHeadersTo (buildHeadersTo),
@ -79,6 +87,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),
HList (..), Headers (..),
getHeadersHList, getResponse)
import Servant.API.Sub ((:>))
import Servant.API.Vault (Vault)
import Servant.Common.Text (FromText (..), ToText (..))
import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
URI (..), safeLink)

19
servant/src/Servant/API/HttpVersion.hs Normal file
View File

@ -0,0 +1,19 @@
module Servant.API.HttpVersion
( -- $httpversion
HttpVersion(..)
) where
import Network.HTTP.Types (HttpVersion(..))
-- $httpversion
--
-- | You can directly use the 'HttpVersion' type from @Network.HTTP.Types@
-- if your request handlers need it to compute a response. This would
-- make the request handlers take an argument of type 'HttpVersion'.
--
-- Example:
--
-- >>> type API = HttpVersion :> Get '[JSON] String
-- $setup
-- >>> import Servant.API

37
servant/src/Servant/API/IsSecure.hs Normal file
View File

@ -0,0 +1,37 @@
{-# LANGUAGE DeriveDataTypeable #-}
module Servant.API.IsSecure
( -- $issecure
IsSecure(..)
) where
import Data.Typeable
-- | Was this request made over an SSL connection?
--
-- Note that this value will not tell you if the client originally
-- made this request over SSL, but rather whether the current
-- connection is SSL. The distinction lies with reverse proxies.
-- In many cases, the client will connect to a load balancer over SSL,
-- but connect to the WAI handler without SSL. In such a case,
-- the handlers would get 'NotSecure', but from a user perspective,
-- there is a secure connection.
data IsSecure = Secure -- ^ the connection to the server
-- is secure (HTTPS)
| NotSecure -- ^ the connection to the server
-- is not secure (HTTP)
deriving Typeable
-- $issecure
--
-- | Use 'IsSecure' whenever your request handlers need to know whether
-- the connection to the server is secure or not.
-- This would make the request handlers receive an argument of type 'IsSecure',
-- whose value can be one of 'Secure' (HTTPS) or 'NotSecure' (HTTP).
--
-- Example:
--
-- >>> type API = "sensitive-data" :> IsSecure :> Get '[JSON] NationSecrets
-- $setup
-- >>> import Servant.API
-- >>> data NationSecrets

25
servant/src/Servant/API/RemoteHost.hs Normal file
View File

@ -0,0 +1,25 @@
{-# LANGUAGE DeriveDataTypeable #-}
module Servant.API.RemoteHost
( -- $remotehost
RemoteHost
) where
import Data.Typeable
-- | Provides access to the host or IP address
-- from which the HTTP request was sent.
data RemoteHost deriving Typeable
-- $remotehost
--
-- | Use 'RemoteHost' whenever your request handlers need the host or IP address
-- from which the client issued the HTTP request. The corresponding handlers
-- receive arguments of type @SockAddr@ (from @Network.Socket@).
--
-- Example:
--
-- >>> -- POST /record-ip
-- >>> type API = "record-ip" :> RemoteHost :> Post '[] ()
-- $setup
-- >>> import Servant.API

20
servant/src/Servant/API/Vault.hs Normal file
View File

@ -0,0 +1,20 @@
module Servant.API.Vault
( -- $vault
Vault
) where
import Data.Vault.Lazy (Vault)
-- $vault
--
-- | Use 'Vault' in your API types to provide access to the 'Vault'
-- of the request, which is a location shared by middlewares and applications
-- to store arbitrary data. See 'Vault' for more details on how to actually
-- use the vault in your handlers
--
-- Example:
--
-- >>> type API = Vault :> Get '[JSON] String
-- $setup
-- >>> import Servant.API