Analyses (SQL) transaction histories for possible conflicts.

sql_conflicts.hs

import Control.Monad.State
import Prelude hiding (reads)

-- A list of dirty records, along with the transactions that wrote to them
-- Also contains a list of read records
data TransactionState = TransactionState
  { dirtyRecs    :: [(Reg, Int)]
  , reads        :: [(Reg, Int)]
  , dirtyCommits :: [Int] 
  , dirtyReads   :: [Int]
  , dirtyWrites  :: [Int] }
   deriving (Show)


initialState :: TransactionState
initialState =
  TransactionState { dirtyRecs    = []
                   , reads        = []
                   , dirtyCommits = []
                   , dirtyReads   = [] 
                   , dirtyWrites  = [] }

type HExec a = State TransactionState a

data Action =
  R Int Reg |
  W Int Reg |
  C Int
  deriving (Eq, Show)

data Reg =
  SAL | SFL | SKY | SCA | SDC | SIL | SNY
  deriving (Eq, Show)

data HistoryType =
  NonRecoverable | Recoverable | AvoidsCascadingAborts | Strict
  deriving (Eq, Show)

type History = [Action]

ha, hb, hc :: History
ha =
  [R 3 SDC
  ,R 3 SIL
  ,R 1 SAL
  ,W 1 SAL
  ,R 1 SFL
  ,W 1 SFL
  ,C 1
  ,R 3 SFL
  ,R 3 SKY
  ,R 3 SNY
  ,C 3]

hb =
  [R 1 SAL
  ,W 1 SAL
  ,R 2 SKY
  ,W 2 SKY
  ,R 2 SCA
  ,R 3 SDC
  ,R 3 SIL
  ,R 3 SFL
  ,R 3 SKY
  ,R 3 SNY
  ,R 1 SFL
  ,W 1 SFL
  ,C 1
  ,W 2 SCA
  ,R 2 SAL
  ,W 2 SAL
  ,C 2
  ,C 3]

hc =
  [R 1 SAL
  ,W 1 SAL
  ,R 2 SKY
  ,W 2 SKY
  ,R 2 SCA
  ,W 2 SCA
  ,R 2 SAL
  ,W 2 SAL
  ,R 3 SDC
  ,R 3 SIL
  ,R 1 SFL
  ,W 1 SFL
  ,C 1
  ,R 3 SFL
  ,R 3 SKY
  ,R 3 SNY
  ,C 3
  ,C 2]

findConflicts :: History -> [(Action, Action)]
findConflicts [] = []
findConflicts (h : hs) =
  (findConflict h hs) ++ (findConflicts hs)
    
findConflict :: Action -> History -> [(Action, Action)]
findConflict _ [] =
  []
findConflict (C _) _ =
  []
findConflict a@(R x o) h  =
  map ((,) a) .
  filter (isW x o) $
  h
findConflict a@(W x o) h =
  map ((,) a) .
  filter (isW x o) $
  h

isW :: Int -> Reg -> Action -> Bool
isW _ _ (C _) = False
isW _ _ (R _ _) = False
isW x o (W y p) = (o == p) && (x /= y)

findHistoryType :: History -> HistoryType
findHistoryType h = 
  case (no_dc, no_dr, no_dw) of
    (_ , [], []) -> Strict
    (_ , [], _ ) -> AvoidsCascadingAborts
    ([], _ , _ ) -> Recoverable
    (_ , _ , _ ) -> NonRecoverable
  where
    s     = execState (executeHistory h) initialState
    no_dc = dirtyCommits s
    no_dr = dirtyReads   s
    no_dw = dirtyWrites  s

executeHistory :: History -> HExec ()
executeHistory [] =
  return ()
executeHistory ((C i) : hs) = do
  state <- get
  -- Get all reads by this transaction
  let rs    = map fst . filter ((== i) . snd) $ reads state
  -- Check if any of them are on dirty records
      dirty = map fst . filter ((/= i) . snd) $ dirtyRecs state
  -- Check if any of the reads are on other transaction's dirty records
      dts   = [] == filter (`elem` dirty) rs
      dirtyCommits' = dirtyCommits state
  if   dts
  then modify $ \s -> s { dirtyCommits = i : dirtyCommits' }
  else return ()
  -- Remove the newly-commited dirty records from state
  let dirtyRecs' = dirtyRecs state
  modify $ \s -> s { dirtyRecs = filter ((/= i) . snd) dirtyRecs' }
  executeHistory hs
executeHistory ((R x o) : hs) = do
  state <- get
  -- Check if record we're reading from was written to by another transaction
  let dirtyRead   = elem o (map fst . filter ((/= x) . snd) $ dirtyRecs state)
      dirtyReads' = dirtyReads state
      reads'      = reads state
  if   dirtyRead
  then modify $ \s -> s { dirtyReads = x : dirtyReads' }
  else return ()
  modify $ \s -> s { reads = (o, x) : reads' }
  executeHistory hs
executeHistory ((W x o) : hs) = do
  state <- get
  -- Check if record we're writing to was written to by another transaction
  let dirtyWrite   = elem o (map fst . filter ((/= x) . snd) $ dirtyRecs state)
      dirtyWrites' = dirtyWrites state 
      dirtyRecs'   = dirtyRecs state
  if   dirtyWrite
  then modify $ \s -> s { dirtyWrites = x : dirtyWrites' }
  else return ()
  modify $ \s -> s { dirtyRecs = (o, x) : dirtyRecs' }
  executeHistory hs