From 26d7aa5e47dc8180b881e701052865a207a455fe Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Wed, 27 May 2015 16:19:11 -0300 Subject: [PATCH] Add more tests to the core. --- serversession/tests/Main.hs | 176 +++++++++++++++++++++++++++++------- 1 file changed, 145 insertions(+), 31 deletions(-) diff --git a/serversession/tests/Main.hs b/serversession/tests/Main.hs index 7fcab05..77e48dd 100644 --- a/serversession/tests/Main.hs +++ b/serversession/tests/Main.hs @@ -1,25 +1,41 @@ module Main (main) where +import Control.Arrow import Control.Monad import Data.Maybe import Data.Typeable (Typeable) import Test.Hspec import Test.Hspec.QuickCheck -import Test.QuickCheck.Property (ioProperty, (===)) import Web.PathPieces import Web.ServerSession.Core.Internal import qualified Control.Exception as E import qualified Crypto.Nonce as N +import qualified Data.ByteString.Char8 as B8 import qualified Data.IORef as I import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Time as TI +import qualified Test.QuickCheck.Property as Q main :: IO () main = hspec $ parallel $ do + -- State using () as storage. As () is not a Storage instance, + -- this is the state to be used when testing functions that + -- should not touch the storage in any code path. + stnull <- runIO $ createState () + + -- State using TNTStorage. This state should be used for + -- functions that normally need to access the storage but on + -- the test code path should not do so. + sttnt <- runIO $ createState TNTStorage + + -- Some functions take a time argument meaning "now". We don't + -- gain anything using real "now", so here's a fake "now". + let fakenow = read "2015-05-27 17:55:41 UTC" :: TI.UTCTime + describe "SessionId" $ do gen <- runIO N.new it "is generated with 24 bytes from letters, numbers, dashes and underscores" $ do @@ -36,9 +52,9 @@ main = hspec $ parallel $ do observed `shouldBe` expected prop "accepts as valid the session IDs generated by ourselves" $ - ioProperty $ do + Q.ioProperty $ do sid <- generateSessionId gen - return $ fromPathPiece (toPathPiece sid) === Just sid + return $ fromPathPiece (toPathPiece sid) Q.=== Just sid it "does not accept as valid some example invalid session IDs" $ do let parse = fromPathPiece :: T.Text -> Maybe SessionId @@ -53,27 +69,27 @@ main = hspec $ parallel $ do describe "State" $ do it "has the expected default values" $ do -- A silly test to avoid unintended change of default values. - st <- createState () - cookieName st `shouldBe` "JSESSIONID" - authKey st `shouldBe` "_ID" - idleTimeout st `shouldBe` Just (60*60*24*7) - absoluteTimeout st `shouldBe` Just (60*60*24*60) - persistentCookies st `shouldBe` True - httpOnlyCookies st `shouldBe` True - secureCookies st `shouldBe` False + cookieName stnull `shouldBe` "JSESSIONID" + authKey stnull `shouldBe` "_ID" + idleTimeout stnull `shouldBe` Just (60*60*24*7) + absoluteTimeout stnull `shouldBe` Just (60*60*24*60) + persistentCookies stnull `shouldBe` True + httpOnlyCookies stnull `shouldBe` True + secureCookies stnull `shouldBe` False it "has sane setters of ambiguous types" $ do - st <- createState () - cookieName (setCookieName "a" st) `shouldBe` "a" - authKey (setAuthKey "a" st) `shouldBe` "a" - idleTimeout (setIdleTimeout (Just 1) st) `shouldBe` Just 1 - absoluteTimeout (setAbsoluteTimeout (Just 1) st) `shouldBe` Just 1 - persistentCookies (setPersistentCookies False st) `shouldBe` False - httpOnlyCookies (setHttpOnlyCookies False st) `shouldBe` False - secureCookies (setSecureCookies True st) `shouldBe` True + cookieName (setCookieName "a" stnull) `shouldBe` "a" + authKey (setAuthKey "a" stnull) `shouldBe` "a" + idleTimeout (setIdleTimeout (Just 1) stnull) `shouldBe` Just 1 + absoluteTimeout (setAbsoluteTimeout (Just 1) stnull) `shouldBe` Just 1 + persistentCookies (setPersistentCookies False stnull) `shouldBe` False + httpOnlyCookies (setHttpOnlyCookies False stnull) `shouldBe` False + secureCookies (setSecureCookies True stnull) `shouldBe` True describe "loadSession" $ do let checkEmptySession (sessionMap, SaveSessionToken msession time) = do + -- Saved time is close to now, session map is empty, + -- there's no reference to an existing session. let point1 = 0.1 {- second -} :: Double now <- TI.getCurrentTime abs (realToFrac $ TI.diffUTCTime now time) `shouldSatisfy` (< point1) @@ -81,13 +97,11 @@ main = hspec $ parallel $ do msession `shouldSatisfy` isNothing it "returns empty session and token when the session ID cookie is not present" $ do - st <- createState TNTStorage - ret <- loadSession st Nothing + ret <- loadSession sttnt Nothing checkEmptySession ret it "does not need the storage if session ID cookie has invalid data" $ do - st <- createState TNTStorage - ret <- loadSession st (Just "123456789-123456789-123") + ret <- loadSession sttnt (Just "123456789-123456789-123") checkEmptySession ret it "returns empty session and token when the session ID cookie refers to inexistent session" $ do @@ -99,16 +113,79 @@ main = hspec $ parallel $ do ret <- loadSession st (Just "123456789-123456789-1234") checkEmptySession ret - it "should have more tests" pending + it "returns the session from the storage when the session ID refers to an existing session" $ do + let session = Session + { sessionKey = S "123456789-123456789-1234" + , sessionAuthId = Just authId + , sessionData = M.fromList [("a", "b"), ("c", "d")] + , sessionCreatedAt = TI.addUTCTime (-10) fakenow + , sessionAccessedAt = TI.addUTCTime (-5) fakenow + } + authId = "auth-id" + st <- createState =<< prepareMockStorage [session] + (retSessionMap, SaveSessionToken msession _now) <- + loadSession st (Just $ B8.pack $ T.unpack $ unS $ sessionKey session) + retSessionMap `shouldBe` M.insert (authKey st) authId (sessionData session) + msession `shouldBe` Just session describe "checkExpired" $ do - it "should have more tests" pending + prop "agrees with nextExpires" $ + \idleSecs absSecs -> + let idleDiff = realToFrac $ max 1 $ abs (idleSecs :: Int) + absDiff = realToFrac $ max 1 $ abs (absSecs :: Int) + st' = setIdleTimeout (Just idleDiff) $ + setAbsoluteTimeout (Just absDiff) stnull + sessTimes = do + diff <- [0, idleDiff, absDiff] + off <- [1, 0, -1] + return $ TI.addUTCTime (negate $ diff + off) fakenow + sessions = do + createdAt <- sessTimes + accessedAt <- sessTimes + return $ Session + { sessionKey = error "irrelevant 1" + , sessionAuthId = error "irrelevant 2" + , sessionData = error "irrelevant 3" + , sessionCreatedAt = createdAt + , sessionAccessedAt = accessedAt + } + test s = + Q.counterexample + (unlines + [ "fakenow = " ++ show fakenow + , "createdAt = " ++ show (sessionCreatedAt s) + , "accessedAt = " ++ show (sessionAccessedAt s) + , "checkRet ~ " ++ show (() <$ checkRet) + , "nextRet = " ++ show nextRet ]) + (isJust checkRet == (nextRet >= Just fakenow)) + where checkRet = checkExpired fakenow st' s + nextRet = nextExpires st' s + in Q.conjoin (test <$> sessions) describe "nextExpires" $ do - it "should have more tests" pending + it "should have unit tests" pending describe "cookieExpires" $ do - it "should have more tests" pending + prop "is Nothing for non-persistent cookies regardless of session" $ + \midleSecs mabsSecs -> + let idleDiff = realToFrac . max 1 . abs <$> (midleSecs :: Maybe Int) + absDiff = realToFrac . max 1 . abs <$> (mabsSecs :: Maybe Int) + st' = setIdleTimeout idleDiff $ + setAbsoluteTimeout absDiff $ + setPersistentCookies False stnull + in cookieExpires st' (error "irrelevant") Q.=== Nothing + it "is a long time for persistent cookies without timeouts regardless of session" $ + let st' = setIdleTimeout Nothing $ + setAbsoluteTimeout Nothing stnull + session = Session + { sessionKey = error "irrelevant 1" + , sessionAuthId = error "irrelevant 2" + , sessionData = error "irrelevant 3" + , sessionCreatedAt = error "irrelevant 4" + , sessionAccessedAt = fakenow + } + distantFuture = TI.addUTCTime (60*60*24*365*10) fakenow + in cookieExpires st' session `shouldSatisfy` maybe False (>= distantFuture) describe "saveSession" $ do it "should have more tests" pending @@ -116,19 +193,56 @@ main = hspec $ parallel $ do describe "invalidateIfNeeded" $ do it "should have more tests" pending - describe "decomposeSession" $ do - it "should have more tests" pending - describe "saveSessionOnDb" $ do it "should have more tests" pending - describe "toSessionMap" $ do + describe "decomposeSession" $ do + prop "it is sane when not finding auth key or force invalidate key" $ + \data_ -> + let sessionMap = mkSessionMap $ filter (notSpecial . fst) $ data_ + notSpecial = flip notElem [authKey stnull, forceInvalidateKey] . T.pack + in decomposeSession stnull sessionMap `shouldBe` + DecomposedSession Nothing DoNotForceInvalidate sessionMap + + prop "parses the force invalidate key" $ + \data_ -> + let sessionMap v = M.insert forceInvalidateKey (B8.pack $ show v) $ mkSessionMap data_ + allForces = [minBound..maxBound] :: [ForceInvalidate] + test v = dsForceInvalidate (decomposeSession stnull $ sessionMap v) Q.=== v + in Q.conjoin (test <$> allForces) + it "should have more tests" pending + describe "toSessionMap" $ do + let mkSession authId data_ = Session + { sessionKey = error "irrelevant 1" + , sessionAuthId = authId + , sessionData = mkSessionMap data_ + , sessionCreatedAt = error "irrelevant 2" + , sessionAccessedAt = error "irrelevant 3" + } + + prop "does not change session data for sessions without auth ID" $ + \data_ -> + let s = mkSession Nothing data_ + in toSessionMap stnull s Q.=== sessionData s + + prop "adds (overwriting) the auth ID to the session data" $ + \authId_ data_ -> + let s = mkSession (Just authId) ((T.unpack k, "foo") : data_) + k = authKey stnull + authId = B8.pack authId_ + in toSessionMap stnull s Q.=== M.adjust (const authId) k (sessionData s) + describe "MockStorage" $ do it "passes the storage test" pending +-- | Used to generate session maps on QuickCheck properties. +mkSessionMap :: [(String, String)] -> SessionMap +mkSessionMap = M.fromList . map (T.pack *** B8.pack) + + ----------------------------------------------------------------------