Skip to content
Permalink
Browse files

Merge pull request #189 from input-output-hk/erikd/webapi-atomic

doc: Document atomicity of PostgreSQL interactions
  • Loading branch information
erikd committed Dec 3, 2019
2 parents 7e05be2 + 02424d4 commit 025ef94646d6a1f0885606377cf10c054e841496
@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.Builder as LT

import Database.Persist.Postgresql (withPostgresqlConn, openSimpleConn)
import Database.PostgreSQL.Simple (connectPostgreSQL)
import Database.Persist.Sql (SqlBackend, runSqlConn)
import Database.Persist.Sql (SqlBackend, IsolationLevel (..), runSqlConnWithIsolation)

import Database.Esqueleto
import Database.Esqueleto.Internal.Sql
@@ -49,9 +49,9 @@ runDbHandleLogger logHandle dbAction = do
pgconf <- readPGPassFileEnv
runHandleLoggerT .
withPostgresqlConn (toConnectionString pgconf) $ \backend ->
-- The 'runSqlConn' function starts a transaction, runs the 'dbAction'
-- The 'runSqlConnWithIsolation' function starts a transaction, runs the 'dbAction'
-- and then commits the transaction.
runSqlConn dbAction backend
runSqlConnWithIsolation dbAction backend Serializable
where
runHandleLoggerT :: LoggingT m a -> m a
runHandleLoggerT action =
@@ -68,7 +68,7 @@ runDbIohkLogging tracer dbAction = do
pgconf <- readPGPassFileEnv
(runIohkLogging tracer) .
withPostgresqlConn (toConnectionString pgconf) $ \backend ->
runSqlConn dbAction backend
runSqlConnWithIsolation dbAction backend Serializable

runIohkLogging :: Trace IO Text -> LoggingT m a -> m a
runIohkLogging tracer action =
@@ -96,15 +96,15 @@ runDbNoLogging action = do
pgconfig <- readPGPassFileEnv
runNoLoggingT .
withPostgresqlConn (toConnectionString pgconfig) $ \backend ->
runSqlConn action backend
runSqlConnWithIsolation action backend Serializable

-- | Run a DB action with stdout logging. Mainly for debugging.
runDbStdoutLogging :: ReaderT SqlBackend (LoggingT IO) b -> IO b
runDbStdoutLogging action = do
pgconfig <- readPGPassFileEnv
runStdoutLoggingT .
withPostgresqlConn (toConnectionString pgconfig) $ \backend ->
runSqlConn action backend
runSqlConnWithIsolation action backend Serializable

-- from Control.Monad.Logger, wasnt exported
defaultOutput :: Handle
@@ -171,8 +171,10 @@ test-suite test
, cardano-explorer-db-test
, containers
, monad-logger
, persistent
, persistent-postgresql
, tasty
, tasty-hunit
, text
, transformers
, unliftio-core
@@ -37,7 +37,7 @@ import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Data.Word (Word16, Word64)

import Database.Persist.Sql (SqlBackend, runSqlConn)
import Database.Persist.Sql (IsolationLevel (..), SqlBackend, runSqlConnWithIsolation)

import Explorer.DB (Block (..), TxId)

@@ -86,7 +86,7 @@ k = 2160

runQuery :: MonadIO m => SqlBackend -> ReaderT SqlBackend IO a -> m a
runQuery backend query =
liftIO $ runSqlConn query backend
liftIO $ runSqlConnWithIsolation query backend Serializable

slotsPerEpoch :: Word64
slotsPerEpoch = k * 10
@@ -1,27 +1,34 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-error=orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.IO.Explorer.Web.Query where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Explorer.DB
import Explorer.Web.Query
import Test.IO.Explorer.DB.Util (assertBool, dummyUTCTime, mkBlockHash, testSlotLeader)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad.Logger (LoggingT, runLoggingT, runStdoutLoggingT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)

import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Logger
import Control.Monad.Trans.Reader
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (fromList, empty)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Data.Word (Word16, Word64)
import Database.Persist.Postgresql
import Database.Persist.Sql (PersistValue, IsolationLevel (..), SqlBackend,
runSqlConnWithIsolation)
import Database.Persist.Postgresql (rawExecute, withPostgresqlConn)

import Explorer.DB
import Explorer.Web.Query

import Test.IO.Explorer.DB.Util (assertBool, dummyUTCTime, mkBlockHash, testSlotLeader)

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)


tests :: TestTree
tests =
@@ -64,9 +71,10 @@ dropAndRemakeDbThenTest action = do
print pgconfig
loggingMode . withPostgresqlConn (toConnectionString pgconfig) $ action


