serversession-backend-persistent (empty) → 1.0
raw patch · 8 files changed
+654/−0 lines, 8 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, base64-bytestring, bytestring, cereal, hspec, monad-logger, path-pieces, persistent, persistent-postgresql, persistent-sqlite, persistent-template, resource-pool, serversession, serversession-backend-persistent, tagged, text, time, transformers, unordered-containers
Files
- LICENSE +20/−0
- README.md +10/−0
- Setup.lhs +7/−0
- serversession-backend-persistent.cabal +83/−0
- src/Web/ServerSession/Backend/Persistent.hs +47/−0
- src/Web/ServerSession/Backend/Persistent/Internal/Impl.hs +332/−0
- src/Web/ServerSession/Backend/Persistent/Internal/Types.hs +118/−0
- tests/Main.hs +37/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,10 @@+# serversession-backend-persistent++This is the storage backend for `serversession` using+`persistent` and an RDBMS. Please+[read the main README file](https://github.com/yesodweb/serversession/blob/master/README.md)+for general information about the serversession packages.++Unfortunately it is not easy to support all `persistent` backends+on a single package, and this is why we currently support the SQL+backend only (which is more commonly used).
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ serversession-backend-persistent.cabal view
@@ -0,0 +1,83 @@+name: serversession-backend-persistent+version: 1.0+license: MIT+license-file: LICENSE+author: Felipe Lessa <felipe.lessa@gmail.com>+maintainer: Felipe Lessa <felipe.lessa@gmail.com>+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++library+ hs-source-dirs: src+ build-depends:+ base == 4.*+ , aeson+ , base64-bytestring == 1.0.*+ , bytestring+ , cereal >= 0.4+ , path-pieces+ , persistent == 2.1.*+ , tagged >= 0.8+ , text+ , time+ , transformers+ , unordered-containers++ , serversession == 1.0.*+ exposed-modules:+ Web.ServerSession.Backend.Persistent+ Web.ServerSession.Backend.Persistent.Internal.Impl+ Web.ServerSession.Backend.Persistent.Internal.Types+ extensions:+ DeriveDataTypeable+ EmptyDataDecls+ FlexibleContexts+ FlexibleInstances+ GADTs+ GeneralizedNewtypeDeriving+ OverloadedStrings+ PatternGuards+ QuasiQuotes+ RecordWildCards+ ScopedTypeVariables+ StandaloneDeriving+ TemplateHaskell+ TypeFamilies+ UndecidableInstances+ ghc-options: -Wall+++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ build-depends:++ base, aeson, base64-bytestring, bytestring, cereal,+ path-pieces, persistent, persistent-template, text, time,+ transformers, unordered-containers++ , hspec >= 2.1 && < 3+ , monad-logger+ , persistent-sqlite == 2.1.*+ , persistent-postgresql == 2.1.*+ , resource-pool+ , QuickCheck++ , serversession+ , serversession-backend-persistent+ extensions:+ OverloadedStrings+ TemplateHaskell+ main-is: Main.hs+ ghc-options: -Wall -threaded "-with-rtsopts=-N -s -M1G -c" -rtsopts+++source-repository head+ type: git+ location: https://github.com/yesodweb/serversession
+ src/Web/ServerSession/Backend/Persistent.hs view
@@ -0,0 +1,47 @@+-- | Storage backend for @serversession@ using persistent.+--+-- In order to use this backend, you have to include+-- 'serverSessionDefs' on your migration code. For example,+-- the Yesod scaffold usually includes the following code:+--+-- @+-- -- On Model.hs+-- share [mkPersist sqlSettings, mkMigrate \"migrateAll\"]+--+-- -- On Application.hs+-- makeFoundation =+-- ...+-- runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc+-- ...+-- @+--+-- You should changed those lines to:+--+-- @+-- -- On Model.hs+-- share [mkPersist sqlSettings, mkSave \"entityDefs\"]+--+-- -- On Application.hs+-- import qualified Data.Proxy as P -- tagged package, or base from GHC 7.10 onwards+-- import qualified Web.ServerSession.Core as SS+-- import qualified Web.ServerSession.Backend.Persistent as SS+--+-- mkMigrate \"migrateAll\" (SS.serverSessionDefs (P.Proxy :: P.Proxy SS.SessionMap) ++ entityDefs)+--+-- makeFoundation =+-- ...+-- runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc+-- ...+-- @+--+-- If you're not using @SessionMap@, just change @Proxy@ type above.+--+-- If you forget to setup the migration above, this session+-- storage backend will fail at runtime as the required table+-- will not exist.+module Web.ServerSession.Backend.Persistent+ ( SqlStorage(..)+ , serverSessionDefs+ ) where++import Web.ServerSession.Backend.Persistent.Internal.Impl
+ src/Web/ServerSession/Backend/Persistent/Internal/Impl.hs view
@@ -0,0 +1,332 @@+-- | Internal module exposing the guts of the package. Use at+-- your own risk. No API stability guarantees apply.+module Web.ServerSession.Backend.Persistent.Internal.Impl+ ( PersistentSession(..)+ , PersistentSessionId+ , EntityField(..)+ , serverSessionDefs+ , psKey+ , toPersistentSession+ , fromPersistentSession+ , SqlStorage(..)+ , throwSS+ ) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Data.Monoid (mempty)+import Data.Proxy (Proxy(..))+import Data.Time (UTCTime)+import Data.Typeable (Typeable)+import Database.Persist (PersistEntity(..))+import Web.PathPieces (PathPiece)+import Web.ServerSession.Core++import qualified Control.Exception as E+import qualified Data.Aeson as A+import qualified Data.Text as T+import qualified Database.Persist as P+import qualified Database.Persist.Sql as P++import Web.ServerSession.Backend.Persistent.Internal.Types+++-- We can't use the Template Haskell since we want to generalize+-- some fields.+--+-- This is going to be a pain to upgrade when the next major+-- persistent version comes :(.++-- | Entity corresponding to a 'Session'.+--+-- We're bending @persistent@ in ways it wasn't expected to. In+-- particular, this entity is parametrized over the session type.+data PersistentSession sess =+ PersistentSession+ { persistentSessionKey :: !(SessionId sess) -- ^ Session ID, primary key.+ , persistentSessionAuthId :: !(Maybe ByteStringJ) -- ^ Value of "_ID" session key.+ , persistentSessionSession :: !(Decomposed sess) -- ^ Rest of the session data.+ , persistentSessionCreatedAt :: !UTCTime -- ^ When this session was created.+ , persistentSessionAccessedAt :: !UTCTime -- ^ When this session was last accessed.+ } deriving (Typeable)++deriving instance Eq (Decomposed sess) => Eq (PersistentSession sess)+deriving instance Ord (Decomposed sess) => Ord (PersistentSession sess)+deriving instance Show (Decomposed sess) => Show (PersistentSession sess)+++type PersistentSessionId sess = Key (PersistentSession sess)++instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (PersistentSession sess) where+ type PersistEntityBackend (PersistentSession sess) = P.SqlBackend++ data Unique (PersistentSession sess)++ newtype Key (PersistentSession sess) =+ PersistentSessionKey' {unPersistentSessionKey :: SessionId sess}+ deriving ( Eq, Ord, Show, Read, PathPiece+ , P.PersistField, P.PersistFieldSql, A.ToJSON, A.FromJSON )++ data EntityField (PersistentSession sess) typ =+ typ ~ PersistentSessionId sess => PersistentSessionId+ | typ ~ SessionId sess => PersistentSessionKey+ | typ ~ Maybe ByteStringJ => PersistentSessionAuthId+ | typ ~ Decomposed sess => PersistentSessionSession+ | typ ~ UTCTime => PersistentSessionCreatedAt+ | typ ~ UTCTime => PersistentSessionAccessedAt++ keyToValues = (:[]) . P.toPersistValue . unPersistentSessionKey+ keyFromValues [x] | Right v <- P.fromPersistValue x = Right $ PersistentSessionKey' v+ keyFromValues xs = Left $ T.pack $ "PersistentSession/keyFromValues: " ++ show xs++ entityDef _+ = P.EntityDef+ (P.HaskellName "PersistentSession")+ (P.DBName "persistent_session")+ (pfd PersistentSessionId)+ ["json"]+ [ pfd PersistentSessionKey+ , pfd PersistentSessionAuthId+ , pfd PersistentSessionSession+ , pfd PersistentSessionCreatedAt+ , pfd PersistentSessionAccessedAt ]+ []+ []+ ["Eq", "Ord", "Show", "Typeable"]+ mempty+ False+ where+ pfd :: P.EntityField (PersistentSession sess) typ -> P.FieldDef+ pfd = P.persistFieldDef++ toPersistFields (PersistentSession a b c d e) =+ [ P.SomePersistField a+ , P.SomePersistField b+ , P.SomePersistField c+ , P.SomePersistField d+ , P.SomePersistField e ]++ fromPersistValues [a, b, c, d, e] =+ PersistentSession+ <$> err "key" (P.fromPersistValue a)+ <*> err "authId" (P.fromPersistValue b)+ <*> err "session" (P.fromPersistValue c)+ <*> err "createdAt" (P.fromPersistValue d)+ <*> err "accessedAt" (P.fromPersistValue e)+ where+ err :: T.Text -> Either T.Text a -> Either T.Text a+ err s (Left r) = Left $ T.concat ["PersistentSession/fromPersistValues/", s, ": ", r]+ err _ (Right v) = Right v+ fromPersistValues x = Left $ T.pack $ "PersistentSession/fromPersistValues: " ++ show x++ persistUniqueToFieldNames _ = error "Degenerate case, should never happen"+ persistUniqueToValues _ = error "Degenerate case, should never happen"+ persistUniqueKeys _ = []++ persistFieldDef PersistentSessionId+ = P.FieldDef+ (P.HaskellName "Id")+ (P.DBName "id")+ (P.FTTypeCon+ Nothing "PersistentSessionId")+ (P.SqlOther "Composite Reference")+ []+ True+ (P.CompositeRef+ (P.CompositeDef+ [P.FieldDef+ (P.HaskellName "key")+ (P.DBName "key")+ (P.FTTypeCon Nothing "SessionId")+ (P.SqlOther "SqlType unset for key")+ []+ True+ P.NoReference]+ []))+ persistFieldDef PersistentSessionKey+ = P.FieldDef+ (P.HaskellName "key")+ (P.DBName "key")+ (P.FTTypeCon Nothing "SessionId sess")+ (P.sqlType (Proxy :: Proxy (SessionId sess)))+ []+ True+ P.NoReference+ persistFieldDef PersistentSessionAuthId+ = P.FieldDef+ (P.HaskellName "authId")+ (P.DBName "auth_id")+ (P.FTTypeCon Nothing "ByteStringJ")+ (P.sqlType (Proxy :: Proxy ByteStringJ))+ ["Maybe"]+ True+ P.NoReference+ persistFieldDef PersistentSessionSession+ = P.FieldDef+ (P.HaskellName "session")+ (P.DBName "session")+ (P.FTTypeCon Nothing "Decomposed sess")+ (P.sqlType (Proxy :: Proxy (Decomposed sess))) -- Important!+ []+ True+ P.NoReference+ persistFieldDef PersistentSessionCreatedAt+ = P.FieldDef+ (P.HaskellName "createdAt")+ (P.DBName "created_at")+ (P.FTTypeCon Nothing "UTCTime")+ (P.sqlType (Proxy :: Proxy UTCTime))+ []+ True+ P.NoReference+ persistFieldDef PersistentSessionAccessedAt+ = P.FieldDef+ (P.HaskellName "accessedAt")+ (P.DBName "accessed_at")+ (P.FTTypeCon Nothing "UTCTime")+ (P.sqlType (Proxy :: Proxy UTCTime))+ []+ True+ P.NoReference++ persistIdField = PersistentSessionId++ fieldLens PersistentSessionId = lensPTH+ P.entityKey+ (\(P.Entity _ v) k -> P.Entity k v)+ fieldLens PersistentSessionKey = lensPTH+ (persistentSessionKey . P.entityVal)+ (\(P.Entity k v) x -> P.Entity k (v {persistentSessionKey = x}))+ fieldLens PersistentSessionAuthId = lensPTH+ (persistentSessionAuthId . P.entityVal)+ (\(P.Entity k v) x -> P.Entity k (v {persistentSessionAuthId = x}))+ fieldLens PersistentSessionSession = lensPTH+ (persistentSessionSession . P.entityVal)+ (\(P.Entity k v) x -> P.Entity k (v {persistentSessionSession = x}))+ fieldLens PersistentSessionCreatedAt = lensPTH+ (persistentSessionCreatedAt . P.entityVal)+ (\(P.Entity k v) x -> P.Entity k (v {persistentSessionCreatedAt = x}))+ fieldLens PersistentSessionAccessedAt = lensPTH+ (persistentSessionAccessedAt . P.entityVal)+ (\(P.Entity k v) x -> P.Entity k (v {persistentSessionAccessedAt = x}))+++-- | Copy-paste from @Database.Persist.TH@. Who needs lens anyway...+lensPTH :: Functor f => (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t+lensPTH sa sbt afb s = fmap (sbt s) (afb $ sa s)+++instance A.ToJSON (Decomposed sess) => A.ToJSON (PersistentSession sess) where+ toJSON (PersistentSession key authId session createdAt accessedAt) =+ A.object+ [ "key" A..= key+ , "authId" A..= authId+ , "session" A..= session+ , "createdAt" A..= createdAt+ , "accessedAt" A..= accessedAt ]++instance A.FromJSON (Decomposed sess) => A.FromJSON (PersistentSession sess) where+ parseJSON (A.Object obj) =+ PersistentSession+ <$> obj A..: "key"+ <*> obj A..: "authId"+ <*> obj A..: "session"+ <*> obj A..: "createdAt"+ <*> obj A..: "accessedAt"+ parseJSON _ = mempty++instance ( A.ToJSON (Decomposed sess)+ , P.PersistFieldSql (Decomposed sess)+ ) => A.ToJSON (P.Entity (PersistentSession sess)) where+ toJSON = P.entityIdToJSON++instance ( A.FromJSON (Decomposed sess)+ , P.PersistFieldSql (Decomposed sess)+ ) => A.FromJSON (P.Entity (PersistentSession sess)) where+ parseJSON = P.entityIdFromJSON+++-- | Entity definitions needed to generate the SQL schema for+-- 'SqlStorage'. Example using 'SessionMap':+--+-- @+-- serverSessionDefs (Proxy :: Proxy SessionMap)+-- @+serverSessionDefs :: forall sess. PersistEntity (PersistentSession sess) => Proxy sess -> [P.EntityDef]+serverSessionDefs _ = [entityDef (Proxy :: Proxy (PersistentSession sess))]+++-- | Generate a key to the entity from the session ID.+psKey :: SessionId sess -> Key (PersistentSession sess)+psKey = PersistentSessionKey'+++-- | Convert from 'Session' to 'PersistentSession'.+toPersistentSession :: Session sess -> PersistentSession sess+toPersistentSession Session {..} =+ PersistentSession+ { persistentSessionKey = sessionKey+ , persistentSessionAuthId = fmap B sessionAuthId+ , persistentSessionSession = sessionData+ , persistentSessionCreatedAt = sessionCreatedAt+ , persistentSessionAccessedAt = sessionAccessedAt+ }+++-- | Convert from 'PersistentSession' to 'Session'.+fromPersistentSession :: PersistentSession sess -> Session sess+fromPersistentSession PersistentSession {..} =+ Session+ { sessionKey = persistentSessionKey+ , sessionAuthId = fmap unB persistentSessionAuthId+ , sessionData = persistentSessionSession+ , sessionCreatedAt = persistentSessionCreatedAt+ , sessionAccessedAt = persistentSessionAccessedAt+ }+++-- | SQL session storage backend using @persistent@.+newtype SqlStorage sess =+ SqlStorage+ { connPool :: P.ConnectionPool+ -- ^ Pool of DB connections. You may use the same pool as+ -- your application.+ } deriving (Typeable)+++instance forall sess.+ ( IsSessionData sess+ , P.PersistFieldSql (Decomposed sess)+ ) => Storage (SqlStorage sess) where+ type SessionData (SqlStorage sess) = sess+ type TransactionM (SqlStorage sess) = P.SqlPersistT IO+ runTransactionM = flip P.runSqlPool . connPool+ getSession _ = fmap (fmap fromPersistentSession) . P.get . psKey+ deleteSession _ = P.delete . psKey+ deleteAllSessionsOfAuthId _ authId =+ P.deleteWhere [field P.==. Just (B authId)]+ where+ field :: EntityField (PersistentSession sess) (Maybe ByteStringJ)+ field = PersistentSessionAuthId+ insertSession s session = do+ mold <- getSession s (sessionKey session)+ maybe+ (void $ P.insert $ toPersistentSession session)+ (\old -> throwSS $ SessionAlreadyExists old session)+ mold+ replaceSession _ session = do+ let key = psKey $ sessionKey session+ mold <- P.get key+ maybe+ (throwSS $ SessionDoesNotExist session)+ (\_old -> void $ P.replace key $ toPersistentSession session)+ mold+++-- | Specialization of 'E.throwIO' for 'SqlStorage'.+throwSS+ :: Storage (SqlStorage sess)+ => StorageException (SqlStorage sess)+ -> TransactionM (SqlStorage sess) a+throwSS = liftIO . E.throwIO
+ src/Web/ServerSession/Backend/Persistent/Internal/Types.hs view
@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Internal module exposing the guts of the package. Use at+-- your own risk. No API stability guarantees apply.+--+-- Also exports orphan instances of @PersistField{,Sql} SessionId@.+module Web.ServerSession.Backend.Persistent.Internal.Types+ ( ByteStringJ(..)+ -- * Orphan instances+ -- ** SessionId+ -- $orphanSessionId+ -- ** SessionMap+ -- $orphanSessionMap+ ) where++import Control.Applicative ((<$>))+import Control.Arrow (first)+import Control.Monad ((>=>), mzero)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Typeable (Typeable)+import Database.Persist (PersistField(..))+import Database.Persist.Sql (PersistFieldSql(..), SqlType(..))+import Web.ServerSession.Core+import Web.ServerSession.Core.Internal (SessionId(..))++import qualified Data.Aeson as A+import qualified Data.ByteString.Base64.URL as B64URL+import qualified Data.HashMap.Strict as HM+import qualified Data.Serialize as S+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+++----------------------------------------------------------------------+++-- $orphanSessionId+--+-- @+-- instance 'PersistField' ('SessionId' sess)+-- instance 'PersistFieldSql' ('SessionId' sess)+-- @+--+-- Does not do sanity checks (DB is trusted).+instance PersistField (SessionId sess) where+ toPersistValue = toPersistValue . unS+ fromPersistValue = fmap S . fromPersistValue++instance PersistFieldSql (SessionId sess) where+ sqlType p = sqlType (fmap unS p)+++----------------------------------------------------------------------+++-- | Newtype of a 'ByteString' with JSON support via base64url.+newtype ByteStringJ = B { unB :: ByteString }+ deriving (Eq, Ord, Show, Read, Typeable)++instance PersistField ByteStringJ where+ toPersistValue = toPersistValue . unB+ fromPersistValue = fmap B . fromPersistValue++instance PersistFieldSql ByteStringJ where+ sqlType p = sqlType (fmap unB p)++instance A.FromJSON ByteStringJ where+ parseJSON (A.String t) =+ either (const mzero) (return . B) $+ B64URL.decode $+ TE.encodeUtf8 t+ parseJSON _ = mzero++instance A.ToJSON ByteStringJ where+ toJSON = A.String . TE.decodeUtf8 . B64URL.encode . unB+++----------------------------------------------------------------------+++-- $orphanSessionMap+--+-- @+-- instance 'PersistField' 'SessionMap'+-- instance 'PersistFieldSql' 'SessionMap'+-- instance 'S.Serialize' 'SessionMap'+-- instance 'A.FromJSON' 'SessionMap'+-- instance 'A.ToJSON' 'SessionMap'+-- @++-- 'PersistField' for 'SessionMap' serializes using @cereal@ on+-- the database. We tried to use @aeson@ but @cereal@ is twice+-- faster and uses half the memory for this use case.+--+-- The JSON instance translates to objects using base64url for+-- the values of 'ByteString' (cf. 'ByteStringJ').+instance PersistField SessionMap where+ toPersistValue = toPersistValue . S.encode+ fromPersistValue = fromPersistValue >=> (either (Left . T.pack) Right . S.decode)++instance PersistFieldSql SessionMap where+ sqlType _ = SqlBlob++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++instance A.FromJSON SessionMap where+ parseJSON = fmap fixup . A.parseJSON+ where+ fixup :: HM.HashMap Text ByteStringJ -> SessionMap+ fixup = SessionMap . fmap unB++instance A.ToJSON SessionMap where+ toJSON = A.toJSON . mangle+ where+ mangle :: SessionMap -> HM.HashMap Text ByteStringJ+ mangle = fmap B . unSessionMap
+ tests/Main.hs view
@@ -0,0 +1,37 @@+module Main (main) where++import Control.Monad (forM_)+import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)+import Data.Pool (destroyAllResources)+import Data.Proxy (Proxy(..))+import Database.Persist.Postgresql (createPostgresqlPool)+import Database.Persist.Sqlite (createSqlitePool)+import Test.Hspec+import Web.ServerSession.Backend.Persistent+import Web.ServerSession.Core (SessionMap)+import Web.ServerSession.Core.StorageTests++import qualified Control.Exception as E+import qualified Database.Persist.TH as P+import qualified Database.Persist.Sql as P++P.mkMigrate "migrateAll" (serverSessionDefs (Proxy :: Proxy SessionMap))++main :: IO ()+main = hspec $+ forM_ [ ("PostgreSQL", createPostgresqlPool "user=test dbname=test password=test" 20)+ , ("SQLite", createSqlitePool "test.db" 1) ] $+ \(rdbms, createPool) ->+ describe ("SqlStorage on " ++ rdbms) $ do+ epool <-+ runIO $ E.try $ do+ pool <- runNoLoggingT createPool+ runStderrLoggingT $ P.runSqlPool (P.runMigration migrateAll) pool+ return pool+ case epool of+ Left (E.SomeException exc) ->+ it "failed to create connection or migrate database" $+ pendingWith (show exc)+ Right pool ->+ afterAll_ (destroyAllResources pool) $+ allStorageTests (SqlStorage pool) it runIO parallel shouldBe shouldReturn shouldThrow