rest-core 0.29 → 0.30

raw patch · 7 files changed

+65/−48 lines, 7 filesdep +rest-stringmapdep +unordered-containersdep −tostringdep ~rest-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: rest-stringmap, unordered-containers

Dependencies removed: tostring

Dependency ranges changed: rest-types

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• rest-core.cabal +4/−3
• src/Rest/Container.hs +9/−11
• src/Rest/Driver/Perform.hs +3/−1
• src/Rest/Driver/RestM.hs +19/−20
• src/Rest/Driver/Routing.hs +10/−7
• tests/Runner.hs +9/−6

@@ -1,5 +1,16 @@ # Changelog +## 0.30++* Use `Content-Disposition` to provide filenames for file responses.+  This slightly changes the semantics of `FileO`: what used to be+  interpreted as the file extension is now used for the whole file name.++* `Rest.Types.Container.StringMap` Has been replaced by `rest-stringmap`. This+  changes the XML serialization format of multi part messages, the old format+  was `<map><key>k</key>v[...]</map>` and the new one is+  `<map><value key="k">v</value>[...]</map>`.+ ## 0.29  * Add multi-delete handler. It is used on a DELETE to

@@ -1,5 +1,5 @@ Name:               rest-core-Version:            0.29+Version:            0.30 Description:        Rest API library. Synopsis:           Rest API library. Maintainer:         code@silk.co@@ -28,12 +28,13 @@     , mtl                       >= 2.0    &&  < 2.2     , multipart                 >= 0.1.1  &&  < 0.2     , random                    == 1.0.*-    , rest-types                == 1.9.*+    , rest-stringmap            == 0.1.*+    , rest-types                == 1.10.*     , safe                      >= 0.2    &&  < 0.4     , split                     >= 0.1    &&  < 0.3     , text                      >= 0.11   &&  < 1.2-    , tostring                  == 0.2.*     , transformers              >= 0.2    &&  < 0.4+    , unordered-containers      == 0.2.*     , uri-encode                == 1.5.*     , utf8-string               == 0.3.*     , uuid                      >= 1.2    &&  < 1.4

