rest-core 0.28.0.1 → 0.29

raw patch · 5 files changed

+62/−30 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• rest-core.cabal +11/−10
• src/Rest/Dictionary/Types.hs +14/−1
• src/Rest/Driver/Perform.hs +1/−1
• src/Rest/Driver/Routing.hs +23/−18

@@ -0,0 +1,13 @@+# Changelog++## 0.29++* Add multi-delete handler. It is used on a DELETE to+  `/<resource>/<id>/` and is derived from the single delete handler.+* Don't put `Cache-Control: private` header on served files. This way+  they can be cached by public proxies, e.g. cloudfront.+* Add `Show` instances for `Header`, `Param` and `Dict`.+* Renamed `mkMultiPutHandler` to `mkMultiHandler` in+  `Rest.Driver.Routing`.+* Explicit exports in `Rest.Driver.Routing`, removing a lot of+  private functions from the public interface.

@@ -1,13 +1,14 @@-Name:             rest-core-Version:          0.28.0.1-Description:      Rest API library.-Synopsis:         Rest API library.-Maintainer:       code@silk.co-Category:         Web-Build-Type:       Simple-Cabal-Version:    >= 1.8-License:          BSD3-License-File:     LICENSE+Name:               rest-core+Version:            0.29+Description:        Rest API library.+Synopsis:           Rest API library.+Maintainer:         code@silk.co+Category:           Web+Build-Type:         Simple+Cabal-Version:      >= 1.8+License:            BSD3+License-File:       LICENSE+Extra-Source-Files: CHANGELOG.md  Library   GHC-Options:     -Wall

@@ -94,6 +94,10 @@   NoHeader ::                                                       Header ()   Header   :: [String] -> ([Maybe String] -> Either DataError h) -> Header h +instance Show (Header h) where+  showsPrec _ NoHeader      = showString "NoHeader"+  showsPrec n (Header hs _) = showParen (n > 9) (showString "Header " . showsPrec 10 hs)+ -- | The explicit dictionary `Parameter` describes how to translate the request -- parameters to some Haskell value. The first field in the `Header` -- constructor is a white list of paramters we can recognize, used in generic@@ -110,6 +114,15 @@   Param     :: [String] -> ([Maybe String] -> Either DataError p) -> Param p   TwoParams :: Param p -> Param q                                 -> Param (p, q) +instance Show (Param p) where+  showsPrec _ NoParam         = showString "NoParam"+  showsPrec n (Param ns _)    = showParen (n > 9) (showString "Param " . showsPrec 10 ns)+  showsPrec n (TwoParams p q) = showParen (n > 9) ( showString "TwoParams "+                                                  . showsPrec 10 p+                                                  . showString " "+                                                  . showsPrec 10 q+                                                  )+ -- | The explicitly dictionary `Input` describes how to translate the request -- body into some Haskell value. We currently use a constructor for every -- combination of input type to output type. For example, we can use XML input@@ -187,7 +200,7 @@     , inputs  :: Inputs  i     , outputs :: Outputs o     , errors  :: Errors  e-    }+    } deriving Show   |]  -- | The empty dictionary, recognizing no types.

@@ -332,7 +332,7 @@         tryD (MultipartO : _ ) _            = outputMultipart v         tryD (FileO      : _ ) FileFormat   = do mime <- fromMaybe "application/octet-stream" <$> lookupMimeType (map toLower (snd v))                                                  setHeader "Content-Type" mime-                                                 setHeader "Cache-Control" "private, max-age=604800"+                                                 setHeader "Cache-Control" "max-age=604800"                                                  ok (fst v)         tryD []                t            = throwError (UnsupportedFormat (show t))         tryD (_          : xs) t            = tryD xs t

