Spock 0.7.6.0 → 0.7.7.0

raw patch · 10 files changed

+66/−49 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Spock.cabal +2/−2
• src/Web/Spock/Internal/CoreAction.hs +17/−5
• src/Web/Spock/Internal/Wire.hs +9/−20
• src/Web/Spock/Safe.hs +5/−6
• src/Web/Spock/Shared.hs +1/−1
• src/Web/Spock/Simple.hs +22/−14
• test/Web/Spock/FrameworkSpecHelper.hs +5/−0
• test/Web/Spock/SafeSpec.hs +2/−0
• test/Web/Spock/SimpleSpec.hs +2/−0

@@ -1,4 +1,4 @@-Copyright (c) 2013 - 2014, Alexander Thiemann <mail@agrafix.net>+Copyright (c) 2013 - 2015, Alexander Thiemann <mail@agrafix.net>  All rights reserved. 

@@ -1,5 +1,5 @@ name:                Spock-version:             0.7.6.0+version:             0.7.7.0 synopsis:            Another Haskell web framework for rapid development description:         This toolbox provides everything you need to get a quick start into web hacking with haskell: fast routing, middleware, json, sessions, cookies, database helper, csrf-protection Homepage:            https://github.com/agrafix/Spock@@ -8,7 +8,7 @@ license-file:        LICENSE author:              Alexander Thiemann <mail@athiemann.net> maintainer:          Alexander Thiemann <mail@athiemann.net>-copyright:           (c) 2013 - 2014 Alexander Thiemann+copyright:           (c) 2013 - 2015 Alexander Thiemann category:            Web build-type:          Simple cabal-version:       >=1.8

