Compare commits

...

63 Commits

Author SHA1 Message Date
Michael Snoyman
bcd2b7da84
default-extensions 2021-02-14 09:29:16 +02:00
Michael Snoyman
e51b5bc11f
More Hackage complaints 2021-02-14 09:26:18 +02:00
Michael Snoyman
b861f18008
cabal-version for Hackage 2021-02-14 08:38:54 +02:00
Michael Snoyman
febbcbe4db
Merge pull request #23 from ncaq/update-lts
updated: lts to 15
2021-02-14 08:13:23 +02:00
ncaq
ecbedcc5b4 added: version bumps and changelog 2021-02-13 00:12:02 +09:00
Michael Snoyman
7ce49ecfed
Relax an upper bound 2020-08-14 09:09:24 +03:00
Michael Snoyman
52ae0284b6
Allow newer base64-bytestring for serversession 2020-08-01 05:38:42 +03:00
ncaq
fc77ca238e updated: lts to 15 2020-04-13 23:46:49 +09:00
Michael Xavier
130fbbaaf2 Ignore db files 2018-10-19 09:33:10 -07:00
Michael Xavier
79c0365052 Whoops, I changes the wrong suite's stack size. 2018-10-19 09:32:43 -07:00
Michael Xavier
b8a9360731 Increase stack size of serversession tests
In travis this seems to blow the stack. Not entirely sure why we're
even setting it.
2018-10-17 15:35:40 -07:00
Michael Xavier
64ab980805 Update our build matrix
Looks like we hit a big breaking change with the latest yesod major
version. I took a look at the CPP needed and it wouldn't be worth
it. This forces us to cut lts-10 and older loose. I've also allowed
nightly tests to fail since there are a lot of dependencies that are
trailing behind.
2018-10-16 10:18:13 -07:00
Michael Xavier
69e565c415 Ignore sqlite files 2018-10-16 08:52:18 -07:00
Michael Xavier
4647b755bf
Merge pull request #16 from betterteamapp/master
Update serversession-frontend-yesod for yesod-1.6
2018-10-16 08:50:10 -07:00
Ian Duncan
b75117c138 Update serversession-frontend-yesod for yesod-1.6 2018-05-23 09:34:16 +09:00
Michael Xavier
7939f1decb
Merge pull request #15 from taksuyu/patch-1
Correct module description
2018-04-10 09:22:30 -07:00
Michael Borden
45eb1b96fc
Correct module description 2018-04-09 13:06:42 -07:00
Michael Xavier
d847280f31 Cut serversession-backend-redis 1.0.3 2018-01-15 20:23:17 -08:00
Michael Xavier
f34e10a3be Send --fast flag for tests
No reason really to have optimizations, all the time is in
building. Last build ran out of memory and I'm hoping this gets us
under the ceiling.
2018-01-15 19:46:19 -08:00
Michael Xavier
94a9db4b81 Scale back build matrix
This matrix takes forever to build and makes the CI setup more
complicated with various stack yamls fixing versions. I think it is
reasonable to test the last 3 LTS and nightly.
2018-01-15 16:34:11 -08:00
Michael Xavier
dfe9cbc364 Default to current LTS for development 2018-01-15 14:02:04 -08:00
Michael Xavier
34446681fe Try caching stack work dir 2018-01-15 14:01:48 -08:00
Michael Xavier
b262a18ae4 Loosen hedis bounds
This is for #14
2018-01-15 13:46:16 -08:00
Michael Xavier
72c555d170 Bump to serversession-backend-persistent 1.0.4 2017-05-17 18:29:48 -07:00
Michael Xavier
d174f05868 Merge pull request #12 from sbditto85/auth_id_default
auth id set to default of null to prevent yet another mysql error
2017-04-28 19:26:08 -07:00
Casey Allred
2300580717 auth id set to default of null to prevent yet another mysql error 2017-04-28 15:14:47 -06:00
Michael Xavier
78fd564eec Update package maintainer
I don't see a way to set multiple maintainers on the project. I don't
have a roadmap or vested interest in all of these packages but for the
time being I'm the active maintainer of these projects.
2017-03-08 09:29:59 -08:00
Michael Xavier
4ddceac6de serversession-frontend-snap 1.0.1 2017-03-03 15:47:33 -08:00
Michael Xavier
854a5a3d1f serversession-backend-redis 1.0.2 2017-03-03 15:46:14 -08:00
Michael Xavier
1ac6f2726b serversession-backend-persistent 1.0.3 2017-03-03 15:43:38 -08:00
Michael Xavier
f73de7c791 Add blank changelogs for all projects
For future releases we'll update these. I have a few packages that
need releases so that'll be the start.
2017-03-03 15:41:27 -08:00
Michael Xavier
4398cea6b4 Work around lts-7/ghc-8.0.1 panic 2017-03-03 08:57:00 -08:00
Michael Xavier
9615bb3996 Run against lts-8
Also great, we get a ghc panic in lts-7. thats neat.
2017-03-02 17:41:09 -08:00
Michael Xavier
4f0deb94f6 Fix errors in sdist for example project 2017-03-02 15:29:49 -08:00
Michael Xavier
2a369c6949 Fix type aliasing issue on some ltses 2017-03-02 14:35:11 -08:00
Michael Xavier
164761bfc3 Install libgmp prereq 2017-03-02 14:35:03 -08:00
Michael Xavier
3cfe27857d Move flag into lts-2 stack yaml 2017-03-02 14:34:56 -08:00
Michael Xavier
a5114cb505 Rework travis build
Perhaps supporting lts 2-8 is not the best idea.
2017-03-02 14:21:42 -08:00
Michael Xavier
399463f8c5 Get building on nightly with ghc 8 2017-02-08 18:34:51 -08:00
Michael Xavier
6edd459223 Wall-werror all the things 2017-02-01 18:20:55 -08:00
Michael Xavier
66bdc481bc Ignore .stack-work 2017-01-31 20:02:32 -08:00
Michael Xavier
f51ce82a3c Merge pull request #11 from sbditto85/limit_session_key
limit the session key as per the the definition comment 'The ID of a …
2017-01-31 19:32:20 -08:00
Casey Allred
be6d9d2aaf Merge branch 'master' into limit_session_key 2017-01-30 16:31:22 -07:00
Michael Xavier
5e80d43db5 Merge pull request #8 from MichaelXavier/redis-session-expiry
Add first stab at backend auto expiry
2017-01-25 19:28:16 -08:00
Michael Xavier
70d1c43e09 I think we have to use system-ghc explicitly now? 2017-01-25 18:15:40 -08:00
Michael Xavier
adda409f90 Merge remote-tracking branch 'upstream/master' into redis-session-expiry 2017-01-25 17:46:29 -08:00
Casey Allred
37590b9e3e limit the session key as per the the definition comment 'The ID of a session. Always 18 bytes base64url-encoded as 24 characters.' using 30 characters to be conservative 2017-01-23 21:33:02 +00:00
Michael Xavier
b51d32df4d widen deps 2016-11-28 09:30:29 -08:00
Michael Snoyman
c2c1718f11 Merge pull request #9 from k-bx/patch-1
Bump hedis
2016-09-22 16:17:23 +03:00
Kostiantyn Rybnikov
3f5b0da2f1 Re-bump hedis 2016-09-22 14:01:10 +03:00
Kostiantyn Rybnikov
7bce4c18e7 Bump hedis
Useful for https://github.com/fpco/stackage/issues/1247
2016-03-24 17:28:34 +02:00
Michael Xavier
d135958be5 Update comments, exercise expiration codepath
I wanted to at least ensure my change's code was excerised, even though
it makes no material difference to the allStorageTests suite.
2016-03-12 13:11:43 -08:00
Michael Xavier
7d922d1de4 Add first stab at backend auto expiry
This is for issue #7