@@ -9,8 +9,14 @@            , DeriveDataTypeable            , TupleSections            #-}-module Rest.Driver.Routing where+module Rest.Driver.Routing+  ( route+  , mkListHandler+  , mkMultiHandler +  , UriParts+  ) where+ import Prelude hiding (id, (.))  import Control.Applicative@@ -24,11 +30,9 @@ import Control.Monad.State (StateT, evalStateT, MonadState) import Control.Monad.Trans.Either import Control.Monad.Trans.Maybe-import Data.ByteString (ByteString) import Network.Multipart (BodyPart (..), HeaderName (..)) import Safe import qualified Control.Monad.State       as State-import qualified Data.ByteString.UTF8      as UTF8 import qualified Data.ByteString.Lazy.UTF8 as LUTF8 import qualified Data.Label.Total          as L import qualified Data.Map                  as Map@@ -51,7 +55,6 @@  import qualified Rest.Driver.RestM as Rest -type Uri = ByteString type UriParts = [String]  apiError :: (MonadError (Reason e) m) => Reason e -> m a@@ -146,7 +149,7 @@              -> Router (RunnableHandler m) routeUnnamed resource@(Rest.Resource { Rest.list }) subRouters cardinality =   case cardinality of-    Rest.Single sBy -> withSegment (multiPut resource sBy) $ \seg ->+    Rest.Single sBy -> withSegment (multi resource sBy) $ \seg ->       parseIdent sBy seg >>= \sid -> withSubresource sid resource subRouters     Rest.Many   mBy ->       do seg <- popSegment@@ -162,18 +165,23 @@ routeGetter getter resource subRouters =   case getter of     Rest.Singleton sid -> getOrDeep sid-    Rest.By        sBy -> withSegment (multiPut resource sBy) $ \seg ->+    Rest.By        sBy -> withSegment (multi resource sBy) $ \seg ->                             parseIdent sBy seg >>= getOrDeep   where     getOrDeep sid = withSubresource sid resource subRouters -multiPut :: Rest.Resource m s sid mid aid -> Rest.Id sid -> Router (RunnableHandler m)-multiPut (Rest.Resource { Rest.update, Rest.enter }) sBy =-  do hasMethod PUT-     maybe (apiError UnsupportedRoute) return $-       do updateH    <- update-          putHandler <- mkMultiPutHandler sBy enter updateH-          return (RunnableHandler id putHandler)+multi :: Rest.Resource m s sid mid aid -> Rest.Id sid -> Router (RunnableHandler m)+multi (Rest.Resource { Rest.update, Rest.remove, Rest.enter }) sBy =+  ask >>= \method ->+  case method of+    PUT    -> handleOrNotFound update+    DELETE -> handleOrNotFound remove+    _      -> apiError UnsupportedMethod+  where+    handleOrNotFound handler =+      maybe (apiError UnsupportedRoute)+            (return . RunnableHandler id)+            (handler >>= mkMultiHandler sBy enter)  routeListGetter :: Monad m                 => Rest.Getter mid@@ -241,9 +249,6 @@     Nothing  -> throwError (IdentError (ParseError $ "Failed to parse " ++ seg))     Just sid -> return (byF sid) -splitUri :: Uri -> UriParts-splitUri = splitUriString . UTF8.toString- splitUriString :: String -> UriParts splitUriString = filter (/= "") . map decode . splitOn "/" @@ -296,8 +301,8 @@   xs <- act (Env h p i)   return (List f (min c (length xs)) (take c xs)) -mkMultiPutHandler :: Monad m => Rest.Id id -> (id -> Run s m) -> Handler s -> Maybe (Handler m)-mkMultiPutHandler sBy run (GenHandler dict act sec) = GenHandler <$> mNewDict <*> pure newAct <*> pure sec+mkMultiHandler :: Monad m => Rest.Id id -> (id -> Run s m) -> Handler s -> Maybe (Handler m)+mkMultiHandler sBy run (GenHandler dict act sec) = GenHandler <$> mNewDict <*> pure newAct <*> pure sec   where     newErrDict = L.modify errors reasonE dict     mNewDict =  L.traverse inputs mappingI