@@ -8,7 +8,7 @@     , files, params, param, param', setStatus, setHeader, redirect     , jumpNext, middlewarePass, modifyVault, queryVault     , setCookie, setCookie'-    , bytes, lazyBytes, text, html, file, json+    , bytes, lazyBytes, text, html, file, json, stream, response     , requireBasicAuth     , preferredFormat, ClientPreferredFormat(..)     )@@ -24,6 +24,7 @@ import Control.Monad.State hiding (get, put) import Data.Monoid import Data.Time+import Network.HTTP.Types.Header (ResponseHeaders) import Network.HTTP.Types.Status import Prelude hiding (head) import System.Locale@@ -209,6 +210,13 @@                       , ";"                       ] +-- | Use a custom 'Wai.Response' generator as response body.+response :: MonadIO m => (Status -> ResponseHeaders -> Wai.Response) -> ActionT m a+response val =+    do modify $ \rs -> rs { rs_responseBody = ResponseBody val }+       throwError ActionDone+{-# INLINE response #-}+ -- | Send a 'ByteString' as response body. Provide your own "Content-Type" bytes :: MonadIO m => BS.ByteString -> ActionT m a bytes val =@@ -218,8 +226,7 @@ -- | Send a lazy 'ByteString' as response body. Provide your own "Content-Type" lazyBytes :: MonadIO m => BSL.ByteString -> ActionT m a lazyBytes val =-    do modify $ \rs -> rs { rs_responseBody = ResponseLBS val }-       throwError ActionDone+    response $ \status headers -> Wai.responseLBS status headers val {-# INLINE lazyBytes #-}  -- | Send text as a response body. Content-Type will be "text/plain"@@ -240,8 +247,7 @@ file :: MonadIO m => T.Text -> FilePath -> ActionT m a file contentType filePath =      do setHeader "Content-Type" contentType-        modify $ \rs -> rs { rs_responseBody = ResponseFile filePath }-        throwError ActionDone+        response $ \status headers -> Wai.responseFile status headers filePath Nothing {-# INLINE file #-}  -- | Send json as response. Content-Type will be "application/json"@@ -250,6 +256,12 @@     do setHeader "Content-Type" "application/json; charset=utf-8"        lazyBytes $ A.encode val {-# INLINE json #-}++-- | Use a 'Wai.StreamingBody' to generate a response.+stream :: MonadIO m => Wai.StreamingBody -> ActionT m a+stream val =+    response $ \status headers -> Wai.responseStream status headers val+{-# INLINE stream #-}  -- | Basic authentification -- provide a title for the prompt and a function to validate

@@ -18,6 +18,7 @@ import Control.Monad.Trans.Resource import Data.Hashable import Data.Maybe+import Network.HTTP.Types.Header (ResponseHeaders) import Network.HTTP.Types.Method import Network.HTTP.Types.Status #if MIN_VERSION_base(4,6,0)@@ -62,18 +63,14 @@    , ri_vaultIf :: VaultIf    } -data ResponseBody-   = ResponseFile FilePath-   | ResponseLBS BSL.ByteString-   | ResponseRedirect !T.Text-   deriving (Show, Eq)+newtype ResponseBody = ResponseBody (Status -> ResponseHeaders -> Wai.Response)  data ResponseState    = ResponseState    { rs_responseHeaders :: !(HM.HashMap (CI.CI BS.ByteString) BS.ByteString)    , rs_status :: !Status    , rs_responseBody :: !ResponseBody-   } deriving (Show, Eq)+   }  data ActionInterupt     = ActionRedirect !T.Text@@ -95,17 +92,8 @@     lift = ActionT . lift . lift  respStateToResponse :: ResponseState -> Wai.Response-respStateToResponse (ResponseState headers status body) =-    case body of-      ResponseFile fp ->-          Wai.responseFile status waiHeaders fp Nothing-      ResponseLBS bsl ->-          Wai.responseLBS status waiHeaders bsl-      ResponseRedirect target ->-          Wai.responseLBS status302 (("Location", T.encodeUtf8 target) : waiHeaders) BSL.empty-    where-      waiHeaders =-          HM.toList headers+respStateToResponse (ResponseState headers status (ResponseBody body)) =+    body status $ HM.toList headers  errorResponse :: Status -> BSL.ByteString -> ResponseState errorResponse s e =@@ -113,8 +101,8 @@     { rs_responseHeaders =           HM.singleton "Content-Type" "text/html"     , rs_status = s-    , rs_responseBody =-        ResponseLBS $+    , rs_responseBody = ResponseBody $ \status headers ->+        Wai.responseLBS status headers $         BSL.concat [ "<html><head><title>"                    , e                    , "</title></head><body><h1>"@@ -200,7 +188,8 @@            runRWST (runErrorT $ runActionT $ selectedAction) env defResp        case r of          Left (ActionRedirect loc) ->-             return $ Just $ ResponseState (rs_responseHeaders respState) status302 (ResponseRedirect loc)+             return $ Just $ ResponseState (rs_responseHeaders respState) status302 $ ResponseBody $+                 \status headers -> Wai.responseLBS status (("Location", T.encodeUtf8 loc) : headers) BSL.empty          Left ActionTryNext ->              applyAction req mkEnv xs          Left (ActionError errorMsg) ->

@@ -111,12 +111,12 @@ -- -- > subcomponent "site" $ -- >   do get "home" homeHandler--- >      get ("misc" <> var) $ -- ...+-- >      get ("misc" <//> var) $ -- ... -- > subcomponent "admin" $ -- >   do get "home" adminHomeHandler ----- The request "/site/home" will be routed to homeHandler and the--- request "/admin/home" will be routed to adminHomeHandler+-- The request \/site\/home will be routed to homeHandler and the+-- request \/admin\/home will be routed to adminHomeHandler subcomponent :: Monad m => Path '[] -> SpockT m () -> SpockT m () subcomponent p (SpockT subapp) = SpockT $ C.subcomponent (SafeRouterPath p) subapp @@ -134,9 +134,8 @@ -- >       do runQuery $ deleteUserFromDb i -- >          redirect "/user-list" -- >--- > get "/user-details/:userId" $--- >   do userId <- param' "userId"--- >      deleteUrl <- safeActionPath (DeleteUser userId)+-- > get ("user-details" <//> var) $ \userId ->+-- >   do deleteUrl <- safeActionPath (DeleteUser userId) -- >      html $ "Click <a href='" <> deleteUrl <> "'>here</a> to delete user!" -- -- Note that safeActions currently only support GET and POST requests.

@@ -20,7 +20,7 @@     , params, param, param'      -- * Sending responses     , setStatus, setHeader, redirect, jumpNext, setCookie, setCookie', bytes, lazyBytes-    , text, html, file, json+    , text, html, file, json, stream, response       -- * Middleware helpers     , middlewarePass, modifyVault, queryVault       -- * Database

@@ -26,7 +26,6 @@ where  import Web.Spock.Shared-import Web.Spock.Internal.CoreAction import Web.Spock.Internal.Types import qualified Web.Spock.Internal.Core as C @@ -52,8 +51,11 @@  newtype SpockRoute     = SpockRoute { _unSpockRoute :: T.Text }-    deriving (Eq, Ord, Show, Read, IsString)+    deriving (Eq, Ord, Show, Read) +instance IsString SpockRoute where+    fromString str = SpockRoute $ combineRoute (T.pack str) ""+ -- | Create a spock application using a given db storageLayer and an initial state. -- Spock works with database libraries that already implement connection pooling and -- with those that don't come with it out of the box. For more see the 'PoolOrConn' type.@@ -76,9 +78,15 @@     C.spockAllT TextRouter liftFun app  -- | Combine two route components safely--- "/foo" <//> "/bar" ===> "/foo/bar"--- "foo" <//> "bar" ===> "/foo/bar"--- "foo <//> "/bar" ===> "/foo/bar"+--+-- >>> "/foo" <//> "/bar"+-- "/foo/bar"+--+-- >>> "foo" <//> "bar"+-- "/foo/bar"+--+-- >>> "foo <//> "/bar"+-- "/foo/bar" (<//>) :: SpockRoute -> SpockRoute -> SpockRoute (SpockRoute t) <//> (SpockRoute t') = SpockRoute $ combineRoute t t' @@ -117,14 +125,14 @@  -- | Define a subcomponent. Usage example: ----- > subcomponent "/site" $--- >   do get "/home" homeHandler--- >      get "/misc/:param" $ -- ...+-- > subcomponent "site" $+-- >   do get "home" homeHandler+-- >      get ("misc" <//> ":param") $ -- ... -- > subcomponent "/admin" $--- >   do get "/home" adminHomeHandler+-- >   get "home" adminHomeHandler ----- The request /site/home will be routed to homeHandler and the--- request /admin/home will be routed to adminHomeHandler+-- The request \/site\/home will be routed to homeHandler and the+-- request \/admin\/home will be routed to adminHomeHandler subcomponent :: Monad m => SpockRoute -> SpockT m () -> SpockT m () subcomponent (SpockRoute p) (SpockT subapp) = SpockT $ C.subcomponent (TextRouterPath p) subapp @@ -142,7 +150,7 @@ -- >       do runQuery $ deleteUserFromDb i -- >          redirect "/user-list" -- >--- > get "/user-details/:userId" $+-- > get ("user-details" <//> ":userId") $ -- >   do userId <- param' "userId" -- >      deleteUrl <- safeActionPath (DeleteUser userId) -- >      html $ "Click <a href='" <> deleteUrl <> "'>here</a> to delete user!"@@ -169,8 +177,8 @@                    , SpockState (SpockAction conn sess st) ~ st)                 => SpockM conn sess st () hookSafeActions =-    do get "/h/:spock-csurf-protection" run-       post "/h/:spock-csurf-protection" run+    do get ("h" <//> ":spock-csurf-protection") run+       post ("h" <//> ":spock-csurf-protection") run     where       run =           do Just h <- param "spock-csurf-protection"

@@ -36,6 +36,11 @@             do get "/askldjas/aklsdj" `shouldRespondWith` "askldjas/aklsdj" { matchStatus = 200 }          it "detected the preferred format" $             do request "GET" "/preferred-format" [("Accept", "text/html,application/xml;q=0.9,image/webp,*/*;q=0.8")] "" `shouldRespondWith` "html" { matchStatus = 200 }+         it "/test-slash and test-noslash are the same thing" $+            do get "/test-slash" `shouldRespondWith` "ok" { matchStatus = 200 }+               get "test-slash" `shouldRespondWith` "ok" { matchStatus = 200 }+               get "/test-noslash" `shouldRespondWith` "ok" { matchStatus = 200 }+               get "test-noslash" `shouldRespondWith` "ok" { matchStatus = 200 }     where       verbTest verb verbVerbose =           (verb "/verb-test")

@@ -17,6 +17,8 @@        put "verb-test" $ text "PUT"        delete "verb-test" $ text "DELETE"        patch "verb-test" $ text "PATCH"+       get "test-slash" $ text "ok"+       get "/test-noslash" $ text "ok"        get ("param-test" <//> var) $ \(i :: Int) ->            text $ "int" <> (T.pack $ show i)        get ("param-test" <//> "static") $

@@ -17,6 +17,8 @@        put "/verb-test" $ text "PUT"        delete "/verb-test" $ text "DELETE"        patch "/verb-test" $ text "PATCH"+       get "test-slash" $ text "ok"+       get "/test-noslash" $ text "ok"        get "/param-test/:int" $            do Just (i :: Int) <- param "int"               text $ "int" <> (T.pack $ show i)