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

Remove implementations for HasServer for now nonexistent types, add tests for capturing times.

Browse source
This commit is contained in:
Alex Mason 2015-12-03 14:32:52 +11:00
parent 74ebec9176
commit 1c9c948faf
2 changed files with 32 additions and 123 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -30,7 +30,6 @@ import Data.Maybe (fromMaybe, mapMaybe)
import Data.String (fromString) import Data.String (fromString)
import Data.String.Conversions (ConvertibleStrings, cs, (<>)) import Data.String.Conversions (ConvertibleStrings, cs, (<>))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable import Data.Typeable
import GHC.TypeLits (KnownSymbol, symbolVal) import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types hiding (Header, ResponseHeaders) import Network.HTTP.Types hiding (Header, ResponseHeaders)
@ -41,9 +40,6 @@ import Network.Wai (Application, lazyRequestBody,
isSecure, vault, httpVersion, Response, isSecure, vault, httpVersion, Response,
Request, pathInfo) Request, pathInfo)
import Servant.API ((:<|>) (..), (:>), Capture, import Servant.API ((:<|>) (..), (:>), Capture,
CaptureTime,
QueryParamTime,
QueryParamTimes,
Delete, Get, Header, Delete, Get, Header,
IsSecure(..), Patch, Post, Put, IsSecure(..), Patch, Post, Put,
QueryFlag, QueryParam, QueryParams, QueryFlag, QueryParam, QueryParams,
@ -63,7 +59,6 @@ import Servant.Server.Internal.ServantErr
import Web.HttpApiData (FromHttpApiData) import Web.HttpApiData (FromHttpApiData)
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe) import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
import Data.Time.Format
class HasServer layout where class HasServer layout where
type ServerT layout (m :: * -> *) :: * type ServerT layout (m :: * -> *) :: *
@ -130,42 +125,6 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
where where
captureProxy = Proxy :: Proxy (Capture capture a) captureProxy = Proxy :: Proxy (Capture capture a)
-- | If you use 'CaptureTime' in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function
-- that takes an argument of the type specified by the 'CaptureTime'.
-- This lets servant worry about getting it from the URL and turning
-- it into a value of the type you specify if the string matches the fiven format.
--
-- Example:
--
-- > type MyApi = "calevents" :> CaptureTime "date" "%Y-%m-%d" Day :> Get '[JSON] [Event]
-- >
-- > server :: Server MyApi
-- > server = getCalendarEvents
-- > where getCalendarEvents :: Day -> ExceptT ServantErr IO [Event]
-- > getCalendarEvents day = ...
instance (KnownSymbol capture, KnownSymbol format, HasServer sublayout, ParseTime t)
=> HasServer (CaptureTime capture format t :> sublayout) where
type ServerT (CaptureTime capture format t :> sublayout) m =
t -> ServerT sublayout m
route Proxy d =
DynamicRouter $ \ first ->
route (Proxy :: Proxy sublayout)
(addCapture d $ case captureDate formatProxy first of
Nothing -> return $ Fail err404
Just (t :: t) -> return $ Route t
)
where formatProxy = Proxy :: Proxy format
captureDate :: (ParseTime t, KnownSymbol format)
=> Proxy format -> Text -> Maybe t
captureDate p t = parseTime defaultTimeLocale formatStr (T.unpack t)
where formatStr = symbolVal p
allowedMethodHead :: Method -> Request -> Bool allowedMethodHead :: Method -> Request -> Bool
allowedMethodHead method request = method == methodGet && requestMethod request == methodHead allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
@ -531,40 +490,6 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
in route (Proxy :: Proxy sublayout) (passToServer subserver param) in route (Proxy :: Proxy sublayout) (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | 'QueryParamTime' allows you to accept dates and times in query params.
-- The format argument specifies the format understood by 'Data.Time.Format'.
--
-- Servant takes care of parsing the
--
-- Example:
--
-- > type MyApi = "timeseries"
-- > :> QueryParamTime "start" "%Y-%m-%d" Day
-- > :> QueryParamTime "end" "%Y-%m-%d" Day
-- > :> Get '[JSON] [Double]
-- >
-- > server :: Server MyApi
-- > server = getDataBetween
-- > where getDataBetween :: Maybe Day -> Maybe Day -> ExceptT ServantErr IO [Double]
-- > getDataBetween mstart mend = ...return data between optional start and end dates...
instance (KnownSymbol sym, KnownSymbol format, HasServer sublayout, ParseTime t)
=> HasServer (QueryParamTime sym format t :> sublayout) where
type ServerT (QueryParamTime sym format t :> sublayout) m =
Maybe t -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
param =
case lookup paramname querytext of
Nothing -> Nothing -- param absent from the query string
Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> captureDate formatProxy v -- if present, we try to convert to
-- the right type
in route (Proxy :: Proxy sublayout) (passToServer subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
formatProxy = Proxy :: Proxy format
-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API, -- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function -- this automatically requires your server-side handler to be a function
-- that takes an argument of type @['Text']@. -- that takes an argument of type @['Text']@.
@ -603,40 +528,6 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
convert Nothing = Nothing convert Nothing = Nothing
convert (Just v) = parseQueryParamMaybe v convert (Just v) = parseQueryParamMaybe v
-- | As with 'QueryParams', 'QueryParamTimes, this allows you to capture 0
-- or more dates/times matching a given format. The format must be one
-- which works with `Data.Time.Format'.
--
-- Example:
--
-- > type MyApi = "chckavailability"
-- > :> QueryParamTimes "start" "%Y-%m-%d" Day
-- > :> Get '[JSON] [Event]
-- >
-- > server :: Server MyApi
-- > server = getEventsForDays
-- > where getEventsForDays :: [Day] -> ExceptT ServantErr IO [Event]
-- > getEventsForDays days = ... return all the events on the specified days ...
instance (KnownSymbol sym, KnownSymbol format, HasServer sublayout, ParseTime t)
=> HasServer (QueryParamTimes sym format t :> sublayout) where
type ServerT (QueryParamTimes sym format t :> sublayout) m =
[t] -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
-- if sym is "foo", we look for query string parameters
-- named "foo" or "foo[]" and call parseQueryParam on the
-- corresponding values
parameters = filter looksLikeParam querytext
values = mapMaybe (convert . snd) parameters
in route (Proxy :: Proxy sublayout) (passToServer subserver values)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing
convert (Just v) = captureDate formatProxy v
formatProxy = Proxy :: Proxy format
-- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API, -- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function -- this automatically requires your server-side handler to be a function
-- that takes an argument of type 'Bool'. -- that takes an argument of type 'Bool'.

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

@ -34,7 +34,7 @@ import Network.Wai.Internal (Response(ResponseBuilder))
import Network.Wai.Test (defaultRequest, request, import Network.Wai.Test (defaultRequest, request,
runSession, simpleBody) runSession, simpleBody)
import Servant.API ((:<|>) (..), (:>), Capture, Delete, import Servant.API ((:<|>) (..), (:>), Capture, Delete,
CaptureTime, FTime(..),
Get, Header (..), Headers, Get, Header (..), Headers,
HttpVersion, IsSecure (..), JSON, HttpVersion, IsSecure (..), JSON,
Patch, PlainText, Post, Put, Patch, PlainText, Post, Put,
@ -50,8 +50,10 @@ import Servant.Server.Internal.RoutingApplication (toApplication, Rout
import Servant.Server.Internal.Router import Servant.Server.Internal.Router
(tweakResponse, runRouter, (tweakResponse, runRouter,
Router, Router'(LeafRouter)) Router, Router'(LeafRouter))
import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.Calendar import Data.Time.LocalTime (LocalTime(..), hoursToTimeZone,
localTimeToUTC, makeTimeOfDayValid)
import Data.Time.Clock (UTCTime)
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
-- * test data types -- * test data types
@ -88,7 +90,7 @@ tweety = Animal "Bird" 2
spec :: Spec spec :: Spec
spec = do spec = do
captureSpec captureSpec
captureDateSpec captureTimeSpec
getSpec getSpec
headSpec headSpec
postSpec postSpec
@ -131,31 +133,47 @@ captureSpec = do
it "strips the captured path snippet from pathInfo" $ do it "strips the captured path snippet from pathInfo" $ do
get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String])) get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
type CaptureTimeApi = CaptureTime "date" "%Y-%m-%d" Day :> Get '[PlainText] String type CaptureTimeApi = (Capture "date" (FTime "%Y-%m-%d" Day) :> Get '[PlainText] String)
:<|>
("datetime" :> Capture "datetime" (FTime "%Y-%m-%d %H:%M:%S%Z" UTCTime) :> Get '[PlainText] String)
captureTimeApi :: Proxy CaptureTimeApi captureTimeApi :: Proxy CaptureTimeApi
captureTimeApi = Proxy captureTimeApi = Proxy
captureTimesServer :: Day -> ExceptT ServantErr IO String captureDateServer :: FTime "%Y-%m-%d" Day -> ExceptT ServantErr IO String
captureTimesServer = return . show captureDateServer = return . show
captureDateTimeServer :: FTime "%Y-%m-%d %H:%M:%S%Z" UTCTime -> ExceptT ServantErr IO String
captureDateTimeServer = return . show
captureDateSpec :: Spec
captureDateSpec = do captureTimeSpec :: Spec
captureTimeSpec = do
describe "Servant.API.Times(CaptureTime)" $ do describe "Servant.API.Times(CaptureTime)" $ do
with (return (serve captureTimeApi captureTimesServer)) $ do with (return (serve captureTimeApi (captureDateServer :<|> captureDateTimeServer))) $ do
it "can capture parts of the 'pathInfo'" $ do it "can capture parts of the 'pathInfo' (date only)" $ do
response <- get "/2015-12-02" response <- get "/2015-12-02"
liftIO $ simpleBody response `shouldBe` (fromString . show $ fromGregorian 2015 12 2 :: ByteString) liftIO $ simpleBody response `shouldBe` (fromString . show $ fromGregorian 2015 12 2 :: ByteString)
it "can capture parts of the 'pathInfo' (date and time with a space)" $ do
let day = fromGregorian 2015 12 2
Just time = makeTimeOfDayValid 12 34 56
tz = hoursToTimeZone 10
utcT = localTimeToUTC tz (LocalTime day time)
ftime :: FTime "%Y-%m-%d %H:%M:%S%Z" UTCTime
ftime = FTime utcT
response <- get "/datetime/2015-12-02%2012:34:56+1000"
liftIO $ simpleBody response `shouldBe` (fromString . show $ ftime)
it "returns 404 if the decoding fails" $ do it "returns 404 if the decoding fails" $ do
get "/notAnInt" `shouldRespondWith` 404 get "/notAnInt" `shouldRespondWith` 404
with (return (serve with (return (serve
(Proxy :: Proxy (CaptureTime "date" "%Y-%m-%d" Day :> Raw)) (Proxy :: Proxy (Capture "datetime" (FTime "%Y-%m-%d %H:%M:%S%Z" UTCTime) :> Raw))
(\ day request_ respond -> (\ (FTime day )request_ respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ do
it "strips the captured path snippet from pathInfo" $ do it "strips the captured path snippet from pathInfo" $ do
get "/2015-12-02/foo" `shouldRespondWith` (fromString (show ["foo" :: String])) get "/2015-12-02%2012:34:56+1000/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))