haskell/serversession
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Throw exceptions from persistent's {insert,replace}Session.

Browse Source 
Now all tests are green for serversession-backend-persistent.
This commit is contained in:
Felipe Lessa 2015-05-28 00:48:44 -03:00
parent 8a6df8cc6c
commit 80f121f57b
2 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
serversession-backend-persistent/serversession-backend-persistent.cabal
View File

@ -26,6 +26,7 @@ library
, persistent-template == 2.1.* , persistent-template == 2.1.*
, text , text
, time , time
, transformers
, serversession == 1.0.* , serversession == 1.0.*
exposed-modules: exposed-modules:
@ -52,7 +53,8 @@ test-suite tests
build-depends: build-depends:
base, aeson, base64-bytestring, bytestring, containers, base, aeson, base64-bytestring, bytestring, containers,
path-pieces, persistent, persistent-template, text, time path-pieces, persistent, persistent-template, text, time,
transformers
, hspec >= 2.1 && < 3 , hspec >= 2.1 && < 3
, monad-logger , monad-logger

17
serversession-backend-persistent/src/Web/ServerSession/Backend/Persistent/Internal/Impl.hs
View File

@ -12,12 +12,14 @@ module Web.ServerSession.Backend.Persistent.Internal.Impl
) where ) where
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Database.Persist (PersistEntity(..)) import Database.Persist (PersistEntity(..))
import Database.Persist.TH (mkPersist, mkSave, persistLowerCase, share, sqlSettings) import Database.Persist.TH (mkPersist, mkSave, persistLowerCase, share, sqlSettings)
import Web.ServerSession.Core import Web.ServerSession.Core
import qualified Control.Exception as E
import qualified Database.Persist as P import qualified Database.Persist as P
import qualified Database.Persist.Sql as P import qualified Database.Persist.Sql as P
@ -82,5 +84,16 @@ instance Storage SqlStorage where
getSession _ = fmap (fmap fromPersistentSession) . P.get . psKey getSession _ = fmap (fmap fromPersistentSession) . P.get . psKey
deleteSession _ = P.delete . psKey deleteSession _ = P.delete . psKey
deleteAllSessionsOfAuthId _ authId = P.deleteWhere [PersistentSessionAuthId P.==. Just (B authId)] deleteAllSessionsOfAuthId _ authId = P.deleteWhere [PersistentSessionAuthId P.==. Just (B authId)]
insertSession _ = void . P.insert . toPersistentSession insertSession s session = do
replaceSession _ = \session -> P.replace (psKey $ sessionKey session) $ toPersistentSession session mold <- getSession s (sessionKey session)
maybe
(void $ P.insert $ toPersistentSession session)
(\old -> liftIO $ E.throwIO $ SessionAlreadyExists old session)
mold
replaceSession s session = do
let key = psKey $ sessionKey session
mold <- P.get key
maybe
(liftIO $ E.throwIO $ SessionDoesNotExist session)
(\_old -> void $ P.replace key $ toPersistentSession session)
mold