apiary 1.4.4 → 1.4.5

raw patch · 4 files changed

+53/−9 lines, 4 filesdep ~http-typesdep ~tastydep ~waiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: http-types, tasty, wai

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• apiary.cabal +1/−1
• src/Control/Monad/Apiary/Action/Internal.hs +5/−5
• tests/Application.hs +38/−3

@@ -1,3 +1,12 @@+# 1.4.5+* fix: MonadPlus lows of ApiaryT Monad++# 1.4.4+* use wai-extra to parse request body++# 1.4.3+* ghc-7.10 compatible+ # 1.4.2 * fix: remove async from API document 

@@ -1,5 +1,5 @@ name:                apiary-version:             1.4.4+version:             1.4.5 synopsis:            Simple and type safe web framework that generate web API documentation. description:   Simple and type safe web framework that can be automatically generate API documentation.

@@ -258,7 +258,7 @@  data Action a      = Continue ActionState a-    | Pass+    | Pass (Maybe RequestBody)     | Stop Wai.Response  newtype ActionT exts prms m a = ActionT { unActionT :: forall b. @@ -280,7 +280,7 @@         => (Dict.Dict prms -> ActionEnv exts -> ActionState -> m (Action a))         -> ActionT exts prms m a actionT f = ActionT $ \dict env !st cont -> f dict env st >>= \case-    Pass            -> return Pass+    Pass b          -> return $ Pass b     Stop s          -> return $ Stop s     Continue !st' a -> cont a st' {-# INLINE actionT #-}@@ -298,7 +298,7 @@ execActionT :: ApiaryConfig -> Extensions exts -> Documents -> ActionT exts '[] IO () -> Wai.Application execActionT config exts doc m request send =      runActionT m Dict.emptyDict (ActionEnv config request doc exts) (initialState config) >>= \case-        Pass         -> notFound config request send+        Pass _       -> notFound config request send         Stop s       -> send s         Continue r _ -> send $ toResponse r @@ -355,11 +355,11 @@     {-# INLINE (<|>) #-}  instance Monad m => MonadPlus (ActionT exts prms m) where-    mzero = ActionT $ \_ _ _ _ -> return Pass+    mzero = ActionT $ \_ _ !st _ -> return $ Pass (actionReqBody st)     mplus m n = ActionT $ \dict e !s cont -> unActionT m dict e s cont >>= \case         Continue !st a -> return $ Continue st a         Stop stp       -> return $ Stop stp-        Pass           -> unActionT n dict e s cont+        Pass b         -> unActionT n dict e s { actionReqBody = b } cont     {-# INLINE mzero #-}     {-# INLINE mplus #-} 

@@ -14,6 +14,7 @@ import Control.Monad.Identity(Identity(..))  import Web.Apiary+import Control.Monad.Apiary.Action import Network.Wai(Request) import qualified Network.Wai.Test as WT import qualified Network.Wai as Wai@@ -34,13 +35,22 @@                    | otherwise        = r { Wai.httpVersion = HTTP.http11 } -------------------------------------------------------------------------------- -assertRequest :: Int -> (Maybe S.ByteString) -> L.ByteString -> Application -> Request -> IO ()-assertRequest sc ct body app req = flip WT.runSession app $ do-    res <- WT.request req+assertSRequest :: Int                -- ^ expected status code+               -> Maybe S.ByteString -- ^ expected content type+               -> L.ByteString       -- ^ expected request body+               -> Application -> WT.SRequest -> IO ()+assertSRequest sc ct body app req = flip WT.runSession app $ do+    res <- WT.srequest req     WT.assertBody body res     WT.assertStatus sc res     maybe (return ()) (flip WT.assertContentType res) ct +assertRequest :: Int                -- ^ expected status code+              -> Maybe S.ByteString -- ^ expected content type+              -> L.ByteString       -- ^ expected request body+              -> Application -> Request -> IO ()+assertRequest sc ct body app req = assertSRequest sc ct body app (WT.SRequest req "")+ assertPlain200 :: L.ByteString -> Application -> Request -> IO () assertPlain200 = assertRequest 200 (Just "text/plain") @@ -326,6 +336,30 @@  -------------------------------------------------------------------------------- +-- https://github.com/philopon/apiary/issues/17++issue17App :: Application+issue17App = runApp $ do+    root $ do+        method GET . ([key|foo|] =: pInt) . action $ do+            foo <- param [key|foo|]+            showing foo++        method POST . action $ do+            ps <- getReqBodyParams+            showing ps++issue17Test :: TestTree+issue17Test = testGroup "issue17" $ map ($ issue17App)+    [ testReq "GET /"          . assert404+    , testReq "GET /?foo=test" . assert404+    , testReq "GET /?foo=12"   . assertPlain200 "12"+    , \app -> testReq "POST /" $ \req -> assertSRequest 200 Nothing "[(\"foo\",\"12\")]" app+      (WT.SRequest req { Wai.requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : Wai.requestHeaders req} "foo=12")+    ]++--------------------------------------------------------------------------------+ test :: TestTree test = testGroup "Application"     [ helloWorldAllTest@@ -338,5 +372,6 @@     , stopTest     , acceptTest     , multipleFilter1Test+    , issue17Test     ]