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

initial changes of raw - wip

Browse source
This commit is contained in:
Brandon Martin 2015-07-30 10:44:13 -06:00
parent 52b58d0fe9
commit 8cded479d8
8 changed files with 35 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/src/Servant/Client.hs
View file

@ -622,6 +622,7 @@ instance HasClient Raw where
type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
clientWithRoute :: Proxy (Raw m a) -> Req -> BaseUrl -> Manager -> Client (Raw m a)
clientWithRoute Proxy req baseurl manager httpMethod = do
performRequest httpMethod req (const True) baseurl manager

10
servant-client/test/Servant/ClientSpec.hs
View file

@ -84,8 +84,8 @@ type Api =
:<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
:<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
:<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
:<|> "rawSuccess" :> Raw
:<|> "rawFailure" :> Raw
:<|> "rawSuccess" :> Raw IO Application
:<|> "rawFailure" :> Raw IO Application
:<|> "multiple" :>
Capture "first" String :>
QueryParam "second" Int :>
@ -126,9 +126,9 @@ withServer :: (BaseUrl -> IO a) -> IO a
withServer action = withWaiDaemon (return server) action
type FailApi =
"get" :> Raw
:<|> "capture" :> Capture "name" String :> Raw
:<|> "body" :> Raw
"get" :> Raw IO Application
:<|> "capture" :> Capture "name" String :> Raw IO Application
:<|> "body" :> Raw IO Application
failApi :: Proxy FailApi
failApi = Proxy

12
servant-server/src/Servant/Server/Internal.hs
View file

@ -47,7 +47,7 @@ import Servant.API ((:<|>) (..), (:>), Capture,
IsSecure(..), MatrixFlag, MatrixParam,
MatrixParams, Patch, Post, Put,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody, Vault)
Raw(..), RemoteHost, ReqBody, Vault)
import Servant.API.ContentTypes (AcceptHeader (..),
AllCTRender (..),
AllCTUnrender (..))
@ -667,19 +667,21 @@ instance (KnownSymbol sym, HasServer sublayout)
--
-- Example:
--
-- > type MyApi = "images" :> Raw
-- > type MyApi = "images" :> Raw IO Application
-- >
-- > server :: Server MyApi
-- > server = serveDirectory "/var/www/images"
instance HasServer Raw where
class ToRawApplication a where
toRawApplication :: a -> Application
type ServerT Raw m = Application
instance ToRawApplication a => HasServer (Raw m a) where
type ServerT (Raw m a) n = Raw n a
route Proxy rawApplication = LeafRouter $ \ request respond -> do
r <- rawApplication
case r of
RR (Left err) -> respond $ failWith err
RR (Right app) -> app request (respond . succeedWith)
RR (Right (Raw app)) -> (toRawApplication app) request (respond . succeedWith)
-- | If you use 'ReqBody' in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function

16
servant-server/src/Servant/Utils/StaticFiles.hs
View file

@ -8,8 +8,10 @@ module Servant.Utils.StaticFiles (
) where
import Network.Wai.Application.Static (defaultFileServerSettings,
StaticSettings,
staticApp)
import Servant.API.Raw (Raw)
import Network.Wai (Application)
import Servant.API.Raw (Raw(..))
import Servant.Server (Server)
import System.FilePath (addTrailingPathSeparator)
#if !MIN_VERSION_wai_app_static(3,1,0)
@ -36,10 +38,14 @@ import Filesystem.Path.CurrentOS (decodeString)
-- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory'
-- handler in the last position, because /servant/ will try to match the handlers
-- in order.
serveDirectory :: FilePath -> Server Raw
serveDirectory =
serveDirectoryWith :: StaticSettings -> Server (Raw m Application)
serveDirectoryWith settings = Raw (staticApp settings)
serveDirectory :: FilePath -> Server (Raw m Application)
serveDirectory = serveDirectoryWith . defaultFileServerSettings .
#if MIN_VERSION_wai_app_static(3,1,0)
staticApp . defaultFileServerSettings . addTrailingPathSeparator
id .
#else
staticApp . defaultFileServerSettings . decodeString . addTrailingPathSeparator
decodeString .
#endif
addTrailingPathSeparator

10
servant-server/test/Servant/ServerSpec.hs
View file

@ -39,7 +39,7 @@ import Servant.API ((:<|>) (..), (:>),
HttpVersion, IsSecure(..), JSON, MatrixFlag,
MatrixParam, MatrixParams, Patch, PlainText,
Post, Put, RemoteHost, QueryFlag, QueryParam,
QueryParams, Raw, ReqBody)
QueryParams, Raw(..), ReqBody)
import Servant.Server (Server, serve, ServantErr(..), err404)
import Servant.Server.Internal.RoutingApplication
(RouteMismatch (..))
@ -118,9 +118,9 @@ captureSpec = do
get "/notAnInt" `shouldRespondWith` 404
with (return (serve
(Proxy :: Proxy (Capture "captured" String :> Raw))
(\ "captured" request_ respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
(Proxy :: Proxy (Capture "captured" String :> Raw IO Application))
(Raw (\ "captured" request_ respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_))))) $ do
it "strips the captured path snippet from pathInfo" $ do
get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
@ -502,7 +502,7 @@ headerSpec = describe "Servant.API.Header" $ do
delete' "/" "" `shouldRespondWith` 204
type RawApi = "foo" :> Raw
type RawApi = "foo" :> Raw IO Application
rawApi :: Proxy RawApi
rawApi = Proxy
rawApplication :: Show a => (Request -> a) -> Application

4
servant-server/test/Servant/Utils/StaticFilesSpec.hs
View file

@ -19,7 +19,7 @@ import Servant.API (JSON)
import Servant.API.Alternative ((:<|>) ((:<|>)))
import Servant.API.Capture (Capture)
import Servant.API.Get (Get)
import Servant.API.Raw (Raw)
import Servant.API.Raw (Raw(..))
import Servant.API.Sub ((:>))
import Servant.Server (Server, serve)
import Servant.ServerSpec (Person (Person))
@ -27,7 +27,7 @@ import Servant.Utils.StaticFiles (serveDirectory)
type Api =
"dummy_api" :> Capture "person_name" String :> Get '[JSON] Person
:<|> "static" :> Raw
:<|> "static" :> Raw IO Application
api :: Proxy Api

2
servant/src/Servant/API.hs
View file

@ -78,7 +78,7 @@ import Servant.API.Post (Post)
import Servant.API.Put (Put)
import Servant.API.QueryParam (QueryFlag, QueryParam,
QueryParams)
import Servant.API.Raw (Raw)
import Servant.API.Raw (Raw(..))
import Servant.API.RemoteHost (RemoteHost)
import Servant.API.ReqBody (ReqBody)
import Servant.API.ResponseHeaders (AddHeader (addHeader),

4
servant/src/Servant/API/Raw.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE KindSignatures #-}
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Raw where
@ -11,4 +12,5 @@ import Data.Typeable (Typeable)
-- In addition to just letting you plug in your existing WAI 'Application's,
-- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve
-- static files stored in a particular directory on your filesystem
data Raw deriving Typeable
newtype Raw (m :: * -> *) a = Raw a
deriving Typeable