wai-extra 3.0.5 → 3.0.6

raw patch · 4 files changed

+295/−10 lines, 4 filesdep +cookiedep ~blaze-builderdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: cookie

Dependency ranges changed: blaze-builder, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/Wai/Test.hs +129/−9
• test/Network/Wai/TestSpec.hs +157/−0
• wai-extra.cabal +5/−1

@@ -1,3 +1,7 @@+## 3.0.6++* Add Cookie Handling to Network.Wai.Test [#356](https://github.com/yesodweb/wai/pull/356)+ ## 3.0.5  * add functions to extract authentication data from Authorization header [#352](add functions to extract authentication data from Authorization header #352)

@@ -5,6 +5,12 @@     ( -- * Session       Session     , runSession+      -- * Client Cookies+    , ClientCookies+    , getClientCookies+    , modifyClientCookies+    , setClientCookie+    , deleteClientCookie       -- * Requests     , request     , srequest@@ -20,13 +26,18 @@     , assertBodyContains     , assertHeader     , assertNoHeader+    , assertClientCookieExists+    , assertNoClientCookieExists+    , assertClientCookieValue     , WaiTestFailure (..)     ) where  import Network.Wai import Network.Wai.Internal (ResponseReceived (ResponseReceived))+import Control.Applicative ((<$>)) import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.State (StateT, evalStateT)+import Control.Monad.Trans.Class (lift)+import qualified Control.Monad.Trans.State as ST import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask) import Control.Monad (unless) import Control.DeepSeq (deepseq)@@ -34,9 +45,10 @@ import Data.Typeable (Typeable) import Data.Map (Map) import qualified Data.Map as Map+import qualified Web.Cookie as Cookie import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8-import Blaze.ByteString.Builder (toLazyByteString)+import Blaze.ByteString.Builder (toLazyByteString, toByteString) import qualified Blaze.ByteString.Builder as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8@@ -47,18 +59,53 @@ import qualified Data.Text.Encoding as TE import Data.IORef import Data.Monoid (mempty, mappend)+import Data.Time.Clock (getCurrentTime) -type Session = ReaderT Application (StateT ClientState IO)+type Session = ReaderT Application (ST.StateT ClientState IO) +-- |+--+-- Since 3.0.6+type ClientCookies = Map ByteString Cookie.SetCookie+ data ClientState = ClientState-    { _clientCookies :: Map ByteString ByteString+    { clientCookies :: ClientCookies     } +-- |+--+-- Since 3.0.6+getClientCookies :: Session ClientCookies+getClientCookies = clientCookies <$> lift ST.get++-- |+--+-- Since 3.0.6+modifyClientCookies :: (ClientCookies -> ClientCookies) -> Session ()+modifyClientCookies f =+  lift (ST.modify (\cs -> cs { clientCookies = f $ clientCookies cs }))++-- |+--+-- Since 3.0.6+setClientCookie :: Cookie.SetCookie -> Session ()+setClientCookie c =+  modifyClientCookies+    (Map.insert (Cookie.setCookieName c) c)++-- |+--+-- Since 3.0.6+deleteClientCookie :: ByteString -> Session ()+deleteClientCookie cookieName =+  modifyClientCookies+    (Map.delete cookieName)+ initState :: ClientState initState = ClientState Map.empty  runSession :: Session a -> Application -> IO a-runSession session app = evalStateT (runReaderT session app) initState+runSession session app = ST.evalStateT (runReaderT session app) initState  data SRequest = SRequest     { simpleRequest :: Request@@ -93,6 +140,40 @@     dropFrontSlash ("":path) = path     dropFrontSlash path = path +addCookiesToRequest :: Request -> Session Request+addCookiesToRequest req = do+  oldClientCookies <- getClientCookies+  let requestPath = "/" `T.append` T.intercalate "/" (pathInfo req)+  currentUTCTime <- liftIO getCurrentTime+  let cookiesForRequest =+        Map.filter+          (\c -> checkCookieTime currentUTCTime c+              && checkCookiePath requestPath c)+          oldClientCookies+  let cookiePairs = [ (Cookie.setCookieName c, Cookie.setCookieValue c)+                    | c <- map snd $ Map.toList cookiesForRequest+                    ]+  let cookieValue = toByteString $ Cookie.renderCookies cookiePairs+  return $ req { requestHeaders = ("Cookie", cookieValue):requestHeaders req }+    where checkCookieTime t c =+            case Cookie.setCookieExpires c of+              Nothing -> True+              Just t' -> t < t'+          checkCookiePath p c =+            case Cookie.setCookiePath c of+              Nothing -> True+              Just p' -> p' `S8.isPrefixOf` TE.encodeUtf8 p++extractSetCookieFromSResponse :: SResponse -> Session SResponse+extractSetCookieFromSResponse response = do+  let setCookieHeaders =+        filter (("Set-Cookie"==) . fst) $ simpleHeaders response+  let newClientCookies = map (Cookie.parseSetCookie . snd) setCookieHeaders+  modifyClientCookies+    (Map.union+       (Map.fromList [(Cookie.setCookieName c, c) | c <- newClientCookies ]))+  return response+ srequest :: SRequest -> Session SResponse srequest (SRequest req bod) = do     app <- ask@@ -103,12 +184,12 @@                     [] -> ([], S.empty)                     x:y -> (y, x)             }-    liftIO $ do+    req'' <- addCookiesToRequest req'+    response <- liftIO $ do         ref <- newIORef $ error "runResponse gave no result"-        ResponseReceived <- app req' (runResponse ref)+        ResponseReceived <- app req'' (runResponse ref)         readIORef ref-    -- FIXME cookie processing-    --return sres+    extractSetCookieFromSResponse response  runResponse :: IORef SResponse -> Response -> IO ResponseReceived runResponse ref res = do@@ -212,3 +293,42 @@             , " containing "             , show s             ]++-- |+--+-- Since 3.0.6+assertClientCookieExists :: String -> ByteString -> Session ()+assertClientCookieExists s cookieName = do+  cookies <- getClientCookies+  assertBool s $ Map.member cookieName cookies++-- |+--+-- Since 3.0.6+assertNoClientCookieExists :: String -> ByteString -> Session ()+assertNoClientCookieExists s cookieName = do+  cookies <- getClientCookies+  assertBool s $ not $ Map.member cookieName cookies++-- |+--+-- Since 3.0.6+assertClientCookieValue :: String -> ByteString -> ByteString -> Session ()+assertClientCookieValue s cookieName cookieValue = do+  cookies <- getClientCookies+  case Map.lookup cookieName cookies of+    Nothing ->+      assertFailure (s ++ " (cookie does not exist)")+    Just c  ->+      assertBool+        (concat+          [ s+          , " (actual value "+          , show $ Cookie.setCookieValue c+          , " expected value "+          , show cookieValue+          , ")"+          ]+        )+        (Cookie.setCookieValue c == cookieValue)+

