packages feed

rest-core 0.33.1.2 → 0.34

raw patch · 7 files changed

+50/−27 lines, 7 filesdep ~rest-types

Dependency ranges changed: rest-types

Files

CHANGELOG.md view
@@ -1,5 +1,22 @@ # Changelog +## 0.34++* Allow setting the method in the requests in a top level multi+  handler.+* The `getMethod` `Rest` class function now returns a `Maybe`.+* The `route` method in `Rest.Driver.Routing` now takes a `Maybe+  Method`.+* The `Method` type was removed from `Rest.Driver.Types` and moved to+  rest-types' `Rest.Types.Method`.++#### 0.33.2++* Allow top level multi handler as a POST as well as a GET.+  Technically, you're not allowed to vary the response based on the+  body of a GET. Also, in some frameworks (e.g. jQuery) it isn't+  possible to set the body of a GET.+ #### 0.33.1.2  * Typo fixes in documentation.
rest-core.cabal view
@@ -1,5 +1,5 @@ name:                rest-core-version:             0.33.1.2+version:             0.34 description:         Rest API library. synopsis:            Rest API library. maintainer:          code@silk.co@@ -53,7 +53,7 @@     , multipart >= 0.1.1 && < 0.2     , random >= 1.0 && < 1.2     , rest-stringmap == 0.2.*-    , rest-types >= 1.11.1 && < 1.12+    , rest-types == 1.12.*     , safe >= 0.2 && < 0.4     , split >= 0.1 && < 0.3     , text >= 0.11 && < 1.3
src/Rest/Driver/Perform.hs view
@@ -45,7 +45,7 @@   getHeader       :: String -> m (Maybe String)   getParameter    :: String -> m (Maybe String)   getBody         :: m UTF8.ByteString-  getMethod       :: m Rest.Method+  getMethod       :: m (Maybe Rest.Method)   getPaths        :: m [String]   lookupMimeType  :: String -> m (Maybe String)   setHeader       :: String -> String -> m ()
src/Rest/Driver/RestM.hs view
@@ -23,7 +23,7 @@   { headers    :: HashMap String String   , parameters :: HashMap String String   , body       :: UTF8.ByteString-  , method     :: Rest.Method+  , method     :: Maybe Rest.Method   , paths      :: [String]   , mimeTypes  :: HashMap String String   }@@ -33,7 +33,7 @@   { headers    = H.empty   , parameters = H.empty   , body       = mempty-  , method     = Rest.GET+  , method     = Just Rest.GET   , paths      = []   , mimeTypes  = H.empty   }
src/Rest/Driver/Routing.hs view
@@ -81,8 +81,9 @@                      . flip runReaderT method                      . unRouter -route :: Method -> UriParts -> Rest.Api m -> Either Reason_ (RunnableHandler m)-route method uri api = runRouter method uri $+route :: Maybe Method -> UriParts -> Rest.Api m -> Either Reason_ (RunnableHandler m)+route Nothing       _   _   = apiError UnsupportedMethod+route (Just method) uri api = runRouter method uri $   do versionStr <- popSegment      case versionStr `Rest.lookupVersion` api of           Just (Some1 router) -> routeRoot router@@ -96,7 +97,7 @@ routeMultiGet :: Rest.Router m s -> MaybeT Router (RunnableHandler m) routeMultiGet root@(Rest.Embed Rest.Resource{} _) =   do guardNullPath-     guardMethod GET+     guardMethod POST      return (RunnableHandler id (mkMultiGetHandler root))  routeRouter :: Rest.Router m s -> Router (RunnableHandler m)@@ -334,12 +335,13 @@   $ R.uri res   where     routeResource :: String -> Either Reason_ (RunnableHandler m)-    routeResource uri = runRouter GET (splitUriString uri) (routeRoot root)+    routeResource uri = runRouter (R.method res) (splitUriString uri) (routeRoot root)      toRestInput r = Rest.emptyInput       { Rest.headers    = H.map (R.unValue) . StringHashMap.toHashMap . R.headers    $ r       , Rest.parameters = H.map (R.unValue) . StringHashMap.toHashMap . R.parameters $ r       , Rest.body       = LUTF8.fromString (R.input r)+      , Rest.method     = Just (R.method r)       , Rest.paths      = splitUriString (R.uri r)       }
src/Rest/Driver/Types.hs view
@@ -1,7 +1,14 @@ {-# LANGUAGE ExistentialQuantification, RankNTypes #-}-module Rest.Driver.Types where+module Rest.Driver.Types+  ( Run+  , RunnableHandler (..)+  , mapHandler +  , module Rest.Types.Method+  ) where+ import Rest.Handler (Handler)+import Rest.Types.Method (Method (..))  type Run m n = forall a. m a -> n a @@ -11,6 +18,3 @@  mapHandler :: Run m n -> RunnableHandler m -> RunnableHandler n mapHandler run (RunnableHandler run' h) = RunnableHandler (run . run') h--data Method = GET | PUT | POST | DELETE | Unknown String-  deriving (Show, Eq)
tests/Runner.hs view
@@ -42,19 +42,19 @@               , testCase "Simple subresource." testSubresource               , testCase "Root router is skipped." testRootRouter               , testCase "Multi-PUT." testMultiPut-              , testCase "Multi-GET." testMultiGet+              , testCase "Multi-POST" testMultiPost               , testCase "Accept headers." testAcceptHeaders               ]  testListing :: Assertion-testListing = checkRoute GET "resource" (Rest.route resource)+testListing = checkRoute GET "resource" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO Void () Void     resource = mkResourceId { name = "resource", schema = Schema (Just (Many ())) (Named []), list = listHandler }     listHandler () = mkListing id $ \_ -> return []  testListingTrailingSlash :: Assertion-testListingTrailingSlash = checkRoute GET "resource/" (Rest.route resource)+testListingTrailingSlash = checkRoute GET "resource/" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO Void () Void     resource = mkResourceId { name = "resource", schema = Schema (Just (Many ())) (Named []), list = listHandler }@@ -75,7 +75,7 @@     handler_ = mkConstHandler stringO ask  testUnnamedMulti :: Assertion-testUnnamedMulti = checkRoute GET "resource/foo" (Rest.route resource)+testUnnamedMulti = checkRoute GET "resource/foo" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO Void String Void     resource = mkResourceId { name = "resource", schema = Schema Nothing (Unnamed (Many (Id StringId id))), list = listHandler }@@ -96,14 +96,14 @@     handler_ = mkConstHandler stringO ask  testNamedListing :: Assertion-testNamedListing = checkRoute GET "resource/foo" (Rest.route resource)+testNamedListing = checkRoute GET "resource/foo" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO Void () Void     resource = mkResourceId { name = "resource", schema = Schema Nothing (Named [("foo", Right (Many (Singleton ())))]), list = listHandler }     listHandler () = mkListing id $ \_rng -> return []  testNamedListingBy :: Assertion-testNamedListingBy = checkRoute GET "resource/foo/bar" (Rest.route resource)+testNamedListingBy = checkRoute GET "resource/foo/bar" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO Void String Void     resource = mkResourceId { name = "resource", schema = Schema Nothing (Named [("foo", Right (Many (By (Id StringId id))))]), list = listHandler }@@ -121,7 +121,7 @@ -- contains no list handler.  testCreateWithListing :: Assertion-testCreateWithListing = checkRoutes [(GET, "resource"), (POST, "resource")] (Rest.route resource)+testCreateWithListing = checkRoutes [(GET, "resource"), (POST, "resource")] (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO Void () Void     resource = mkResourceId { name = "resource", schema = Schema (Just (Many ())) (Named []), list = listHandler, create = Just createHandler }@@ -129,14 +129,14 @@     listHandler () = mkListing id $ \_rng -> return []  testStaticAction :: Assertion-testStaticAction = checkRoute POST "resource/action" (Rest.route resource)+testStaticAction = checkRoute POST "resource/action" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO IO () Void ()     resource = mkResourceId { name = "resource", schema = Schema Nothing (Named [("action", Left ())]), statics = staticHandler }     staticHandler () = mkConstHandler id $ return ()  testSubresource :: Assertion-testSubresource = checkRoute GET "resource/single/subresource" (Rest.route resource -/ Rest.route subResource)+testSubresource = checkRoute GET "resource/single/subresource" (Rest.root -/ Rest.route resource --/ Rest.route subResource)   where     resource :: Resource IO IO () Void Void     resource = mkResourceId { name = "resource", schema = Schema Nothing (Named [("single", Right (Single (Singleton ())))]), get = Just getHandler }@@ -153,7 +153,7 @@     getHandler = mkConstHandler id $ return ()  testMultiPut :: Assertion-testMultiPut = checkRouteSuccess PUT "resource/foo" (Rest.route resource)+testMultiPut = checkRouteSuccess PUT "resource/foo" (Rest.root -/ Rest.route resource)   where     resource :: Resource IO (ReaderT String IO) String Void Void     resource = mkResourceReader@@ -162,8 +162,8 @@       , update = Just (mkConstHandler xmlJsonO (liftM void ask))       } -testMultiGet :: Assertion-testMultiGet = checkRouteSuccess GET "" (Rest.root :: Rest.Router IO IO)+testMultiPost :: Assertion+testMultiPost = checkRoute POST "" (Rest.root :: Rest.Router IO IO)  type Uri = String @@ -191,13 +191,13 @@  checkRouteFailure :: Method -> Uri -> Rest.Router m s -> Assertion checkRouteFailure method uri router =-  case route method (splitUriString $ "v1.0/" <> uri) [(Version 1 0 Nothing, Some1 router)] of+  case route (Just method) (splitUriString $ "v1.0/" <> uri) [(Version 1 0 Nothing, Some1 router)] of     Left _  -> return ()     Right _ -> assertFailure ("Should be no route to " ++ show method ++ " " ++ uri ++ ".")  checkRouteSuccess :: Method -> Uri -> Rest.Router m s -> Assertion checkRouteSuccess method uri router =-  case route method (splitUriString $ "v1.0/" <> uri) [(Version 1 0 Nothing, Some1 router)] of+  case route (Just method) (splitUriString $ "v1.0/" <> uri) [(Version 1 0 Nothing, Some1 router)] of     Left e  -> assertFailure ("No route to " ++ show method ++ " " ++ uri ++ ": " ++ show e)     Right _ -> return ()