WIP unify budget and history pipelines

app/Main.hs

@@ -174,19 +174,25 @@ runSync c = do
       liftIOExceptT $ getDBState config
 
     -- read desired statements from disk
-    bSs <-
+    (rus, is) <-
-      flip runReaderT state $
+      flip runReaderT state $ do
-        catMaybes <$> mapErrorsIO (readHistStmt root) hSs
+        hSs' <- mapErrorsIO (readHistStmt root) hSs
+        hTs' <- liftIOExceptT $ mapErrors readHistTransfer hTs
+        bTs <- liftIOExceptT $ mapErrors readBudget $ budget config
+        return $ second concat $ partitionEithers $ hSs' ++ hTs' ++ bTs
 
     -- update the DB
     runSqlQueryT pool $ withTransaction $ flip runReaderT state $ do
-      let runHist = do
+      res <- runExceptT $ do
-            ts <- catMaybes <$> mapErrors readHistTransfer hTs
+        -- TODO taking out the hash is dumb
-            insertHistory $ bSs ++ ts
+        (rs, ues) <- readUpdates $ fmap commitRHash rus
-      let runBudget = mapErrors insertBudget $ budget config
+        let ebs = fmap ToUpdate ues ++ fmap ToRead rs ++ fmap ToInsert is
+        insertAll ebs
+      -- NOTE this rerunnable thing is a bit misleading; fromEither will throw
+      -- whatever error is encountered above in an IO context, but the first
+      -- thrown error should be caught despite possibly needing to be rerun
+      rerunnableIO $ fromEither res
       updateDBState updates -- TODO this will only work if foreign keys are deferred
-      res <- runExceptT $ combineError runHist runBudget $ \_ _ -> ()
-      rerunnableIO $ fromEither res -- TODO why is this here?
   where
     root = takeDirectory c
     err (InsertException es) = do

lib/Internal/Budget.hs

@@ -1,10 +1,8 @@
-module Internal.Budget (insertBudget) where
+module Internal.Budget (readBudget) where
 
 import Control.Monad.Except
 import Data.Foldable
-import Database.Persist.Monad
 import Internal.Database
-import Internal.History
 import Internal.Types.Main
 import Internal.Utils
 import RIO hiding (to)
@@ -25,11 +23,11 @@ import RIO.Time
 -- 4. assign shadow transactions
 -- 5. insert all transactions
 
-insertBudget
+readBudget
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
+  :: (MonadInsertError m, MonadFinance m)
   => Budget
-  -> m ()
+  -> m (Either CommitR [Tx TxCommit])
-insertBudget
+readBudget
   b@Budget
     { bgtLabel
     , bgtIncomes
@@ -40,14 +38,13 @@ insertBudget
     , bgtPosttax
     , bgtInterval
     } =
-    whenHash CTBudget b () $ \key -> do
+    eitherHash CTBudget b return $ \key -> do
       (intAllos, _) <- combineError intAlloRes acntRes (,)
-      let res1 = mapErrors (insertIncome key bgtLabel intAllos bgtInterval) bgtIncomes
+      let res1 = mapErrors (readIncome key bgtLabel intAllos bgtInterval) bgtIncomes
       let res2 = expandTransfers key bgtLabel bgtInterval bgtTransfers
       txs <- combineError (concat <$> res1) res2 (++)
       shadow <- addShadowTransfers bgtShadowTransfers txs
-      (_, toIns) <- balanceTxs $ fmap ToInsert $ txs ++ shadow
+      return $ txs ++ shadow
-      void $ insertBudgetTx toIns
     where
       acntRes = mapErrors isNotIncomeAcnt alloAcnts
       intAlloRes = combineError3 pre_ tax_ post_ (,,)
@@ -60,60 +57,6 @@ insertBudget
           ++ (alloAcnt <$> bgtTax)
           ++ (alloAcnt <$> bgtPosttax)
 