@@ -1,11 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Wai.TestSpec (main, spec) where +import           Control.Monad (void)++import qualified Data.Text.Encoding as TE++import           Data.Time.Calendar (fromGregorian)+import           Data.Time.Clock (UTCTime(..))+ import           Test.Hspec  import           Network.Wai import           Network.Wai.Test +import           Network.HTTP.Types (status200)++import qualified Data.ByteString.Lazy.Char8 as L8+import           Blaze.ByteString.Builder (toByteString)++import qualified Web.Cookie as Cookie+ main :: IO () main = hspec spec @@ -34,3 +48,146 @@     context "when path has no query string" $ do       it "sets rawQueryString to empty string" $ do         rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""++  describe "request" $ do++    let simpleApp _req respond =+          respond $+            responseLBS+              status200+              [("foo", "bar")]+              "simple"++    it "returns the status code      of a simple app on default request" $ do+      sresp <- runSession (request defaultRequest) simpleApp+      simpleStatus sresp `shouldBe` status200++    it "returns the response body    of a simple app on default request" $ do+      sresp <- runSession (request defaultRequest) simpleApp+      simpleBody sresp `shouldBe` "simple"++    it "returns the response headers of a simple app on default request" $ do+      sresp <- runSession (request defaultRequest) simpleApp+      simpleHeaders sresp `shouldBe` [("foo", "bar")]++    let cookieApp req respond =+          case pathInfo req of+            ["set", name, val] ->+              respond $+                responseLBS+                  status200+                  [( "Set-Cookie"+                   , toByteString $ Cookie.renderSetCookie $+                      Cookie.def { Cookie.setCookieName  = TE.encodeUtf8 name+                                 , Cookie.setCookieValue = TE.encodeUtf8 val+                                 }+                   )+                  ]+                  "set_cookie_body"+            ["delete", name] ->+              respond $+                responseLBS+                  status200+                  [( "Set-Cookie"+                   , toByteString $ Cookie.renderSetCookie $+                      Cookie.def { Cookie.setCookieName  =+                                     TE.encodeUtf8 name+                                 , Cookie.setCookieExpires =+                                     Just $ UTCTime (fromGregorian 1970 1 1) 0+                                 }+                   )+                  ]+                  "set_cookie_body"+            _ ->+              respond $+                responseLBS+                  status200+                  []+                  ( L8.pack+                  $ show+                  $ map snd+                  $ filter ((=="Cookie") . fst)+                  $ requestHeaders req+                  )++    it "sends a Cookie header with correct value after receiving a Set-Cookie header" $ do+      sresp <- flip runSession cookieApp $ do+                 void $ request $+                   setPath defaultRequest "/set/cookie_name/cookie_value"+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"++    it "sends a Cookie header with updated value after receiving a Set-Cookie header update" $ do+      sresp <- flip runSession cookieApp $ do+                 void $ request $+                   setPath defaultRequest "/set/cookie_name/cookie_value"+                 void $ request $+                   setPath defaultRequest "/set/cookie_name/cookie_value2"+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"++    it "handles multiple cookies" $ do+      sresp <- flip runSession cookieApp $ do+                 void $ request $+                   setPath defaultRequest "/set/cookie_name/cookie_value"+                 void $ request $+                   setPath defaultRequest "/set/cookie_name2/cookie_value2"+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value;cookie_name2=cookie_value2\"]"++    it "removes a deleted cookie" $ do+      sresp <- flip runSession cookieApp $ do+                 void $ request $+                   setPath defaultRequest "/set/cookie_name/cookie_value"+                 void $ request $+                   setPath defaultRequest "/set/cookie_name2/cookie_value2"+                 void $ request $+                   setPath defaultRequest "/delete/cookie_name2"+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"++    it "sends a cookie set with setClientCookie to server" $ do+      sresp <- flip runSession cookieApp $ do+                 setClientCookie+                   (Cookie.def { Cookie.setCookieName = "cookie_name"+                               , Cookie.setCookieValue = "cookie_value"+                               }+                   )+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value\"]"++    it "sends a cookie updated with setClientCookie to server" $ do+      sresp <- flip runSession cookieApp $ do+                 setClientCookie+                   (Cookie.def { Cookie.setCookieName = "cookie_name"+                               , Cookie.setCookieValue = "cookie_value"+                               }+                   )+                 setClientCookie+                   (Cookie.def { Cookie.setCookieName = "cookie_name"+                               , Cookie.setCookieValue = "cookie_value2"+                               }+                   )+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"cookie_name=cookie_value2\"]"++    it "does not send a cookie deleted with deleteClientCookie to server" $ do+      sresp <- flip runSession cookieApp $ do+                 setClientCookie+                   (Cookie.def { Cookie.setCookieName = "cookie_name"+                               , Cookie.setCookieValue = "cookie_value"+                               }+                   )+                 deleteClientCookie "cookie_name"+                 request $+                   setPath defaultRequest "/get"+      simpleBody sresp `shouldBe` "[\"\"]"+++

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.5+Version:             3.0.6 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality:@@ -108,6 +108,7 @@                    , deepseq                    , streaming-commons                    , unix-compat+                   , cookie    if os(windows)       cpp-options:   -DWINDOWS@@ -157,6 +158,9 @@                    , resourcet                    , bytestring                    , HUnit+                   , blaze-builder+                   , cookie+                   , time     ghc-options:     -Wall -Werror  source-repository head