diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 8d6beac4..ec6b13ae 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -65,6 +65,7 @@ library , wai >= 3.0 && < 3.1 , wai-app-static >= 3.0 && < 3.2 , warp >= 3.0 && < 3.2 + , time >= 1.5 && < 1.6 hs-source-dirs: src default-language: Haskell2010 @@ -121,6 +122,7 @@ test-suite spec , wai , wai-extra , warp + , time test-suite doctests build-depends: base diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 4200d052..4b1c04a6 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -30,6 +30,7 @@ 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) @@ -40,6 +41,9 @@ 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, @@ -59,6 +63,8 @@ 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 :: * -> *) :: * @@ -124,6 +130,43 @@ 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 @@ -488,6 +531,40 @@ 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']@. @@ -526,6 +603,40 @@ 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'.