--- TODO need to systematically make this function match the history version,
--- which will allow me to use the same balancing algorithm for both
--- balanceTransfers :: [Tx BudgetMeta] -> [KeyEntry]
--- balanceTransfers = undefined
-
--- balanceTransfers = snd . L.mapAccumR go M.empty . reverse . L.sortOn ftWhen
---   where
---     go bals f@FlatTransfer {ftFrom, ftTo, ftValue = UnbalancedValue {cvValue, cvType}} =
---       let balTo = M.findWithDefault 0 ftTo bals
---           x = amtToMove balTo cvType cvValue
---           bals' = mapAdd_ ftTo x $ mapAdd_ ftFrom (-x) bals
---        in (bals', f {ftValue = x})
---     -- TODO might need to query signs to make this intuitive; as it is this will
---     -- probably work, but for credit accounts I might need to supply a negative
---     -- target value
---     amtToMove _ TFixed x = x
---     amtToMove bal TPercent x = -(x / 100 * bal)
---     amtToMove bal TBalance x = x - bal
-
-insertBudgetTx
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => [InsertTx BudgetMeta]
-  -> m ()
-insertBudgetTx toInsert = do
-  forM_ (groupKey (commitRHash . bmCommit) $ (\x -> (itxCommit x, x)) <$> toInsert) $
-    \(c, ts) -> do
-      ck <- insert $ bmCommit c
-      mapM_ (insertTx ck) ts
-  where
-    insertTx c InsertTx {itxDate = d, itxDescr = e, itxEntries = ss, itxCommit = BudgetMeta {bmName}} = do
-      let anyDeferred = any (isJust . feDeferred) ss
-      k <- insert $ TransactionR c d e anyDeferred
-      mapM_ (insertBudgetLabel bmName k) ss
-    insertBudgetLabel n k entry = do
-      sk <- insertEntry k entry
-      insert_ $ BudgetLabelR sk n
-
--- insertBudgetTx
---   :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
---   => BalancedTransfer
---   -> m ()
--- insertBudgetTx FlatTransfer {ftFrom, ftTo, ftMeta, ftCur, ftValue, ftDesc, ftWhen} = do
--- ((sFrom, sTo), exchange) <- entryPair ftFrom ftTo ftCur ftValue
--- insertPair sFrom sTo
--- forM_ exchange $ uncurry insertPair
--- where
---   insertPair from to = do
---     k <- insert $ TransactionR (bmCommit ftMeta) ftWhen ftDesc
---     insertBudgetLabel k from
---     insertBudgetLabel k to
---   insertBudgetLabel k entry = do
---     sk <- insertEntry k entry
---     insert_ $ BudgetLabelR sk $ bmName ftMeta
-
 entryPair
   :: (MonadInsertError m, MonadFinance m)
   => TaggedAcnt
@@ -170,15 +113,15 @@ sortAllo a@Allocation {alloAmts = as} = do
 -- TODO this will scan the interval allocations fully each time
 -- iteration which is a total waste, but the fix requires turning this
 -- loop into a fold which I don't feel like doing now :(
-insertIncome
+readIncome
   :: (MonadInsertError m, MonadFinance m)
-  => CommitRId
+  => CommitR
   -> T.Text
   -> IntAllocations
   -> Maybe Interval
   -> Income
-  -> m [Tx BudgetMeta]
+  -> m [Tx TxCommit]
-insertIncome
+readIncome
   key
   name
   (intPre, intTax, intPost)
@@ -212,7 +155,7 @@ insertIncome
       dayRes = askDays incWhen localInterval
       start = fromGregorian' $ pStart incPayPeriod
       pType' = pType incPayPeriod
-      meta = BudgetMeta key name
+      meta = BudgetCommit key name
       flatPre = concatMap flattenAllo incPretax
       flatTax = concatMap flattenAllo incTaxes
       flatPost = concatMap flattenAllo incPosttax
@@ -352,11 +295,11 @@ selectAllos day Allocation {alloAmts, alloCur, alloTo} =
 
 allo2Trans
   :: (MonadInsertError m, MonadFinance m)
-  => BudgetMeta
+  => TxCommit
   -> Day
   -> TaggedAcnt
   -> FlatAllocation Rational
-  -> m (Tx BudgetMeta)
+  -> m (Tx TxCommit)
 allo2Trans meta day from FlatAllocation {faValue, faTo, faDesc, faCur} = do
   -- TODO double here?
   p <- entryPair from faTo faCur faDesc (fromRational faValue)
@@ -441,12 +384,12 @@ allocatePost precision aftertax = fmap (fmap go)
 -- Standalone Transfer
 
 expandTransfers
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
+  :: (MonadInsertError m, MonadFinance m)
-  => CommitRId
+  => CommitR
   -> T.Text
   -> Maybe Interval
   -> [BudgetTransfer]
-  -> m [Tx BudgetMeta]
+  -> m [Tx TxCommit]
 expandTransfers key name localInterval ts = do
   txs <-
     fmap (L.sortOn txDate . concat) $
@@ -459,13 +402,13 @@ expandTransfers key name localInterval ts = do
       return $ filter (inDaySpan bounds . txDate) txs
 
 expandTransfer
-  :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
+  :: (MonadInsertError m, MonadFinance m)
-  => CommitRId
+  => CommitR
   -> T.Text
   -> BudgetTransfer
-  -> m [Tx BudgetMeta]
+  -> m [Tx TxCommit]
-expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFrom} = do
+expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFrom} =
-  fmap concat $ mapErrors go transAmounts
+  concat <$> mapErrors go transAmounts
   where
     go
       Amount
