diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 4b1c04a6..bc8b0732 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -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'. diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index b45eb6b3..92ad631a 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -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]))