So it would be nice if we had access to `State` because it would provide
us with `cookieExpires`, but nothing in the machinery of serversession
makes it available to backends for some reason. Also the tests seem to
indicate that the State may not be available at the time of setting up
storange engines (or may be a chicken-and-egg situation). The best
solution seemed to be to take the settings for absolute and idle timeout
that you're going to give to the state and share them.

Just as a reminder for the motivation on this: currently in
serversession's redis backend, you accumulate sessions
indefinitely. Even after they expire, they will stay in redis. The other
backends seem vulnerable to this too but its probably not nearly a big
deal in something like persistent because:

1. Storage is not as much of a premium in peristent's supported backend
compared to redis. They are primarily storing to disk.
2. Persistent's backends have good querying primitives so it is simple
to write jobs to delete old sessions.

Redis must fit all data in memory, so storage is at a premium and in
order to find old keys you'd have to issue the frowned-upon KEYS
command (or SCAN which isn't even suppored by hedis yet) and parse every
session.

This change uses redis' built in expiry mechanism and sets the
expiration every time a write operation is made to a session. Sessions
as they would naturally expire on the client side will now automatically
expire and free memory on the backend.
2016-03-11 16:54:14 -08:00
Felipe Lessa
cc69e23dc9 serversession-backend-redis-1.0.1 2015-12-31 15:45:45 -02:00
Felipe Lessa
c334f3bd07 serversession-backend-persistent-1.0.2 2015-12-31 15:45:16 -02:00
Felipe Lessa
01b277b11e New .travis.yml using stack instead of cabal-meta. 2015-12-31 15:25:41 -02:00
Felipe Lessa
9d0ee44c06 serversession-backend-acid-state-1.0.3 2015-12-31 11:26:45 -02:00
Felipe Lessa
50c29148ab Make serversession-backend-acid-state work with older versions. 2015-12-31 11:26:25 -02:00
Felipe Lessa
e7a4de11f8 Fix serversession-example-yesod-persistent, add to stack.yaml. 2015-12-31 11:26:07 -02:00
Felipe Lessa
7433a914ce Merge pull request #6 from DanBurton/master
Upgrade to safecopy-0.9. yesodweb/serversession#5
2015-12-31 10:38:14 -02:00
Dan Burton
cfe7118e50 Upgrade to safecopy-0.9. yesodweb/serversession#5 2015-12-30 14:26:20 -08:00
Felipe Lessa
c528a671d4 Accept acid-state 0.13 and beyond (fixes #4). 2015-09-03 15:13:18 -03:00
Felipe Lessa
d882c65e6b Upgrade stack.yaml to latest versions. 2015-09-03 15:12:05 -03:00
42 changed files with 507 additions and 218 deletions

3
.gitignore vendored
View File

@ -12,3 +12,6 @@ cabal.sandbox.config
.shelly/
tarballs/
\#*#
.stack-work
*.sqlite3*
*.db

View File

@ -1,64 +1,57 @@
# Travis file upgraded to stack at 2015-31-12 using template from
# <http://docs.haskellstack.org/en/stable/travis_ci.html>.
#
# Travis file initially created at 2015-05-31 using template from
# <https://github.com/hvr/multi-ghc-travis/commit/c9c87d36c450d7f9cb3183dcaf1f77b60f916f28>
# and taking the idea of using cabal-meta from yesodweb/yesod.
# NB: don't set `language: haskell` here
sudo: false
dist: trusty
language: c
services:
- redis-server
- redis-server
addons:
postgresql: "9.3"
apt:
packages:
- libgmp-dev
postgresql: "9.3"
# The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for.
env:
#- CABALVER=1.16 GHCVER=6.12.3
#- CABALVER=1.16 GHCVER=7.0.1
#- CABALVER=1.16 GHCVER=7.0.2
#- CABALVER=1.16 GHCVER=7.0.3
#- CABALVER=1.16 GHCVER=7.0.4
#- CABALVER=1.16 GHCVER=7.2.1
#- CABALVER=1.16 GHCVER=7.2.2
#- CABALVER=1.16 GHCVER=7.4.1
#- CABALVER=1.16 GHCVER=7.4.2
#- CABALVER=1.16 GHCVER=7.6.1
#- CABALVER=1.16 GHCVER=7.6.2
#- CABALVER=1.18 GHCVER=7.6.3
#- CABALVER=1.18 GHCVER=7.8.1 # see note about Alex/Happy for GHC >= 7.8
#- CABALVER=1.18 GHCVER=7.8.2
#- CABALVER=1.18 GHCVER=7.8.3
#- CABALVER=1.18 GHCVER=7.8.4
- CABALVER=1.20 GHCVER=7.8.4
- CABALVER=1.22 GHCVER=7.10.1
#- CABALVER=1.22 GHCVER=7.10.2
#- CABALVER=head GHCVER=head # see section about GHC HEAD snapshots
cache:
directories:
- $HOME/.stack
- .stack-work
matrix:
include:
- env: STACKARGS="--resolver=lts-15"
- env: STACKARGS="--resolver=nightly"
allow_failures:
- env: STACKARGS="--resolver=nightly"
# Note: the distinction between `before_install` and `install` is not important.
before_install:
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
- travis_retry sudo apt-get update
- travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.cabal/bin:$PATH
install:
- cabal --version
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- travis_retry cabal update
- cabal install cabal-src cabal-meta alex happy
# Download and unpack the stack executable
- mkdir -p ~/.local/bin
- export PATH=$HOME/.local/bin:$PATH
- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
before_script:
- psql -c "CREATE USER test WITH PASSWORD 'test';" -U postgres
- psql -c "CREATE DATABASE test;" -U postgres
- psql -c "GRANT ALL PRIVILEGES ON DATABASE test TO test;" -U postgres
- psql -c "CREATE USER test WITH PASSWORD 'test';" -U postgres
- psql -c "CREATE DATABASE test;" -U postgres
- psql -c "GRANT ALL PRIVILEGES ON DATABASE test TO test;" -U postgres
install:
- stack setup $STACKARGS
# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail.
script:
- cabal-meta install --enable-tests --enable-benchmarks --force-reinstalls
- serversession/dist/build/tests/tests
- serversession-backend-acid-state/dist/build/tests/tests
- du -hcs state; rm -Rfv state
- serversession-backend-persistent/dist/build/tests/tests --skip=100\ MiB
- du -hcs test.db*; rm -Rfv test.db*
- psql -c 'SELECT COUNT(*) FROM "persistent_session";' -U test test; psql -c 'DROP DATABASE test;' -U postgres
- serversession-backend-redis/dist/build/tests/tests
- redis-cli FLUSHALL
- stack test --fast $STACKARGS serversession
- stack test --fast $STACKARGS serversession-backend-acid-state
- du -hcs serversession-backend-acid-state/state; rm -Rfv serversession-backend-acid-state/state
- stack test --fast $STACKARGS serversession-backend-persistent --test-arguments='"--skip=100 MiB"'
- du -hcs serversession-backend-persistent/test.db*; rm -Rfv serversession-backend-persistent/test.db*
- psql -c 'SELECT COUNT(*) FROM "persistent_session";' -U test test; psql -c 'DROP DATABASE test;' -U postgres
- stack test --fast $STACKARGS serversession-backend-redis
- redis-cli FLUSHALL
- stack test --fast $STACKARGS --no-run-tests # Make sure everything else builds
- stack $STACKARGS sdist

View File

@ -1,3 +1,5 @@
-- https://ghc.haskell.org/trac/ghc/ticket/12130#comment:9
{-# LANGUAGE NoDisambiguateRecordFields, NoRecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Application
( getApplicationDev
@ -67,7 +69,7 @@ makeFoundation appSettings = do
-- logging function. To get out of this loop, we initially create a
-- temporary foundation without a real connection pool, get a log function
-- from there, and then create the real foundation.
let mkFoundation appConnPool = App {..}
let mkFoundation appConnPool = App appSettings appStatic appConnPool appHttpManager appLogger
tempFoundation = mkFoundation $ error "connPool forced in tempFoundation"
logFunc = messageLoggerSource tempFoundation appLogger
@ -126,7 +128,7 @@ getApplicationDev = do
return (wsettings, app)
getAppSettings :: IO AppSettings
getAppSettings = loadAppSettings [configSettingsYml] [] useEnv
getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
-- | main function for use by yesod devel
develMain :: IO ()
@ -136,7 +138,7 @@ develMain = develMainHelper getApplicationDev
appMain :: IO ()
appMain = do
-- Get the settings from all relevant sources
settings <- loadAppSettingsArgs
settings <- loadYamlSettingsArgs
-- fall back to compile-time values, set to [] to require values at runtime
[configSettingsYmlValue]

View File

@ -6,7 +6,7 @@ import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Web.ServerSession.Backend.Persistent
import Web.ServerSession.Frontend.Yesod
import Yesod.Auth.BrowserId (authBrowserId)
import Yesod.Auth.Dummy (authDummy)
import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe
@ -37,7 +37,7 @@ instance HasHttpManager App where
mkYesodData "App" $(parseRoutesFile "config/routes")
-- | A convenient synonym for creating forms.
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
-- | Cookie name used for the sessions of this example app.
sessionCookieName :: Text
@ -104,7 +104,7 @@ instance Yesod App where
-- What messages should be logged. The following includes all messages when
-- in development, and warnings and errors in production.
shouldLog app _source level =
shouldLogIO app _source level = return $
appShouldLogAll (appSettings app)
|| level == LevelWarn
|| level == LevelError
@ -117,6 +117,7 @@ instance YesodPersist App where
runDB action = do
master <- getYesod
runSqlPool action $ appConnPool master
instance YesodPersistRunner App where
getDBRunner = defaultGetDBRunner appConnPool
@ -130,19 +131,19 @@ instance YesodAuth App where
-- Override the above two destinations when a Referer: header is present
redirectToReferer _ = True
getAuthId creds = runDB $ do
authenticate creds = liftHandler $ runDB $ do
x <- getBy $ UniqueUser $ credsIdent creds
case x of
Just (Entity uid _) -> return $ Just uid
Nothing -> Just <$> insert User
Just (Entity uid _) -> return $ Authenticated uid
Nothing -> Authenticated <$> insert User
{ userIdent = credsIdent creds
, userPassword = Nothing
}
-- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authBrowserId def]
authPlugins _ = [authDummy]
authHttpManager = getHttpManager
authHttpManager = getHttpManager <$> getYesod
instance YesodAuthPersist App
@ -151,7 +152,7 @@ instance YesodAuthPersist App
instance RenderMessage App FormMessage where
renderMessage _ _ = defaultFormMessage
unsafeHandler :: App -> Handler a -> IO a
unsafeHandler :: App -> Foundation.Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
-- Note: Some functionality previously present in the scaffolding has been

View File

@ -1,3 +1,5 @@
-- https://ghc.haskell.org/trac/ghc/ticket/12130#comment:9
{-# LANGUAGE NoDisambiguateRecordFields, NoRecordWildCards #-}
-- | On this serversession example, we simply provide some ways
-- users may interact with the session.
module Handler.Home where
@ -24,12 +26,12 @@ getHomeR = do
-- | Invalidate the session as requested via 'forceForm'.
postForceR :: Handler ()
postForceR =
processForm "Force form" forceForm $ \force -> do
processForm "Force form" forceForm $ \frce -> do
msid <- getSessionId
SS.forceInvalidate force
SS.forceInvalidate frce
return $ concat
[ "Forced session invalidation using "
, show force
, show frce
, " [old session ID was "
, show msid
, "]." ]

View File

@ -1,5 +1,12 @@
{-# LANGUAGE CPP #-}
module Import.NoFoundation
( module Import
#if !MIN_VERSION_yaml(0,8,16)
, loadYamlSettings
#endif
#if !MIN_VERSION_yaml(0,8,17)
, loadYamlSettingsArgs
#endif
) where
import ClassyPrelude.Yesod as Import
@ -9,3 +16,13 @@ import Settings.StaticFiles as Import
import Yesod.Auth as Import
import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import
#if !MIN_VERSION_yaml(0,8,16)
loadYamlSettings :: FromJSON settings => [String] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings = loadAppSettings
#endif
#if !MIN_VERSION_yaml(0,8,17)
loadYamlSettingsArgs :: FromJSON settings => [Value] -> EnvUsage -> IO settings
loadYamlSettingsArgs = loadAppSettingsArgs
#endif

View File

@ -0,0 +1,20 @@
Copyright (c) 2015 Felipe Lessa
Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

View File

@ -1,3 +1,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Model where
import ClassyPrelude.Yesod

View File

@ -6,7 +6,7 @@
module Settings where
import ClassyPrelude.Yesod
import Control.Exception (throw)
import Control.Exception as E
import Data.Aeson (Result (..), fromJSON, withObject, (.!=),
(.:?))
import Data.FileEmbed (embedFile)
@ -108,7 +108,7 @@ configSettingsYmlBS = $(embedFile configSettingsYml)
-- | @config/settings.yml@, parsed to a @Value@.
configSettingsYmlValue :: Value
configSettingsYmlValue = either throw id $ decodeEither' configSettingsYmlBS
configSettingsYmlValue = either E.throw id $ decodeEither' configSettingsYmlBS
-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
compileTimeAppSettings :: AppSettings

View File

@ -0,0 +1,7 @@
#!/usr/bin/env runhaskell
> module Main where
> import Distribution.Simple
> main :: IO ()
> main = defaultMain

View File

@ -1,5 +1,8 @@
name: serversession-example-yesod-persistent
version: 0.0.0
license: MIT
license-file: LICENSE
description: Example yesod/persistent app using serversession
cabal-version: >= 1.8
build-type: Simple
@ -25,9 +28,9 @@ library
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT
ghc-options: -Wall -fwarn-tabs -O0
ghc-options: -Wall -fwarn-tabs
else
ghc-options: -Wall -fwarn-tabs -O
ghc-options: -Wall -fwarn-tabs
extensions: TemplateHaskell
QuasiQuotes
@ -46,35 +49,35 @@ library
TupleSections
RecordWildCards
build-depends: base >= 4 && < 5
, yesod >= 1.4.1 && < 1.5
, yesod-core >= 1.4.6 && < 1.5
, yesod-auth >= 1.4.0 && < 1.5
, yesod-static >= 1.4.0.3 && < 1.5
, yesod-form >= 1.4.0 && < 1.5
build-depends: base >= 4 && < 5
, yesod >= 1.4.1
, yesod-core >= 1.4.6
, yesod-auth >= 1.4.0
, yesod-static >= 1.4.0.3
, yesod-form >= 1.4.0
, classy-prelude >= 0.10.2
, classy-prelude-conduit >= 0.10.2
, classy-prelude-yesod >= 0.10.2
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0
, persistent >= 2.0 && < 2.2
, persistent-sqlite >= 2.1.1 && < 2.2
, persistent-template >= 2.0 && < 2.2
, bytestring >= 0.9
, text >= 0.11
, persistent >= 2.0
, persistent-sqlite >= 2.1.1
, persistent-template >= 2.0
, template-haskell
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2
, monad-control >= 0.3 && < 1.1
, wai-extra >= 3.0 && < 3.1
, yaml >= 0.8 && < 0.9
, http-conduit >= 2.1 && < 2.2
, directory >= 1.1 && < 1.3
, warp >= 3.0 && < 3.1
, shakespeare >= 2.0
, hjsmin >= 0.1
, monad-control >= 0.3
, wai-extra >= 3.0
, yaml >= 0.8
, http-conduit >= 2.1
, directory >= 1.1
, warp >= 3.0
, data-default
, aeson >= 0.6 && < 0.9
, conduit >= 1.0 && < 2.0
, monad-logger >= 0.3 && < 0.4
, fast-logger >= 2.2 && < 2.4
, wai-logger >= 2.2 && < 2.3
, aeson >= 0.6
, conduit >= 1.0
, monad-logger >= 0.3
, fast-logger >= 2.2
, wai-logger >= 2.2
, file-embed
, safe
, unordered-containers
@ -95,13 +98,17 @@ executable serversession-example-yesod-persistent
hs-source-dirs: app
build-depends: base, serversession-example-yesod-persistent
ghc-options: -threaded -O -rtsopts -with-rtsopts=-N
ghc-options: -threaded -rtsopts -with-rtsopts=-N
test-suite test
type: exitcode-stdio-1.0
main-is: Spec.hs
hs-source-dirs: test
ghc-options: -Wall
other-modules:
Handler.CommonSpec
Handler.HomeSpec
TestImport
extensions: TemplateHaskell
QuasiQuotes
@ -121,7 +128,7 @@ test-suite test
build-depends: base
, serversession-example-yesod-persistent
, yesod-test >= 1.4.3 && < 1.5
, yesod-test >= 1.4.3
, yesod-core
, yesod
, persistent

View File

@ -3,15 +3,15 @@ module Handler.CommonSpec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
describe "robots.txt" $ do
it "gives a 200" $ do
get RobotsR
statusIs 200
it "has correct User-agent" $ do
get RobotsR
bodyContains "User-agent: *"
describe "favicon.ico" $ do
it "gives a 200" $ do
get FaviconR
statusIs 200
spec = yesodSpecWithSiteGenerator mkApp $ do
ydescribe "robots.txt" $ do
yit "gives a 200" $ do
get RobotsR
statusIs 200
yit "has correct User-agent" $ do
get RobotsR
bodyContains "User-agent: *"
ydescribe "favicon.ico" $ do
yit "gives a 200" $ do
get FaviconR
statusIs 200

View File

@ -3,7 +3,9 @@ module Handler.HomeSpec (spec) where
import TestImport
spec :: Spec
spec = withApp $ do
spec = yesodSpecWithSiteGenerator mkApp $ do
return ()
{-
it "loads the index and checks it looks right" $ do
get HomeR
statusIs 200
@ -30,3 +32,4 @@ spec = withApp $ do
statusIs 200
users <- runDB $ selectList ([] :: [Filter User]) []
assertEqual "user table empty" 0 $ length users
-}

View File

@ -5,13 +5,13 @@ module TestImport
import Application (makeFoundation)
import ClassyPrelude as X
import Database.Persist as X hiding (get)
import Database.Persist as X hiding (delete, deleteBy, get)
import Database.Persist.Sql (SqlPersistM, SqlBackend, runSqlPersistMPool, rawExecute, rawSql, unSingle, connEscapeName)
import Foundation as X
import Foundation as X hiding (Handler)
import Import.NoFoundation (loadYamlSettings)
import Model as X
import Test.Hspec as X
import Text.Shakespeare.Text (st)
import Yesod.Default.Config2 (ignoreEnv, loadAppSettings)
import Yesod.Default.Config2 (ignoreEnv)
import Yesod.Test as X
-- Wiping the database
@ -26,9 +26,9 @@ runDB query = do
pool <- fmap appConnPool getTestYesod
liftIO $ runSqlPersistMPool query pool
withApp :: SpecWith App -> Spec
withApp = before $ do
settings <- loadAppSettings
mkApp :: IO App
mkApp = do
settings <- loadYamlSettings
["config/test-settings.yml", "config/settings.yml"]
[]
ignoreEnv
@ -49,8 +49,8 @@ wipeDB app = do
-- Aside: SQLite by default *does not enable foreign key checks*
-- (disabling foreign keys is only necessary for those who specifically enable them).
let settings = appSettings app
sqliteConn <- rawConnection (sqlDatabase $ appDatabaseConf settings)
let settings = appSettings app
sqliteConn <- rawConnection (sqlDatabase $ appDatabaseConf settings)
disableForeignKeys sqliteConn
let logFunc = messageLoggerSource app (appLogger app)

View File

@ -0,0 +1,3 @@
# 1.0.4
* bump acid-state to 0.16

View File

@ -1,33 +1,39 @@
cabal-version: >= 1.10
name: serversession-backend-acid-state
version: 1.0.1
version: 1.0.4
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: Storage backend for serversession using acid-state.
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-backend-acid-state>
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.*
, acid-state == 0.12.*
, acid-state >= 0.16
, containers
, mtl
, safecopy == 0.8.*
, safecopy >= 0.8
, unordered-containers
, serversession == 1.0.*
exposed-modules:
Web.ServerSession.Backend.Acid
Web.ServerSession.Backend.Acid.Internal
extensions:
default-extensions:
ConstraintKinds
DeriveDataTypeable
FlexibleContexts
@ -35,9 +41,14 @@ library
TypeFamilies
UndecidableInstances
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
if impl(ghc >= 8.0.0)
ghc-options: -Wno-redundant-constraints
test-suite tests
default-language: Haskell2010
type: exitcode-stdio-1.0
hs-source-dirs: tests
build-depends:
@ -48,9 +59,11 @@ test-suite tests
, serversession
, serversession-backend-acid-state
main-is: Main.hs
extensions:
default-extensions:
CPP
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts
if flag(lib-Werror)
ghc-options: -Werror
source-repository head

View File

@ -1,3 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Internal module exposing the guts of the package. Use at
-- your own risk. No API stability guarantees apply.
module Web.ServerSession.Backend.Acid.Internal
@ -23,7 +24,7 @@ module Web.ServerSession.Backend.Acid.Internal
, AcidStorage(..)
) where
import Control.Applicative ((<$>), (<*>))
import Control.Applicative as A
import Control.Monad.Reader (ask)
import Control.Monad.State (get, modify, put)
import Data.Acid
@ -103,19 +104,19 @@ insertSessionForAuthId sid = maybe id (flip (HM.insertWith S.union) (S.singleton
-- @safeCopy@ doesn't contain instances for @HashMap@ as of now.
instance SafeCopy SS.SessionMap where
putCopy = contain . safePut . HM.toList . SS.unSessionMap
getCopy = contain $ SS.SessionMap . HM.fromList <$> safeGet
getCopy = contain $ SS.SessionMap . HM.fromList A.<$> safeGet
-- | We can't @deriveSafeCopy 0 'base ''SS.SessionId@ as
-- otherwise we'd require an unneeded @SafeCopy sess@.
instance SafeCopy (SS.SessionId sess) where
instance Typeable sess => SafeCopy (SS.SessionId sess) where
putCopy = contain . safePut . SSI.unS
getCopy = contain $ SSI.S <$> safeGet
-- | We can't @deriveSafeCopy 0 'base ''SS.Session@ due to the
-- required context.
instance SafeCopy (SS.Decomposed sess) => SafeCopy (SS.Session sess) where
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (SS.Session sess) where
putCopy (SS.Session key authId data_ createdAt accessedAt) = contain $ do
put_t <- getSafePut
safePut key
@ -135,7 +136,7 @@ instance SafeCopy (SS.Decomposed sess) => SafeCopy (SS.Session sess) where
-- | We can't @deriveSafeCopy 0 'base ''ServerSessionAcidState@ due
-- to the required context.
instance SafeCopy (SS.Decomposed sess) => SafeCopy (ServerSessionAcidState sess) where
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (ServerSessionAcidState sess) where
putCopy (ServerSessionAcidState sits aits) = contain $ do
safePut (HM.toList sits)
safePut (HM.toList aits)
@ -272,23 +273,23 @@ data DeleteAllSessionsOfAuthId sess = DeleteAllSessionsOfAuthId SS.AuthId derivi
data InsertSession sess = InsertSession (SS.Session sess) deriving (Typeable)
data ReplaceSession sess = ReplaceSession (SS.Session sess) deriving (Typeable)
instance SafeCopy (GetSession sess) where
instance Typeable sess => SafeCopy (GetSession sess) where
putCopy (GetSession v) = contain $ safePut v
getCopy = contain $ GetSession <$> safeGet
instance SafeCopy (DeleteSession sess) where
instance Typeable sess => SafeCopy (DeleteSession sess) where
putCopy (DeleteSession v) = contain $ safePut v
getCopy = contain $ DeleteSession <$> safeGet
instance SafeCopy (DeleteAllSessionsOfAuthId sess) where
instance Typeable sess => SafeCopy (DeleteAllSessionsOfAuthId sess) where
putCopy (DeleteAllSessionsOfAuthId v) = contain $ safePut v
getCopy = contain $ DeleteAllSessionsOfAuthId <$> safeGet
instance SafeCopy (SS.Decomposed sess) => SafeCopy (InsertSession sess) where
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (InsertSession sess) where
putCopy (InsertSession v) = contain $ safePut v
getCopy = contain $ InsertSession <$> safeGet
instance SafeCopy (SS.Decomposed sess) => SafeCopy (ReplaceSession sess) where
instance (Typeable sess, SafeCopy (SS.Decomposed sess)) => SafeCopy (ReplaceSession sess) where
putCopy (ReplaceSession v) = contain $ safePut v
getCopy = contain $ ReplaceSession <$> safeGet
@ -321,8 +322,8 @@ instance AcidContext sess => Method (ReplaceSession sess) where
instance AcidContext sess => IsAcidic (ServerSessionAcidState sess) where
acidEvents =
[ QueryEvent $ \(GetSession sid) -> getSession sid
, UpdateEvent $ \(DeleteSession sid) -> deleteSession sid
, UpdateEvent $ \(DeleteAllSessionsOfAuthId authId) -> deleteAllSessionsOfAuthId authId
, UpdateEvent $ \(InsertSession session) -> insertSession session
, UpdateEvent $ \(ReplaceSession session) -> replaceSession session ]
[ QueryEvent (\(GetSession sid) -> getSession sid) safeCopyMethodSerialiser
, UpdateEvent (\(DeleteSession sid) -> deleteSession sid) safeCopyMethodSerialiser
, UpdateEvent (\(DeleteAllSessionsOfAuthId authId) -> deleteAllSessionsOfAuthId authId) safeCopyMethodSerialiser
, UpdateEvent (\(InsertSession session) -> insertSession session) safeCopyMethodSerialiser
, UpdateEvent (\(ReplaceSession session) -> replaceSession session) safeCopyMethodSerialiser ]

View File

@ -1,6 +1,6 @@
module Main (main) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Data.Acid.Local (openLocalState, createCheckpointAndClose)
import Data.Acid.Memory (openMemoryState)
import Test.Hspec
@ -15,7 +15,7 @@ main =
(AcidStorage <$> openLocalState emptyState)
(createCheckpointAndClose . acidState) $
\acidLocal -> hspec $ do
acidMem <- runIO $ AcidStorage <$> openMemoryState emptyState
acidMem <- runIO $ AcidStorage A.<$> openMemoryState emptyState
describe "AcidStorage on memory only" $
allStorageTests acidMem it runIO parallel shouldBe shouldReturn shouldThrow
describe "AcidStorage on local storage" $

View File

@ -0,0 +1,7 @@
1.0.5
* bump persistent to 2.10
1.0.4
* Default auth id to NULL to fix a MySQL bug.
1.0.3
* Get building on ghc-8
* Limit column size for session key

View File

@ -1,19 +1,25 @@
cabal-version: >= 1.10
name: serversession-backend-persistent
version: 1.0.1
version: 1.0.5
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: Storage backend for serversession using persistent and an RDBMS.
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-backend-persistent>
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.*
@ -22,8 +28,8 @@ library
, bytestring
, cereal >= 0.4
, path-pieces
, persistent >= 2.1 && < 2.3
, tagged >= 0.8
, persistent >= 2.10
, tagged >= 0.7
, text
, time
, transformers
@ -34,7 +40,7 @@ library
Web.ServerSession.Backend.Persistent
Web.ServerSession.Backend.Persistent.Internal.Impl
Web.ServerSession.Backend.Persistent.Internal.Types
extensions:
default-extensions:
DeriveDataTypeable
EmptyDataDecls
FlexibleContexts
@ -51,9 +57,13 @@ library
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:
@ -64,18 +74,21 @@ test-suite tests
, hspec >= 2.1 && < 3
, monad-logger
, persistent-sqlite >= 2.1 && < 2.3
, persistent-postgresql >= 2.1 && < 2.3
, persistent-sqlite >= 2.1
, persistent-postgresql >= 2.1
, resource-pool
, QuickCheck
, serversession
, serversession-backend-persistent
extensions:
default-extensions:
OverloadedStrings
TemplateHaskell
main-is: Main.hs
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts
ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M2G -c" -rtsopts
if flag(lib-Werror)
ghc-options: -Werror
source-repository head

View File

@ -12,10 +12,10 @@ module Web.ServerSession.Backend.Persistent.Internal.Impl
, throwSS
) where
import Control.Applicative ((<$>), (<*>))
import Control.Applicative as A
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Monoid (mempty)
import Data.Monoid as M
import Data.Proxy (Proxy(..))
import Data.Time (UTCTime)
import Data.Typeable (Typeable)
@ -94,8 +94,9 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
[]
[]
["Eq", "Ord", "Show", "Typeable"]
mempty
M.mempty
False
Nothing
where
pfd :: P.EntityField (PersistentSession sess) typ -> P.FieldDef
pfd = P.persistFieldDef
@ -109,7 +110,7 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
fromPersistValues [a, b, c, d, e] =
PersistentSession
<$> err "key" (P.fromPersistValue a)
A.<$> err "key" (P.fromPersistValue a)
<*> err "authId" (P.fromPersistValue b)
<*> err "session" (P.fromPersistValue c)
<*> err "createdAt" (P.fromPersistValue d)
@ -142,26 +143,30 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
(P.SqlOther "SqlType unset for key")
[]
True
P.NoReference]
P.NoReference
Nothing]
[]))
Nothing
persistFieldDef PersistentSessionKey
= P.FieldDef
(P.HaskellName "key")
(P.DBName "key")
(P.FTTypeCon Nothing "SessionId sess")
(P.sqlType (Proxy :: Proxy (SessionId sess)))
[]
["maxlen=30"]
True
P.NoReference
Nothing
persistFieldDef PersistentSessionAuthId
= P.FieldDef
(P.HaskellName "authId")
(P.DBName "auth_id")
(P.FTTypeCon Nothing "ByteStringJ")
(P.sqlType (Proxy :: Proxy ByteStringJ))
["Maybe"]
["Maybe", "default=NULL"]
True
P.NoReference
Nothing
persistFieldDef PersistentSessionSession
= P.FieldDef
(P.HaskellName "session")
@ -171,6 +176,7 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
[]
True
P.NoReference
Nothing
persistFieldDef PersistentSessionCreatedAt
= P.FieldDef
(P.HaskellName "createdAt")
@ -180,6 +186,7 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
[]
True
P.NoReference
Nothing
persistFieldDef PersistentSessionAccessedAt
= P.FieldDef
(P.HaskellName "accessedAt")
@ -189,6 +196,7 @@ instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (Pe
[]
True
P.NoReference
Nothing
persistIdField = PersistentSessionId

View File

@ -12,7 +12,7 @@ module Web.ServerSession.Backend.Persistent.Internal.Types
-- $orphanSessionMap
) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Control.Arrow (first)
import Control.Monad ((>=>), mzero)
import Data.ByteString (ByteString)
@ -103,7 +103,7 @@ instance PersistFieldSql SessionMap where
instance S.Serialize SessionMap where
put = S.put . map (first TE.encodeUtf8) . HM.toList . unSessionMap
get = SessionMap . HM.fromList . map (first TE.decodeUtf8) <$> S.get
get = SessionMap . HM.fromList . map (first TE.decodeUtf8) A.<$> S.get
instance A.FromJSON SessionMap where
parseJSON = fmap fixup . A.parseJSON

View File

@ -0,0 +1,7 @@
1.0.4
* bump hedis to 0.13
1.0.3
* Allow hedis-0.10
1.0.2
* Get building on GHC 8
* Auto-expire expired keys in redis to avoid storage bloat over time.

View File

@ -1,36 +1,51 @@
cabal-version: >= 1.10
name: serversession-backend-redis
version: 1.0
version: 1.0.4
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: Storage backend for serversession using Redis.
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-backend-redis>
extra-source-files: README.md
changelog.md
flag old-locale
description: Use time-1.4 and old-locale (GHC 7.8).
default: False
flag lib-Werror
default: False
manual: True
library
default-language: Haskell2010
hs-source-dirs: src
build-depends:
base == 4.*
, bytestring
, hedis == 0.6.*
, hedis < 0.13
, path-pieces
, tagged >= 0.8
, tagged >= 0.7
, text
, time >= 1.5
, time >= 1.4
, transformers
, unordered-containers
, serversession == 1.0.*
if flag(old-locale)
build-depends: time == 1.4.*, old-locale
else
build-depends: time >= 1.5
exposed-modules:
Web.ServerSession.Backend.Redis
Web.ServerSession.Backend.Redis.Internal
extensions:
default-extensions:
CPP
DeriveDataTypeable
FlexibleContexts
OverloadedStrings
@ -38,9 +53,15 @@ library
ScopedTypeVariables
TypeFamilies
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
if impl(ghc >= 8.0.0)
ghc-options: -Wno-redundant-constraints
test-suite tests
default-language: Haskell2010
type: exitcode-stdio-1.0
hs-source-dirs: tests
build-depends:
@ -53,6 +74,9 @@ test-suite tests
, serversession-backend-redis
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

View File

@ -26,13 +26,13 @@ module Web.ServerSession.Backend.Redis.Internal
, throwRS
) where
import Control.Applicative ((<$), (<$>))
import Control.Applicative as A
import Control.Arrow (first)
import Control.Monad (void, when)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import Data.List (partition)
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import Web.PathPieces (toPathPiece)
@ -45,17 +45,27 @@ import qualified Data.ByteString.Char8 as B8
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Encoding as TE
import qualified Data.Time.Clock as TI
import qualified Data.Time.Clock.POSIX as TP
import qualified Data.Time.Format as TI
#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
----------------------------------------------------------------------
-- | Session storage backend using Redis via the @hedis@ package.
newtype RedisStorage sess =
data RedisStorage sess =
RedisStorage
{ connPool :: R.Connection
-- ^ Connection pool to the Redis server.
, idleTimeout :: Maybe TI.NominalDiffTime
-- ^ How long should a session live after last access
, absoluteTimeout :: Maybe TI.NominalDiffTime
-- ^ How long should a session live after creation
} deriving (Typeable)
@ -68,8 +78,8 @@ instance RedisSession sess => Storage (RedisStorage sess) where
getSession _ = getSessionImpl
deleteSession _ = deleteSessionImpl
deleteAllSessionsOfAuthId _ = deleteAllSessionsOfAuthIdImpl
insertSession _ = insertSessionImpl
replaceSession _ = replaceSessionImpl
insertSession = insertSessionImpl
replaceSession = replaceSessionImpl
-- | An exception thrown by the @serversession-backend-redis@
@ -184,13 +194,19 @@ printSession Session {..} =
-- | Parse 'UTCTime' from a 'ByteString' stored on Redis. Uses
-- 'error' on parse error.
parseUTCTime :: ByteString -> TI.UTCTime
parseUTCTime = TI.parseTimeOrError True TI.defaultTimeLocale timeFormat . B8.unpack
#if MIN_VERSION_time(1,5,0)
parseUTCTime = TI.parseTimeOrError True defaultTimeLocale timeFormat . B8.unpack
#else
parseUTCTime =
fromMaybe (error "Web.ServerSession.Backend.Redis.Internal.parseUTCTime") .
TI.parseTime defaultTimeLocale timeFormat . B8.unpack
#endif
-- | Convert a 'UTCTime' into a 'ByteString' to be stored on
-- Redis.
printUTCTime :: TI.UTCTime -> ByteString
printUTCTime = B8.pack . TI.formatTime TI.defaultTimeLocale timeFormat
printUTCTime = B8.pack . TI.formatTime defaultTimeLocale timeFormat
-- | Time format used when storing 'UTCTime'.
@ -214,7 +230,7 @@ batched f xs =
-- | Get the session for the given session ID.
getSessionImpl :: RedisSession sess => SessionId sess -> R.Redis (Maybe (Session sess))
getSessionImpl sid = parseSession sid <$> unwrap (R.hgetall $ rSessionKey sid)
getSessionImpl sid = parseSession sid A.<$> unwrap (R.hgetall $ rSessionKey sid)
-- | Delete the session with given session ID.
@ -260,8 +276,8 @@ deleteAllSessionsOfAuthIdImpl authId = do
-- | Insert a new session.
insertSessionImpl :: RedisSession sess => Session sess -> R.Redis ()
insertSessionImpl session = do
insertSessionImpl :: RedisSession sess => RedisStorage sess -> Session sess -> R.Redis ()
insertSessionImpl sto session = do
-- Check that no old session exists.
let sid = sessionKey session
moldSession <- getSessionImpl sid
@ -271,14 +287,14 @@ insertSessionImpl session = do
transaction $ do
let sk = rSessionKey sid
r <- batched (R.hmset sk) (printSession session)
-- TODO: R.expireat
expireSession session sto
insertSessionForAuthId (sessionKey session) (sessionAuthId session)
return (() <$ r)
-- | Replace the contents of a session.
replaceSessionImpl :: RedisSession sess => Session sess -> R.Redis ()
replaceSessionImpl session = do
replaceSessionImpl :: RedisSession sess => RedisStorage sess -> Session sess -> R.Redis ()
replaceSessionImpl sto session = do
-- Check that the old session exists.
let sid = sessionKey session
moldSession <- getSessionImpl sid
@ -290,6 +306,7 @@ replaceSessionImpl session = do
let sk = rSessionKey sid
_ <- R.del [sk]
r <- batched (R.hmset sk) (printSession session)
expireSession session sto
-- Remove the old auth ID from the map if it has changed.
let oldAuthId = sessionAuthId oldSession
@ -307,3 +324,21 @@ throwRS
=> StorageException (RedisStorage sess)
-> R.Redis a
throwRS = liftIO . E.throwIO
-- | Given a session, finds the next time the session will time out,
-- either by idle or absolute timeout and schedule the key in redis to
-- expire at that time. This is meant to be used on every write to a
-- session so that it is constantly setting the appropriate timeout.
expireSession :: Session sess -> RedisStorage sess -> R.RedisTx ()
expireSession Session {..} RedisStorage {..} =
case minimum' (catMaybes [viaIdle, viaAbsolute]) of
Nothing -> return ()
Just t -> let ts = round (TP.utcTimeToPOSIXSeconds t)
in void (R.expireat sk ts)
where
sk = rSessionKey sessionKey
minimum' [] = Nothing
minimum' xs = Just (minimum xs)
viaIdle = flip TI.addUTCTime sessionAccessedAt <$> idleTimeout
viaAbsolute = flip TI.addUTCTime sessionCreatedAt <$> absoluteTimeout

