serversession 1.0.1 → 1.0.2
raw patch · 5 files changed
+39/−18 lines, 5 filesdep +persistent-testnew-uploader
Dependencies added: persistent-test
Files
- changelog.md +2/−0
- serversession.cabal +20/−6
- src/Web/ServerSession/Core/Internal.hs +2/−2
- src/Web/ServerSession/Core/StorageTests.hs +7/−6
- tests/Main.hs +8/−4
+ changelog.md view
@@ -0,0 +1,2 @@+# 1.0.2+* add persistent-test to deps
serversession.cabal view
@@ -1,29 +1,36 @@+cabal-version: >= 1.10 name: serversession-version: 1.0.1+version: 1.0.2 license: MIT license-file: LICENSE author: Felipe Lessa <felipe.lessa@gmail.com>-maintainer: Felipe Lessa <felipe.lessa@gmail.com>+maintainer: Michael Xavier <michael@michaelxavier.net> synopsis: Secure, modular server-side sessions. category: Web stability: Stable-cabal-version: >= 1.8 build-type: Simple homepage: https://github.com/yesodweb/serversession description: API docs and the README are available at <http://www.stackage.org/package/serversession> extra-source-files: README.md+ changelog.md +flag lib-Werror+ default: False+ manual: True+ library+ default-language: Haskell2010 hs-source-dirs: src build-depends: base == 4.* , aeson- , base64-bytestring == 1.0.*+ , base64-bytestring >= 1.0 && < 1.3 , bytestring , data-default , hashable , nonce == 1.0.* , path-pieces+ , persistent-test , text , time , transformers@@ -32,7 +39,7 @@ Web.ServerSession.Core Web.ServerSession.Core.Internal Web.ServerSession.Core.StorageTests- extensions:+ default-extensions: DeriveDataTypeable FlexibleContexts OverloadedStrings@@ -42,9 +49,13 @@ TypeFamilies UndecidableInstances ghc-options: -Wall+ if flag(lib-Werror)+ ghc-options: -Werror + test-suite tests+ default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests build-depends:@@ -56,7 +67,7 @@ , hspec >= 2.1 && < 3 , QuickCheck , serversession- extensions:+ default-extensions: DeriveDataTypeable FlexibleContexts OverloadedStrings@@ -66,6 +77,9 @@ UndecidableInstances main-is: Main.hs ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts+ if flag(lib-Werror)+ ghc-options: -Werror+ source-repository head
src/Web/ServerSession/Core/Internal.hs view
@@ -45,7 +45,7 @@ , ForceInvalidate(..) ) where -import Control.Applicative ((<$>), (<*>))+import Control.Applicative as A import Control.Monad (guard, when) import Control.Monad.IO.Class (MonadIO(..)) import Data.ByteString (ByteString)@@ -730,7 +730,7 @@ (saveToDb, key, createdAt) <- case maybeInput of Nothing -> liftIO $- (,,) <$> return (insertSession $ storage state)+ (,,) A.<$> return (insertSession $ storage state) <*> generateSessionId (generator state) <*> return now Just Session {..} ->
src/Web/ServerSession/Core/StorageTests.hs view
@@ -7,9 +7,10 @@ ( allStorageTests ) where -import Control.Applicative ((<$), (<$>), (<*>))+import Control.Applicative as A import Control.Exception (Exception) import Control.Monad+import DataTypeTest (roundUTCTime) import Web.ServerSession.Core.Internal import qualified Crypto.Nonce as N@@ -95,7 +96,7 @@ master <- generateSession gen HasAuthId let Just authId = sessionAuthId master preslaves <-- (++) <$> replicateM 100 (generateSession gen HasAuthId)+ (++) A.<$> replicateM 100 (generateSession gen HasAuthId) <*> replicateM 100 (generateSession gen NoAuthId) let slaves = (\s -> s { sessionAuthId = Just authId }) <$> preslaves others <-@@ -173,8 +174,8 @@ { sessionKey = sid , sessionAuthId = Nothing , sessionData = SessionMap $ HM.fromList vals- , sessionCreatedAt = now- , sessionAccessedAt = now+ , sessionCreatedAt = roundUTCTime now+ , sessionAccessedAt = roundUTCTime now } ver2 = session { sessionData = SessionMap HM.empty } run (getSession storage sid) `shouldReturn` Nothing@@ -223,8 +224,8 @@ { sessionKey = sid , sessionAuthId = authId , sessionData = SessionMap data_- , sessionCreatedAt = TI.addUTCTime (-1000) now- , sessionAccessedAt = now+ , sessionCreatedAt = roundUTCTime $ TI.addUTCTime (-1000) now+ , sessionAccessedAt = roundUTCTime $ now } data HasAuthId = HasAuthId | NoAuthId
tests/Main.hs view
@@ -1,6 +1,6 @@ module Main (main) where -import Control.Applicative ((<$), (<$>), (<*>))+import Control.Applicative as A import Control.Arrow import Control.Monad import Data.Maybe@@ -49,7 +49,7 @@ -- The probability of a given character not appearing on -- this test is (63/64)^(24*reps), so it's extremely -- unlikely for this test to fail on correct code.- let observed = S.fromList $ concat $ T.unpack . unS <$> sids+ let observed = S.fromList $ concat $ T.unpack . unS A.<$> sids expected = S.fromList $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "-_" observed `shouldBe` expected @@ -93,9 +93,13 @@ 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+ --+ -- We used to use 0.1 seconds, but Travis+ -- intermittently had troubles with it, e.g.:+ -- <https://travis-ci.org/yesodweb/serversession/jobs/67062266>+ let closeEnough = 2 {- seconds -} :: Double now <- TI.getCurrentTime- abs (realToFrac $ TI.diffUTCTime now time) `shouldSatisfy` (< point1)+ abs (realToFrac $ TI.diffUTCTime now time) `shouldSatisfy` (< closeEnough) sessionMap `shouldBe` TNTSessionData msession `shouldSatisfy` isNothing