@@ -474,7 +417,7 @@ expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFro
         , amtDesc = desc
         } =
         withDates pat $ \day -> do
-          let meta = BudgetMeta {bmCommit = key, bmName = name}
+          let meta = BudgetCommit key name
           p <- entryPair_ (\_ x -> EntryValue t $ toRational x) transFrom transTo transCurrency desc v
           return
             Tx
@@ -486,7 +429,7 @@ expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFro
               }
 
 withDates
-  :: (MonadSqlQuery m, MonadFinance m, MonadInsertError m)
+  :: (MonadFinance m, MonadInsertError m)
   => DatePat
   -> (Day -> m a)
   -> m [a]
@@ -502,9 +445,9 @@ withDates dp f = do
 addShadowTransfers
   :: (MonadInsertError m, MonadFinance m)
   => [ShadowTransfer]
-  -> [Tx BudgetMeta]
+  -> [Tx TxCommit]
-  -> m [Tx BudgetMeta]
+  -> m [Tx TxCommit]
-addShadowTransfers ms txs = mapErrors go txs
+addShadowTransfers ms = mapErrors go
   where
     go tx = do
       es <- catMaybes <$> mapErrors (fromShadow tx) ms
@@ -512,7 +455,7 @@ addShadowTransfers ms txs = mapErrors go txs
 
 fromShadow
   :: (MonadInsertError m, MonadFinance m)
-  => Tx BudgetMeta
+  => Tx TxCommit
   -> ShadowTransfer
   -> m (Maybe (EntrySet AcntID CurrencyPrec TagID Rational (Either Double (EntryValue Rational))))
 fromShadow tx ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stMatch} = do
@@ -520,7 +463,7 @@ fromShadow tx ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stMatch
   es <- entryPair_ (\_ v -> Left v) stFrom stTo stCurrency stDesc stRatio
   return $ if not res then Nothing else Just es
 
-shadowMatches :: TransferMatcher -> Tx BudgetMeta -> InsertExcept Bool
+shadowMatches :: TransferMatcher -> Tx TxCommit -> InsertExcept Bool
 shadowMatches TransferMatcher {tmFrom, tmTo, tmDate} Tx {txPrimary, txDate} = do
   -- NOTE this will only match against the primary entry set since those
   -- are what are guaranteed to exist from a transfer
@@ -538,10 +481,6 @@ shadowMatches TransferMatcher {tmFrom, tmTo, tmDate} Tx {txPrimary, txDate} = do
 --------------------------------------------------------------------------------
 -- random
 
--- initialCurrency :: TransferCurrency -> CurID
--- initialCurrency (NoX c) = c
--- initialCurrency (X Exchange {xFromCur = c}) = c
-
 alloAcnt :: Allocation w v -> AcntID
 alloAcnt = taAcnt . alloTo
 
@@ -551,85 +490,6 @@ data UnbalancedValue = UnbalancedValue
   }
   deriving (Show)
 