View File

@ -9,4 +9,4 @@ main :: IO ()
main = do
conn <- connect defaultConnectInfo
hspec $ describe "RedisStorage" $
allStorageTests (RedisStorage conn) it runIO parallel shouldBe shouldReturn shouldThrow
allStorageTests (RedisStorage conn (Just 999999) (Just 999999)) it runIO parallel shouldBe shouldReturn shouldThrow

View File

@ -0,0 +1,2 @@
1.0.1
* Get building on GHC-8

View File

@ -1,27 +1,34 @@
cabal-version: >= 1.10
name: serversession-frontend-snap
version: 1.0
version: 1.0.1
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: Snap bindings for serversession.
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-frontend-snap>
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.*
, bytestring
, nonce
, path-pieces
, snap == 0.14.*
, snap-core == 0.9.*
, snap >= 0.14
, snap-core >= 0.9
, text
, time
, transformers
@ -31,13 +38,16 @@ library
exposed-modules:
Web.ServerSession.Frontend.Snap
Web.ServerSession.Frontend.Snap.Internal
extensions:
default-extensions:
DeriveDataTypeable
FlexibleContexts
OverloadedStrings
TypeFamilies
UndecidableInstances
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
source-repository head
type: git

View File

@ -12,7 +12,7 @@ module Web.ServerSession.Frontend.Snap.Internal
, forceInvalidate
) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Control.Arrow (first, second)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
@ -137,7 +137,7 @@ instance ( Storage sto
mcookie <- S.getCookie (cookieName ssm)
-- Load session from storage backend.
(data1, saveSessionToken) <-
liftIO $ loadSession (state ssm) (S.cookieValue <$> mcookie)
liftIO $ loadSession (state ssm) (S.cookieValue A.<$> mcookie)
-- Add CSRF token if needed.
data2 <-
maybe

View File

View File

@ -1,19 +1,25 @@
cabal-version: >= 1.10
name: serversession-frontend-wai
version: 1.0
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: wai-session bindings for serversession.
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-frontend-wai>
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.6 && < 5
@ -33,11 +39,15 @@ library
exposed-modules:
Web.ServerSession.Frontend.Wai
Web.ServerSession.Frontend.Wai.Internal
extensions:
default-extensions:
FlexibleContexts
OverloadedStrings
TypeFamilies
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
if impl(ghc >= 8.0.0)
ghc-options: -Wno-redundant-constraints
source-repository head
type: git

View File

@ -6,7 +6,7 @@
-- @Max-age@ field is not supported by all browsers: some
-- browsers will treat them as non-persistent cookies.
--
-- * Also, the @Max-age@ is fixed and does not take a given a
-- * Also, the @Max-age@ is fixed and does not take a given
-- session into consideration.
module Web.ServerSession.Frontend.Wai
( -- * Simple interface

View File

@ -10,7 +10,7 @@ module Web.ServerSession.Frontend.Wai.Internal
, forceInvalidate
) where
import Control.Applicative ((<$>))
import Control.Applicative as A
import Control.Monad (guard)
import Control.Monad.IO.Class (MonadIO(..))
import Data.ByteString (ByteString)
@ -80,7 +80,7 @@ mkSession sessionRef =
-- We need to use atomicModifyIORef instead of readIORef
-- because latter may be reordered (cf. "Memory Model" on
-- Data.IORef's documentation).
( \k -> kvLookup k <$> liftIO (I.atomicModifyIORef' sessionRef $ \a -> (a, a))
( \k -> kvLookup k A.<$> liftIO (I.atomicModifyIORef' sessionRef $ \a -> (a, a))
, \k v -> liftIO (I.atomicModifyIORef' sessionRef $ flip (,) () . kvInsert k v)
)

View File

@ -1,19 +1,25 @@
cabal-version: >= 1.10
name: serversession-frontend-yesod
version: 1.0
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: Yesod bindings for serversession.
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-frontend-yesod>
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.*
@ -27,17 +33,19 @@ library
, transformers
, unordered-containers
, wai
, yesod-core == 1.4.*
, yesod-core >= 1.6
, serversession == 1.0.*
exposed-modules:
Web.ServerSession.Frontend.Yesod
Web.ServerSession.Frontend.Yesod.Internal
extensions:
default-extensions:
FlexibleContexts
OverloadedStrings
TypeFamilies
ghc-options: -Wall
if flag(lib-Werror)
ghc-options: -Werror
source-repository head
type: git

View File

@ -0,0 +1,2 @@
# 1.0.2
* add persistent-test to deps

View File

@ -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 @@ library
Web.ServerSession.Core
Web.ServerSession.Core.Internal
Web.ServerSession.Core.StorageTests
extensions:
default-extensions:
DeriveDataTypeable
FlexibleContexts
OverloadedStrings
@ -42,9 +49,13 @@ library
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 @@ test-suite tests
, hspec >= 2.1 && < 3
, QuickCheck
, serversession
extensions:
default-extensions:
DeriveDataTypeable
FlexibleContexts
OverloadedStrings
@ -66,6 +77,9 @@ test-suite tests
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

View File

@ -45,7 +45,7 @@ module Web.ServerSession.Core.Internal
, 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 @@ saveSessionOnDb state now maybeInput DecomposedSession {..} = do
(saveToDb, key, createdAt) <-
case maybeInput of
Nothing -> liftIO $
(,,) <$> return (insertSession $ storage state)
(,,) A.<$> return (insertSession $ storage state)
<*> generateSessionId (generator state)
<*> return now
Just Session {..} ->

View File

@ -7,9 +7,10 @@ module Web.ServerSession.Core.StorageTests
( 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 @@ allStorageTests storage it runIO parallel _shouldBe shouldReturn shouldThrow = d
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 @@ allStorageTests storage it runIO parallel _shouldBe shouldReturn shouldThrow = d
{ 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 @@ generateSession gen hasAuthId = do
{ 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

View File

@ -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 @@ main = hspec $ parallel $ do
-- 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

View File

@ -1,4 +1,18 @@
resolver: nightly-2015-06-09
flags:
serversession-backend-acid-state:
lib-Werror: true
serversession-frontend-wai:
lib-Werror: true
serversession-backend-persistent:
lib-Werror: true
serversession:
lib-Werror: true
serversession-backend-redis:
lib-Werror: true
serversession-frontend-yesod:
lib-Werror: true
serversession-frontend-snap:
lib-Werror: true
packages:
- serversession
- serversession-backend-acid-state
@ -7,7 +21,12 @@ packages:
- serversession-frontend-snap
- serversession-frontend-wai
- serversession-frontend-yesod
- examples/serversession-example-yesod-persistent
extra-deps:
- acid-state-0.12.4
- nonce-1.0.2
- wai-session-0.3.1
- snap-1.1.3.0@sha256:0c0814d2ab1c3d5f22cef4615b2913ded18e87710ea6febdbe6e3ab8d9838735,8872
- acid-state-0.16.0@sha256:a5640fd8d99bdb5f152476a2ae56cc8eb81864b280c8ec7d1387e81296ed844d,6190
- heist-1.1.0.1@sha256:7355cf8c1a7ef84c0c800c0539f7b99e7e540cace697238009a2dea1f05231f1,9311
- map-syntax-0.3@sha256:ca8b449615fa57419c16a5e98844624a6ac758692b87b3cfae8c74c87c56f1b2,2420
- pwstore-fast-2.4.4@sha256:9b6a37510d8b9f37f409a8ab3babac9181afcaaa3fce8ba1c131a7ed3de30698,1351
- xmlhtml-0.2.5.2@sha256:3f0990f725551985d777e8edb5563fe99aee998f1fde6a7633f720f76df54701,46997
resolver: lts-15.8

54
stack.yaml.lock Normal file
View File

@ -0,0 +1,54 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
hackage: snap-1.1.3.0@sha256:0c0814d2ab1c3d5f22cef4615b2913ded18e87710ea6febdbe6e3ab8d9838735,8872
pantry-tree:
size: 5743
sha256: 804f55a8cab81e720547308e799243e81f43e089b860c0d3160a938cad86ed0d
original:
hackage: snap-1.1.3.0@sha256:0c0814d2ab1c3d5f22cef4615b2913ded18e87710ea6febdbe6e3ab8d9838735,8872
- completed:
hackage: acid-state-0.16.0@sha256:a5640fd8d99bdb5f152476a2ae56cc8eb81864b280c8ec7d1387e81296ed844d,6190
pantry-tree:
size: 13678
sha256: c6e4b7f00d2a500e6286beafe3a2da7ba898a9ea31f5744df57cdce8a8f5890f
original:
hackage: acid-state-0.16.0@sha256:a5640fd8d99bdb5f152476a2ae56cc8eb81864b280c8ec7d1387e81296ed844d,6190
- completed:
hackage: heist-1.1.0.1@sha256:7355cf8c1a7ef84c0c800c0539f7b99e7e540cace697238009a2dea1f05231f1,9311
pantry-tree:
size: 7354
sha256: a2635ed49de6debaf8b98189989f83ab58dcc125c6ae8e57f6fe0903bc7fa8ff
original:
hackage: heist-1.1.0.1@sha256:7355cf8c1a7ef84c0c800c0539f7b99e7e540cace697238009a2dea1f05231f1,9311
- completed:
hackage: map-syntax-0.3@sha256:ca8b449615fa57419c16a5e98844624a6ac758692b87b3cfae8c74c87c56f1b2,2420
pantry-tree:
size: 558
sha256: c196bee0433f9540e4251ebd1be06d802ff7cc4931e6f0aedc38babd28683a3c
original:
hackage: map-syntax-0.3@sha256:ca8b449615fa57419c16a5e98844624a6ac758692b87b3cfae8c74c87c56f1b2,2420
- completed:
hackage: pwstore-fast-2.4.4@sha256:9b6a37510d8b9f37f409a8ab3babac9181afcaaa3fce8ba1c131a7ed3de30698,1351
pantry-tree:
size: 270
sha256: ff4a44ede62515efe5cd366a5803f7183c811c4a0cf56eea88da94181c4844c0
original:
hackage: pwstore-fast-2.4.4@sha256:9b6a37510d8b9f37f409a8ab3babac9181afcaaa3fce8ba1c131a7ed3de30698,1351
- completed:
hackage: xmlhtml-0.2.5.2@sha256:3f0990f725551985d777e8edb5563fe99aee998f1fde6a7633f720f76df54701,46997
pantry-tree:
size: 61835
sha256: bb1bd95db3738e18d112bbc9724510ee64a51b7eda61494507f4957c5e2281f6
original:
hackage: xmlhtml-0.2.5.2@sha256:3f0990f725551985d777e8edb5563fe99aee998f1fde6a7633f720f76df54701,46997
snapshots:
- completed:
size: 492015
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/8.yaml
sha256: 926bc3d70249dd0ba05277ff00943c0addb35b627cb641752669e7cf771310d0
original: lts-15.8