yesod-test 1.2.0 → 1.2.1

raw patch · 2 files changed

+115/−32 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Yesod/Test.hs +114/−31
• yesod-test.cabal +1/−1

@@ -27,6 +27,7 @@     ( -- * Declaring and running your test suite       yesodSpec     , YesodSpec+    , yesodSpecWithSiteGenerator     , YesodExample     , YesodSpecTree (..)     , ydescribe@@ -41,12 +42,14 @@     --     , get     , post+    , postBody     , request     , addRequestHeader     , setMethod     , addPostParam     , addGetParam     , addFile+    , setRequestBody     , RequestBuilder     , setUrl @@ -164,7 +167,7 @@ getResponse = fmap yedResponse ST.get  data RequestBuilderData site = RequestBuilderData-    { rbdPosts :: [RequestPart]+    { rbdPostData :: RBDPostData     , rbdResponse :: (Maybe SResponse)     , rbdMethod :: H.Method     , rbdSite :: site@@ -173,9 +176,12 @@     , rbdHeaders :: H.RequestHeaders     } +data RBDPostData = MultipleItemsPostData [RequestPart]+                 | BinaryPostData BSL8.ByteString+ -- | Request parts let us discern regular key/values from files sent in the request. data RequestPart-  = ReqPlainPart T.Text T.Text+  = ReqKvPart T.Text T.Text   | ReqFilePart T.Text FilePath BSL8.ByteString T.Text  -- | The RequestBuilder state monad constructs an url encoded string of arguments@@ -205,6 +211,28 @@             , yedResponse = Nothing             } +-- | Same as yesodSpec, but instead of taking already built site it+-- takes an action which produces site for each test.+yesodSpecWithSiteGenerator :: YesodDispatch site+                           => IO site+                           -> YesodSpec site+                           -> Hspec.Spec+yesodSpecWithSiteGenerator getSiteAction yspecs =+    Core.fromSpecList $ map (unYesod getSiteAction) $ execWriter yspecs+    where+      unYesod :: YesodDispatch t+              => IO t -> YesodSpecTree t -> Core.SpecTree+      unYesod getSiteAction' (YesodSpecGroup x y) = Core.SpecGroup x $ map (unYesod getSiteAction') y+      unYesod getSiteAction' (YesodSpecItem x y) = Core.it x $ do+        site <- getSiteAction'+        app <- toWaiAppPlain site+        ST.evalStateT y YesodExampleData+            { yedApp = app+            , yedSite = site+            , yedCookies = M.empty+            , yedResponse = Nothing+            }+ -- | Describe a single test that keeps cookies, and a reference to the last response. yit :: String -> YesodExample site () -> YesodSpec site yit label example = tell [YesodSpecItem label example]@@ -347,9 +375,10 @@ -- | Add a parameter with the given name and value. addPostParam :: T.Text -> T.Text -> RequestBuilder site () addPostParam name value =-    ST.modify $ \rbd -> rbd-        { rbdPosts = ReqPlainPart name value : rbdPosts rbd-        }+  ST.modify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }+  where addPostData (BinaryPostData _) = error "Trying to add post param to binary content."+        addPostData (MultipleItemsPostData posts) =+          MultipleItemsPostData $ ReqKvPart name value : posts  addGetParam :: T.Text -> T.Text -> RequestBuilder site () addGetParam name value = ST.modify $ \rbd -> rbd@@ -363,9 +392,10 @@ addFile :: T.Text -> FilePath -> T.Text -> RequestBuilder site () addFile name path mimetype = do   contents <- liftIO $ BSL8.readFile path-  ST.modify $ \rbd -> rbd-    { rbdPosts = ReqFilePart name path contents mimetype : rbdPosts rbd-    }+  ST.modify $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd) contents) }+    where addPostData (BinaryPostData _) _ = error "Trying to add file after setting binary content."+          addPostData (MultipleItemsPostData posts) contents =+            MultipleItemsPostData $ ReqFilePart name path contents mimetype : posts  -- This looks up the name of a field based on the contents of the label pointing to it. nameFromLabel :: T.Text -> RequestBuilder site T.Text@@ -436,9 +466,19 @@      => url      -> YesodExample site () post url = request $ do-    setMethod "POST"-    setUrl url+  setMethod "POST"+  setUrl url +-- | Perform a POST request to url with sending a body into it.+postBody :: (Yesod site, RedirectUrl site url)+         => url+         -> BSL8.ByteString+         -> YesodExample site ()+postBody url body = request $ do+  setMethod "POST"+  setUrl url+  setRequestBody body+ -- | Perform a GET request to url, using params get :: (Yesod site, RedirectUrl site url)     => url@@ -471,6 +511,12 @@         , rbdGets = rbdGets rbd ++ H.parseQuery (TE.encodeUtf8 urlQuery)         } +-- | Simple way to set HTTP request body+setRequestBody :: (Yesod site)+               => BSL8.ByteString+               -> RequestBuilder site ()+setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData body }+ addRequestHeader :: H.Header -> RequestBuilder site () addRequestHeader header = ST.modify $ \rbd -> rbd     { rbdHeaders = header : rbdHeaders rbd@@ -485,7 +531,7 @@     YesodExampleData app site oldCookies mRes <- ST.get      RequestBuilderData {..} <- liftIO $ ST.execStateT reqBuilder RequestBuilderData-      { rbdPosts = []+      { rbdPostData = MultipleItemsPostData []       , rbdResponse = mRes       , rbdMethod = "GET"       , rbdSite = site@@ -500,11 +546,21 @@     let cookies = M.filter (checkCookieTime currentUtc) oldCookies         cookiesForPath = M.filter (checkCookiePath path) cookies -    let maker-          | DL.any isFile rbdPosts = makeMultipart-          | otherwise = makeSinglepart-        req = maker cookiesForPath rbdPosts rbdMethod rbdHeaders path rbdGets-+    let req = case rbdPostData of+          MultipleItemsPostData x ->+            if DL.any isFile x+            then (multipart x)+            else singlepart+          BinaryPostData _ -> singlepart+          where singlepart = makeSinglepart cookiesForPath rbdPostData rbdMethod rbdHeaders path rbdGets+                multipart x = makeMultipart cookiesForPath x rbdMethod rbdHeaders path rbdGets+    -- let maker = case rbdPostData of+    --       MultipleItemsPostData x ->+    --         if DL.any isFile x+    --         then makeMultipart+    --         else makeSinglepart+    --       BinaryPostData _ -> makeSinglepart+    -- let req = maker cookiesForPath rbdPostData rbdMethod rbdHeaders path rbdGets     response <- liftIO $ runSession (srequest req) app     let newCookies = map (Cookie.parseSetCookie . snd) $ DL.filter (("Set-Cookie"==) . fst) $ simpleHeaders response         cookies' = M.fromList [(Cookie.setCookieName c, c) | c <- newCookies] `M.union` cookies@@ -525,15 +581,28 @@     boundary :: String     boundary = "*******noneedtomakethisrandom"     separator = BS8.concat ["--", BS8.pack boundary, "\r\n"]+    makeMultipart :: M.Map a0 Cookie.SetCookie+                  -> [RequestPart]+                  -> H.Method+                  -> [H.Header]+                  -> T.Text+                  -> H.Query+                  -> SRequest     makeMultipart cookies parts method extraHeaders urlPath urlQuery =-      flip SRequest (BSL8.fromChunks [multiPartBody parts]) $ mkRequest-        [ ("Cookie", Builder.toByteString $ Cookie.renderCookies-              [(Cookie.setCookieName c, Cookie.setCookieValue c) | c <- map snd $ M.toList cookies])-        , ("Content-Type", BS8.pack $ "multipart/form-data; boundary=" ++ boundary)-        ] method extraHeaders urlPath urlQuery+      SRequest simpleRequest' (simpleRequestBody' parts)+      where simpleRequestBody' x =+              BSL8.fromChunks [multiPartBody x]+            simpleRequest' = mkRequest+                             [ ("Cookie", cookieValue)+                             , ("Content-Type", contentTypeValue)]+                             method extraHeaders urlPath urlQuery+            cookieValue = Builder.toByteString $ Cookie.renderCookies cookiePairs+            cookiePairs = [ (Cookie.setCookieName c, Cookie.setCookieValue c)+                          | c <- map snd $ M.toList cookies ]+            contentTypeValue = BS8.pack $ "multipart/form-data; boundary=" ++ boundary     multiPartBody parts =       BS8.concat $ separator : [BS8.concat [multipartPart p, separator] | p <- parts]-    multipartPart (ReqPlainPart k v) = BS8.concat+    multipartPart (ReqKvPart k v) = BS8.concat       [ "Content-Disposition: form-data; "       , "name=\"", TE.encodeUtf8 k, "\"\r\n\r\n"       , TE.encodeUtf8 v, "\r\n"]@@ -545,15 +614,29 @@       , BS8.concat $ BSL8.toChunks bytes, "\r\n"]      -- For building the regular non-multipart requests-    makeSinglepart cookies parts method extraHeaders urlPath urlQuery = SRequest (mkRequest-      [ ("Cookie", Builder.toByteString $ Cookie.renderCookies-              [(Cookie.setCookieName c, Cookie.setCookieValue c) | c <- map snd $ M.toList cookies])-      , ("Content-Type", "application/x-www-form-urlencoded")-      ] method extraHeaders urlPath urlQuery) $-      BSL8.fromChunks $ return $ TE.encodeUtf8 $ T.intercalate "&" $ map singlepartPart parts--    singlepartPart (ReqFilePart _ _ _ _) = ""-    singlepartPart (ReqPlainPart k v) = T.concat [k,"=",v]+    makeSinglepart :: M.Map a0 Cookie.SetCookie+                   -> RBDPostData+                   -> H.Method+                   -> [H.Header]+                   -> T.Text+                   -> H.Query+                   -> SRequest+    makeSinglepart cookies rbdPostData method extraHeaders urlPath urlQuery =+      SRequest simpleRequest' (simpleRequestBody' rbdPostData)+      where+        simpleRequest' = (mkRequest+                          [ ("Cookie", cookieValue)+                          , ("Content-Type", "application/x-www-form-urlencoded")]+                          method extraHeaders urlPath urlQuery)+        simpleRequestBody' (MultipleItemsPostData x) =+          BSL8.fromChunks $ return $ TE.encodeUtf8 $ T.intercalate "&"+          $ map singlepartPart x+        simpleRequestBody' (BinaryPostData x) = x+        cookieValue = Builder.toByteString $ Cookie.renderCookies cookiePairs+        cookiePairs = [ (Cookie.setCookieName c, Cookie.setCookieValue c)+                      | c <- map snd $ M.toList cookies ]+        singlepartPart (ReqFilePart _ _ _ _) = ""+        singlepartPart (ReqKvPart k v) = T.concat [k,"=",v]      -- General request making     mkRequest headers method extraHeaders urlPath urlQuery = defaultRequest

@@ -1,5 +1,5 @@ name:               yesod-test-version:            1.2.0+version:            1.2.1 license:            MIT license-file:       LICENSE author:             Nubis <nubis@woobiz.com.ar>