@@ -1,11 +1,11 @@ {-# LANGUAGE-    TemplateHaskell+    DeriveDataTypeable   , EmptyDataDecls-  , TypeFamilies   , FlexibleInstances-  , ScopedTypeVariables-  , DeriveDataTypeable   , GADTs+  , ScopedTypeVariables+  , TemplateHaskell+  , TypeFamilies   #-} module Rest.Container   ( module Rest.Types.Container@@ -18,12 +18,10 @@   ) where  import Data.Maybe-import Data.String-import Data.String.ToString-import Data.Typeable  import Rest.Dictionary import Rest.Error+import Rest.StringMap.HashMap.Strict import Rest.Types.Container  listI :: Inputs a -> Maybe (Inputs (List a))@@ -50,26 +48,26 @@     listDictO JsonO = Just JsonO     listDictO _     = Nothing -mappingI :: forall k i. (Typeable k, IsString k, ToString k) => Inputs i -> Maybe (Inputs (StringMap k i))+mappingI :: forall i. Inputs i -> Maybe (Inputs (StringHashMap String i)) mappingI None       = Just (Dicts [XmlI, JsonI]) mappingI (Dicts is) =   case mapMaybe mappingDictI is of     []  -> Nothing     mis -> Just (Dicts mis)   where-    mappingDictI :: Input i -> Maybe (Input (StringMap k i))+    mappingDictI :: Input i -> Maybe (Input (StringHashMap String i))     mappingDictI XmlI  = Just XmlI     mappingDictI JsonI = Just JsonI     mappingDictI _     = Nothing -mappingO :: forall k o. (Typeable k, IsString k, ToString k) => Outputs o -> Maybe (Outputs (StringMap k o))+mappingO :: forall o. Outputs o -> Maybe (Outputs (StringHashMap String o)) mappingO None       = Just (Dicts [XmlO, JsonO]) mappingO (Dicts os) =   case mapMaybe mappingDictO os of     []  -> Nothing     mos -> Just (Dicts mos)   where-    mappingDictO :: Output o -> Maybe (Output (StringMap k o))+    mappingDictO :: Output o -> Maybe (Output (StringHashMap String o))     mappingDictO XmlO  = Just XmlO     mappingDictO JsonO = Just JsonO     mappingDictO _     = Nothing

@@ -330,9 +330,11 @@         tryD (JsonO      : _ ) JsonFormat   = contentType JsonFormat   >> ok (encode v)         tryD (StringO    : _ ) StringFormat = contentType StringFormat >> ok (UTF8.fromString v)         tryD (MultipartO : _ ) _            = outputMultipart v-        tryD (FileO      : _ ) FileFormat   = do mime <- fromMaybe "application/octet-stream" <$> lookupMimeType (map toLower (snd v))+        tryD (FileO      : _ ) FileFormat   = do let ext = (reverse . takeWhile (/='.') . reverse) $ snd v+                                                 mime <- fromMaybe "application/octet-stream" <$> lookupMimeType (map toLower ext)                                                  setHeader "Content-Type" mime                                                  setHeader "Cache-Control" "max-age=604800"+                                                 setHeader "Content-Disposition" ("filename=" ++ snd v)                                                  ok (fst v)         tryD []                t            = throwError (UnsupportedFormat (show t))         tryD (_          : xs) t            = tryD xs t

@@ -11,48 +11,47 @@ import Control.Applicative import Control.Monad.Reader import Control.Monad.Writer-import Data.Map (Map)--import qualified Data.Map                  as Map+import Data.HashMap.Strict (HashMap) import qualified Data.ByteString.Lazy.UTF8 as UTF8+import qualified Data.HashMap.Strict       as H  import Rest.Driver.Perform (Rest)-import qualified Rest.Driver.Types   as Rest import qualified Rest.Driver.Perform as Rest+import qualified Rest.Driver.Types   as Rest  data RestInput = RestInput-  { headers      :: Map String String-  , parameters   :: Map String String-  , body         :: UTF8.ByteString-  , method       :: Rest.Method-  , paths        :: [String]-  , mimeTypes    :: Map String String+  { headers    :: HashMap String String+  , parameters :: HashMap String String+  , body       :: UTF8.ByteString+  , method     :: Rest.Method+  , paths      :: [String]+  , mimeTypes  :: HashMap String String   }  emptyInput :: RestInput emptyInput = RestInput-  { headers    = Map.empty-  , parameters = Map.empty+  { headers    = H.empty+  , parameters = H.empty   , body       = mempty   , method     = Rest.GET   , paths      = []-  , mimeTypes  = Map.empty+  , mimeTypes  = H.empty   }  data RestOutput = RestOutput-  { headersSet   :: Map String String+  { headersSet   :: HashMap String String   , responseCode :: Maybe Int   } deriving Show  instance Monoid RestOutput where-  mempty = RestOutput { headersSet = Map.empty, responseCode = Nothing }+  mempty = RestOutput { headersSet = H.empty, responseCode = Nothing }   o1 `mappend` o2 = RestOutput-    { headersSet   = headersSet o2 `Map.union` headersSet o1+    { headersSet   = headersSet o2 `H.union` headersSet o1     , responseCode = responseCode o2 <|> responseCode o1     }  outputHeader :: String -> String -> RestOutput-outputHeader h v = mempty { headersSet = Map.singleton h v }+outputHeader h v = mempty { headersSet = H.singleton h v }  outputCode :: Int -> RestOutput outputCode cd = mempty { responseCode = Just cd }@@ -70,11 +69,11 @@ runRestM_ i = fmap fst . runRestM i  instance (Functor m, Applicative m, Monad m) => Rest (RestM m) where-  getHeader    h     = RestM $ asks (Map.lookup h . headers   )-  getParameter p     = RestM $ asks (Map.lookup p . parameters)+  getHeader    h     = RestM $ asks (H.lookup h . headers   )+  getParameter p     = RestM $ asks (H.lookup p . parameters)   getBody            = RestM $ asks body   getMethod          = RestM $ asks method   getPaths           = RestM $ asks paths-  lookupMimeType t   = RestM $ asks (Map.lookup t . mimeTypes)+  lookupMimeType t   = RestM $ asks (H.lookup t . mimeTypes)   setHeader h v      = RestM $ tell (outputHeader h v)   setResponseCode cd = RestM $ tell (outputCode cd)

@@ -4,6 +4,8 @@            , NamedFieldPuns            , FlexibleContexts            , StandaloneDeriving+    , ViewPatterns+    , NamedFieldPuns            , GADTs            , ScopedTypeVariables            , DeriveDataTypeable@@ -34,13 +36,14 @@ import Safe import qualified Control.Monad.State       as State import qualified Data.ByteString.Lazy.UTF8 as LUTF8+import qualified Data.HashMap.Strict       as H import qualified Data.Label.Total          as L-import qualified Data.Map                  as Map  import Network.URI.Encode (decode) import Rest.Api (Some1(..)) import Rest.Container import Rest.Dictionary+import qualified Rest.StringMap.HashMap.Strict as StringHashMap import Rest.Error import Rest.Handler (ListHandler, Handler, GenHandler (..), Env (..), range, mkInputHandler, Range (..)) import Rest.Types.Container.Resource (Resource, Resources (..))@@ -308,11 +311,11 @@     mNewDict =  L.traverse inputs mappingI             <=< L.traverse outputs (mappingO <=< statusO (L.get errors newErrDict))              $  newErrDict-    newAct (Env hs ps (StringMap vs)) =-      do bs <- lift $ forM vs $ \(k, v) -> runErrorT $+    newAct (Env hs ps vs) =+      do bs <- lift $ forM (StringHashMap.toList vs) $ \(k, v) -> runErrorT $            do i <- parseIdent sBy k               mapErrorT (run i) (act (Env hs ps v))-         return (StringMap (zipWith (\(k, _) b -> (k, eitherToStatus b)) vs bs))+         return . StringHashMap.fromList $ zipWith (\(k, _) b -> (k, eitherToStatus b)) (StringHashMap.toList vs) bs  mkMultiGetHandler :: forall m s. (Applicative m, Monad m) => Rest.Router m s -> Handler m mkMultiGetHandler root = mkInputHandler (xmlJsonI . someI . multipartO) $ \(Resources rs) -> multiGetHandler rs@@ -332,13 +335,13 @@     routeResource uri = runRouter GET (splitUriString uri) (routeRoot root)      toRestInput r = Rest.emptyInput-      { Rest.headers    = Map.map R.unValue . fromStringMap . R.headers    $ r-      , Rest.parameters = Map.map R.unValue . fromStringMap . R.parameters $ r+      { 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.paths      = splitUriString (R.uri r)       } -    mkHeaders = map (first HeaderName) . Map.toList+    mkHeaders = map (first HeaderName) . H.toList      mkBodyPart bdy restOutput =       let hdrs = (HeaderName "X-Response-Code", maybe "200" show (Rest.responseCode restOutput))

@@ -1,4 +1,7 @@-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE+    OverloadedStrings+  , ScopedTypeVariables+  #-}  import Control.Applicative import Control.Monad@@ -6,12 +9,13 @@ import Data.Monoid import Test.Framework (defaultMain) import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit (Assertion, assertFailure, assertEqual)+import Test.HUnit (Assertion, assertEqual, assertFailure)  import qualified Data.ByteString.Char8 as Char8-import qualified Data.Map as Map+import qualified Data.HashMap.Strict   as H  import Rest.Api hiding (route)+import Rest.Dictionary import Rest.Driver.Perform (accept) import Rest.Driver.RestM (runRestM_) import Rest.Driver.Routing@@ -19,8 +23,7 @@ import Rest.Handler import Rest.Resource import Rest.Schema-import Rest.Dictionary-import qualified Rest.Api as Rest+import qualified Rest.Api          as Rest import qualified Rest.Driver.RestM as RestM  main :: IO ()@@ -202,5 +205,5 @@  testAcceptHeaders :: Assertion testAcceptHeaders =-  do fmt <- runRestM_ RestM.emptyInput { RestM.headers = Map.singleton "Accept" "text/json" } accept+  do fmt <- runRestM_ RestM.emptyInput { RestM.headers = H.singleton "Accept" "text/json" } accept      assertEqual "Accept json format." [JsonFormat] fmt