testEmptyUtxo :: IO ()
testEmptyUtxo = do
dropAndRemakeDbThenTest $ \backend -> flip runSqlConn backend $ do
dropAndRemakeDbThenTest $ \backend -> runSqlAction backend $ do
slid <- insertSlotLeader testSlotLeader
bid0 <- insertBlock (blockZero slid)
snapshot <- queryUtxoSnapshot bid0
@@ -76,19 +84,17 @@ testEmptyUtxo = do
testCase1 :: IO ()
testCase1 = do
dropAndRemakeDbThenTest $ \backend -> do
let
g = flip runSqlConn backend
(slid, bid0) <- g $ do
(slid, bid0) <- runSqlAction backend $ do
slid <- insertSlotLeader testSlotLeader
bid0 <- insertBlock $ blockZero slid
pure (slid, bid0)

snapshot00 <- g $ do
snapshot00 <- runSqlAction backend $ do
snapshot00 <- fromList <$> queryUtxoSnapshot bid0
assertBool "utxo must be empty when no outputs exist" (snapshot00 == empty)
pure snapshot00

(bid1, expected1, out1, tx0, tx0id) <- g $ do
(bid1, expected1, out1, tx0, tx0id) <- runSqlAction backend $ do
bid1 <- insertBlock $ mkBlock 1 slid bid0
let tx0 = mkTx 0 bid1
tx0id <- insertTx tx0
@@ -102,7 +108,7 @@ testCase1 = do
mapM_ insertTxOut [ out0, out1 ]
pure (bid1, expected1, out1, tx0, tx0id)

snapshot10 <- g $ do
snapshot10 <- runSqlAction backend $ do
snapshot01 <- fromList <$> queryUtxoSnapshot bid0
assertBool "snapshot at point 0 must not change when inserting new blocks" (snapshot00 == snapshot01)
snapshot10 <- fromList <$> queryUtxoSnapshot bid1
@@ -112,7 +118,7 @@ testCase1 = do
assertBool "snapshot at point 1 should be expected value" (snapshot10 == expected1)
pure snapshot10

(bid2, tx1, out2, expected2) <- g $ do
(bid2, tx1, out2, expected2) <- runSqlAction backend $ do
bid2 <- insertBlock $ mkBlock 2 slid bid1
let tx1 = mkTx 1 bid2
tx1id <- insertTx tx1
@@ -126,7 +132,7 @@ testCase1 = do
_ <- insertTxOut out2
pure (bid2, tx1, out2, expected2)

(snapshot20) <- g $ do
(snapshot20) <- runSqlAction backend $ do
snapshot02 <- fromList <$> queryUtxoSnapshot bid0
snapshot11 <- fromList <$> queryUtxoSnapshot bid1
snapshot20 <- fromList <$> queryUtxoSnapshot bid2
@@ -135,7 +141,7 @@ testCase1 = do
assertBool "snapshot at point 2 should be expected value" (snapshot20 == expected2)
pure (snapshot20)

(bid3, expected3) <- g $ do
(bid3, expected3) <- runSqlAction backend $ do
bid3 <- insertBlock $ mkBlock 3 slid bid2
let tx2 = mkTx 2 bid3
tx2id <- insertTx tx2
@@ -149,7 +155,7 @@ testCase1 = do
_ <- insertTxOut out3
pure (bid3, expected3)

g $ do
runSqlAction backend $ do
snapshot03 <- fromList <$> queryUtxoSnapshot bid0
snapshot12 <- fromList <$> queryUtxoSnapshot bid1
snapshot21 <- fromList <$> queryUtxoSnapshot bid2
@@ -163,6 +169,10 @@ deriving instance Show TxOut
deriving instance Eq TxOut
deriving instance Ord TxOut

runSqlAction :: MonadUnliftIO m => SqlBackend -> ReaderT SqlBackend m a -> m a
runSqlAction backend action =
runSqlConnWithIsolation action backend Serializable

blockZero :: SlotLeaderId -> Block
blockZero slid =
Block (mkHash '\0') Nothing Nothing Nothing Nothing Nothing slid 0 dummyUTCTime 0
@@ -0,0 +1,30 @@
# Atomicity of PostgreSQL Interactions

Both the webapi and the node which populates the database operate on the database within a
database transaction. All operations on the database from Haskell code is done in a function
which has a type signatures of :
```
ReaderT SqlBackend m a
```
Any function without the `ReaderT SqlBackend` component will not be able to access the database
and any attempt to access the database without the required type signature will result in a compile
error at compile time.

All functions with the required file type are run with the function provided by Haskell's
[Persistent][Persistent] library:
```
runSqlConnWithIsolation action backend Serializable
```
where:
* `runSqlConnWithIsolation` is the function that runs the provided `action` on a connection to
the database within a database transaction.
* `action` is the action to be performed on the database (eg write or query).
* `backend` contains the database connection data.
* `Serializable` specifies the transaction isolation level.

In this case the `Serializable` [transaction isolation][PosgresIso] level is used which is the
*maximum* level of transaction isolation.

[Persistent]: https://hackage.haskell.org/package/persistent
[PosgresIso]: https://www.postgresql.org/docs/current/transaction-iso.html

Some generated files are not rendered by default. Learn more.

0 comments on commit 025ef94

Please sign in to comment.
You can’t perform that action at this time.