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.Conversions (ConvertibleStrings, cs, (<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable
import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types hiding (Header, ResponseHeaders)
@ -41,9 +40,6 @@ import Network.Wai (Application, lazyRequestBody,
isSecure, vault, httpVersion, Response,
Request, pathInfo)
import Servant.API ((:<|>) (..), (:>), Capture,
CaptureTime,
QueryParamTime,
QueryParamTimes,
Delete, Get, Header,
IsSecure(..), Patch, Post, Put,
QueryFlag, QueryParam, QueryParams,
@ -63,7 +59,6 @@ import Servant.Server.Internal.ServantErr
import Web.HttpApiData (FromHttpApiData)
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
import Data.Time.Format
class HasServer layout where
type ServerT layout (m :: * -> *) :: *
@ -130,42 +125,6 @@ instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
where
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 = method == methodGet && requestMethod request == methodHead
@ -531,40 +490,6 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
in route (Proxy :: Proxy sublayout) (passToServer subserver param)
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,
-- this automatically requires your server-side handler to be a function
-- that takes an argument of type @['Text']@.
@ -603,40 +528,6 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
convert Nothing = Nothing
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,
-- this automatically requires your server-side handler to be a function
-- 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,
runSession, simpleBody)
import Servant.API ((:<|>) (..), (:>), Capture, Delete,
CaptureTime,
FTime(..),
Get, Header (..), Headers,
HttpVersion, IsSecure (..), JSON,
Patch, PlainText, Post, Put,
@ -50,8 +50,10 @@ import Servant.Server.Internal.RoutingApplication (toApplication, Rout
import Servant.Server.Internal.Router
(tweakResponse, runRouter,
Router, Router'(LeafRouter))
import Data.Time.Calendar
import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.LocalTime (LocalTime(..), hoursToTimeZone,
localTimeToUTC, makeTimeOfDayValid)
import Data.Time.Clock (UTCTime)
import Data.ByteString.Lazy (ByteString)
-- * test data types
@ -88,7 +90,7 @@ tweety = Animal "Bird" 2
spec :: Spec
spec = do
captureSpec
captureDateSpec
captureTimeSpec
getSpec
headSpec
postSpec
@ -131,31 +133,47 @@ captureSpec = do
it "strips the captured path snippet from pathInfo" $ do
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
captureTimesServer :: Day -> ExceptT ServantErr IO String
captureTimesServer = return . show
captureDateServer :: FTime "%Y-%m-%d" Day -> ExceptT ServantErr IO String
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
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"
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
get "/notAnInt" `shouldRespondWith` 404
with (return (serve
(Proxy :: Proxy (CaptureTime "date" "%Y-%m-%d" Day :> Raw))
(\ day request_ respond ->
(Proxy :: Proxy (Capture "datetime" (FTime "%Y-%m-%d %H:%M:%S%Z" UTCTime) :> Raw))
(\ (FTime day )request_ respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_)))) $ 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]))