--- TODO need to make this into the same ish thing as the Tx/EntrySet structs
--- in the history algorithm, which will entail resolving the budget currency
--- stuff earlier in the chain, and preloading multiple entries into this thing
--- before balancing.
--- type UnbalancedTransfer = FlatTransfer UnbalancedValue
-
--- ubt2tx :: UnbalancedTransfer -> Tx BudgetMeta
--- ubt2tx
---   FlatTransfer
---     { ftFrom
---     , ftTo
---     , ftValue
---     , ftWhen
---     , ftDesc
---     , ftMeta
---     , ftCur
---     } =
---     Tx
---       { txDescr = ftDesc
---       , txDate = ftWhen
---       , txPrimary = p
---       , txOther = maybeToList os
---       , txCommit = ftMeta
---       }
---     where
---       (p, os) = entries ftCur
---       entries (NoX curid) = (pair curid ftFrom ftTo ftValue, Nothing)
---       entries (X Exchange {xFromCur, xToCur, xAcnt, xRate}) =
---         let middle = TaggedAcnt xAcnt []
---             p1 = pair xFromCur ftFrom middle ftValue
---             p2 = pair xToCur middle ftTo (ftValue * roundPrecision 3 xRate)
---          in (p1, Just p2)
---       pair c (TaggedAcnt fa fts) (TaggedAcnt ta tts) v =
---         EntrySet
---           { esTotalValue = v
---           , esCurrency = c
---           , esFrom =
---               HalfEntrySet
---                 { hesPrimary =
---                     Entry
---                       { eValue = ()
---                       , eComment = ""
---                       , eAcnt = fa
---                       , eTags = fts
---                       }
---                 , hesOther = []
---                 }
---           , esTo =
---               HalfEntrySet
---                 { hesPrimary =
---                     Entry
---                       { eValue = ()
---                       , eComment = ""
---                       , eAcnt = ta
---                       , eTags = tts
---                       }
---                 , hesOther = []
---                 }
---           }
-
--- type BalancedTransfer = FlatTransfer Rational
-
--- data FlatTransfer v = FlatTransfer
---   { ftFrom :: !TaggedAcnt
---   , ftTo :: !TaggedAcnt
---   , ftValue :: !v
---   , ftWhen :: !Day
---   , ftDesc :: !T.Text
---   , ftMeta :: !BudgetMeta
---   , ftCur :: !TransferCurrency
---   }
---   deriving (Show)
-
-data BudgetMeta = BudgetMeta
-  { bmCommit :: !CommitR
-  , bmName :: !T.Text
-  }
-  deriving (Show)
-
 type IntAllocations =
   ( [DaySpanAllocation PretaxValue]
   , [DaySpanAllocation TaxValue]
@@ -638,8 +498,6 @@ type IntAllocations =
 
 type DaySpanAllocation = Allocation DaySpan
 
-type EntryPair = (KeyEntry, KeyEntry)
-
 type PeriodScaler = Natural -> Double -> Double
 
 data FlatAllocation v = FlatAllocation

lib/Internal/Database.hs

@@ -459,7 +459,7 @@ resolveEntry s@InsertEntry {feEntry = e@Entry {eValue, eTags, eAcnt}, feCurrency
 readUpdates
   :: (MonadInsertError m, MonadSqlQuery m)
   => [Int]
-  -> m [Either ReadEntry UpdateEntrySet]
+  -> m ([ReadEntry], [UpdateEntrySet])
 readUpdates hashes = do
   xs <- selectE $ do
     (commits :& txs :& entries) <-
@@ -482,7 +482,7 @@ readUpdates hashes = do
     liftExcept $
       mapErrors makeUES $
         second (fmap snd) <$> groupWith uGroup toUpdate
-  return $ fmap Left toRead ++ fmap Right toUpdate'
+  return (toRead, toUpdate')
   where
     unpack = fmap (\(_, d, e) -> (E.unValue d, (entityKey e, entityVal e)))
     uGroup (day, (_, e)) = (day, entryRCurrency e, entryRTransaction e)

lib/Internal/History.hs

@@ -1,9 +1,10 @@
 module Internal.History
   ( readHistStmt
   , readHistTransfer
-  , insertHistory
+  , insertAll
   , splitHistory
   , balanceTxs
+  , updateTx
   )
 where
 
@@ -26,21 +27,11 @@ import qualified RIO.Text as T
 import RIO.Time
 import qualified RIO.Vector as V
 
--- readHistory
+-- TODO unify this with the transfer system I use in the budget now
---   :: (MonadInsertError m, MonadFinance m, MonadUnliftIO m)
---   => FilePath
---   -> [History]
---   -> m [(CommitR, [DeferredTx])]
--- readHistory root hs = do
---   let (ts, ss) = splitHistory hs
---   ts' <- catMaybes <$> mapErrorsIO readHistTransfer ts
---   ss' <- catMaybes <$> mapErrorsIO (readHistStmt root) ss
---   return $ ts' ++ ss'
-
 readHistTransfer
   :: (MonadInsertError m, MonadFinance m)
   => HistTransfer
-  -> m [Tx CommitR]
+  -> m (Either CommitR [Tx TxCommit])
 readHistTransfer
   m@Transfer
     { transFrom = from
@@ -48,7 +39,7 @@ readHistTransfer
     , transCurrency = u
     , transAmounts = amts
     } =
-    whenHash0 CTManual m [] $ \c -> do
+    eitherHash CTManual m return $ \c -> do
       bounds <- askDBState kmStatementInterval
       let curRes = lookupCurrency u
       let go Amount {amtWhen, amtValue, amtDesc} = do
@@ -62,11 +53,11 @@ readHistStmt
   :: (MonadUnliftIO m, MonadFinance m)
   => FilePath
   -> Statement
-  -> m (Either CommitR [Tx CommitR])
+  -> m (Either CommitR [Tx TxCommit])
 readHistStmt root i = eitherHash CTImport i return $ \c -> do
   bs <- readImport root i
   bounds <- askDBState kmStatementInterval
-  return $ filter (inDaySpan bounds . txDate) $ fmap (\t -> t {txCommit = c}) bs
+  return $ filter (inDaySpan bounds . txDate) $ fmap (\t -> t {txCommit = HistoryCommit c}) bs
 
 splitHistory :: [History] -> ([HistTransfer], [Statement])
 splitHistory = partitionEithers . fmap go
@@ -74,17 +65,35 @@ splitHistory = partitionEithers . fmap go
     go (HistTransfer x) = Left x
     go (HistStatement x) = Right x
 
-insertHistory
+insertAll
   :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
-  => [EntryBin CommitR]
+  => [EntryBin]
   -> m ()
-insertHistory hs = do
+insertAll ebs = do
-  (toUpdate, toInsert) <- balanceTxs hs
+  (toUpdate, toInsert) <- balanceTxs ebs
   mapM_ updateTx toUpdate
-  forM_ (groupKey commitRHash $ (\x -> (itxCommit x, x)) <$> toInsert) $
+  forM_ (groupWith itxCommit toInsert) $
     \(c, ts) -> do
-      ck <- insert c
+      ck <- insert $ getCommit c
       mapM_ (insertTx ck) ts
+  where
+    getCommit (HistoryCommit c) = c
+    getCommit (BudgetCommit c _) = c
+
+insertTx :: MonadSqlQuery m => CommitRId -> InsertTx -> m ()
+insertTx c InsertTx {itxDate, itxDescr, itxEntries, itxCommit} = do
+  let anyDeferred = any (isJust . feDeferred) itxEntries
+  k <- insert $ TransactionR c itxDate itxDescr anyDeferred
+  mapM_ (go k) itxEntries
+  where
+    go k tx = do
+      ek <- insertEntry k tx
+      case itxCommit of
+        BudgetCommit _ name -> insert_ $ BudgetLabelR ek name
+        _ -> return ()
+
+updateTx :: MonadSqlQuery m => UEBalanced -> m ()
+updateTx UpdateEntry {ueID, ueValue} = update ueID [EntryRValue =. unStaticValue ueValue]
 
 --------------------------------------------------------------------------------
 -- low-level transaction stuff
@@ -98,12 +107,12 @@ txPair
   -> CurrencyPrec
   -> TransferValue
   -> T.Text
-  -> Tx CommitR
+  -> Tx TxCommit
 txPair commit day from to cur (TransferValue t v) desc =
   Tx
     { txDescr = desc
     , txDate = day
-    , txCommit = commit
+    , txCommit = HistoryCommit commit
     , txPrimary =
         EntrySet
           { esTotalValue = EntryValue t $ toRational v
@@ -126,15 +135,6 @@ txPair commit day from to cur (TransferValue t v) desc =
 -- resolveTx t@Tx {txEntries = ss} =
 --   (\kss -> t {txEntries = kss}) <$> mapErrors resolveEntry ss
 
-insertTx :: MonadSqlQuery m => CommitRId -> InsertTx CommitR -> m ()
-insertTx c InsertTx {itxDate = d, itxDescr = e, itxEntries = ss} = do
-  let anyDeferred = any (isJust . feDeferred) ss
-  k <- insert $ TransactionR c d e anyDeferred
-  mapM_ (insertEntry k) ss
-
-updateTx :: MonadSqlQuery m => UEBalanced -> m ()
-updateTx UpdateEntry {ueID, ueValue} = update ueID [EntryRValue =. unStaticValue ueValue]
-
 --------------------------------------------------------------------------------
 -- Statements
 
@@ -349,8 +349,8 @@ matchNonDates ms = go ([], [], initZipper ms)
 
 balanceTxs
   :: (MonadInsertError m, MonadFinance m)
-  => [EntryBin a]
+  => [EntryBin]
-  -> m ([UEBalanced], [InsertTx a])
+  -> m ([UEBalanced], [InsertTx])
 balanceTxs ebs =
   first concat . partitionEithers . catMaybes
     <$> evalStateT (mapErrors go $ L.sortOn binDate ebs) M.empty
@@ -379,7 +379,7 @@ balanceTxs ebs =
       Right (EntryValue t v) -> findBalance eAcnt c t v
       Left v -> return $ toRational v * tot
 
-binDate :: EntryBin a -> Day
+binDate :: EntryBin -> Day
 binDate (ToUpdate UpdateEntrySet {utDate}) = utDate
 binDate (ToRead ReadEntry {reDate}) = reDate
 binDate (ToInsert Tx {txDate}) = txDate

lib/Internal/Types/Database.hs

@@ -20,7 +20,7 @@ share
 CommitR sql=commits
     hash Int
     type ConfigType
-    deriving Show Eq
+    deriving Show Eq Ord
 CurrencyR sql=currencies
     symbol T.Text
     fullname T.Text
@@ -67,7 +67,7 @@ BudgetLabelR sql=budget_labels
 |]
 
 data ConfigType = CTBudget | CTManual | CTImport
-  deriving (Eq, Show, Read, Enum)
+  deriving (Eq, Show, Read, Enum, Ord)
 
 instance PersistFieldSql ConfigType where
   sqlType _ = SqlString

lib/Internal/Types/Main.hs

@@ -121,10 +121,10 @@ data UpdateEntrySet = UpdateEntrySet
   , utTotalValue :: !Rational
   }
 
-data EntryBin a
+data EntryBin
   = ToUpdate UpdateEntrySet
   | ToRead ReadEntry
-  | ToInsert (Tx a)
+  | ToInsert (Tx TxCommit)
 
 data InsertEntry a c t = InsertEntry
   { feCurrency :: !c
@@ -218,6 +218,8 @@ data EntrySet a c t v v' = EntrySet
   , esTo :: !(HalfEntrySet a c t (LinkDeferred v))
   }
 
+data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text deriving (Eq, Ord)
+
 data Tx k = Tx
   { txDescr :: !T.Text
   , txDate :: !Day
@@ -227,11 +229,11 @@ data Tx k = Tx
   }
   deriving (Generic)
 
-data InsertTx a = InsertTx
+data InsertTx = InsertTx
   { itxDescr :: !T.Text
   , itxDate :: !Day
   , itxEntries :: ![InsertEntry AccountRId CurrencyRId TagRId]
-  , itxCommit :: !a
+  , itxCommit :: !TxCommit
   }
   deriving (Generic)