module BtcLsp.Storage.Model.Block ( createUpdateConfirmedSql, getLatestSql, getBlockByHeightSql, getBlocksHigherSql, updateOrphanHigherSql, withLockedRowSql, ) where import BtcLsp.Import hiding (Storage (..)) import qualified BtcLsp.Import.Psql as Psql import qualified BtcLsp.Storage.Util as Util createUpdateConfirmedSql :: ( MonadIO m ) => BlkHeight -> BlkHash -> ReaderT Psql.SqlBackend m (Entity Block) createUpdateConfirmedSql :: forall (m :: * -> *). MonadIO m => BlkHeight -> BlkHash -> ReaderT SqlBackend m (Entity Block) createUpdateConfirmedSql BlkHeight height BlkHash hash = do UTCTime ct <- ReaderT SqlBackend m UTCTime forall (m :: * -> *). MonadIO m => m UTCTime getCurrentTime Unique Block -> Block -> [SqlExpr (Entity Block) -> SqlExpr Update] -> ReaderT SqlBackend m (Entity Block) forall (m :: * -> *) record. (MonadIO m, PersistEntity record, IsPersistBackend (PersistEntityBackend record)) => Unique record -> record -> [SqlExpr (Entity record) -> SqlExpr Update] -> ReaderT SqlBackend m (Entity record) Psql.upsertBy (BlkHash -> Unique Block UniqueBlock BlkHash hash) Block :: BlkHeight -> BlkHash -> BlkStatus -> UTCTime -> UTCTime -> Block Block { blockHeight :: BlkHeight blockHeight = BlkHeight height, blockHash :: BlkHash blockHash = BlkHash hash, blockStatus :: BlkStatus blockStatus = BlkStatus BlkConfirmed, blockInsertedAt :: UTCTime blockInsertedAt = UTCTime ct, blockUpdatedAt :: UTCTime blockUpdatedAt = UTCTime ct } [ EntityField Block BlkStatus forall typ. (typ ~ BlkStatus) => EntityField Block typ BlockStatus EntityField Block BlkStatus -> SqlExpr (Value BlkStatus) -> SqlExpr (Entity Block) -> SqlExpr Update forall val typ. (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update Psql.=. BlkStatus -> SqlExpr (Value BlkStatus) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkStatus BlkConfirmed, EntityField Block UTCTime forall typ. (typ ~ UTCTime) => EntityField Block typ BlockUpdatedAt EntityField Block UTCTime -> SqlExpr (Value UTCTime) -> SqlExpr (Entity Block) -> SqlExpr Update forall val typ. (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update Psql.=. UTCTime -> SqlExpr (Value UTCTime) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val UTCTime ct ] getLatestSql :: ( MonadIO m ) => ReaderT Psql.SqlBackend m (Maybe (Entity Block)) getLatestSql :: forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m (Maybe (Entity Block)) getLatestSql = do [Entity Block] xs <- SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block] forall a r (m :: * -> *). (SqlSelect a r, MonadIO m) => SqlQuery a -> SqlReadT m [r] Psql.select (SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block]) -> SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block] forall a b. (a -> b) -> a -> b $ (SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block)) forall a b. From a => (a -> SqlQuery b) -> SqlQuery b Psql.from ((SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block))) -> (SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block)) forall a b. (a -> b) -> a -> b $ \SqlExpr (Entity Block) row -> do LockingKind -> SqlQuery () Psql.locking LockingKind Psql.ForUpdate SqlExpr (Value Bool) -> SqlQuery () Psql.where_ (SqlExpr (Value Bool) -> SqlQuery ()) -> SqlExpr (Value Bool) -> SqlQuery () forall a b. (a -> b) -> a -> b $ SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkStatus -> SqlExpr (Value BlkStatus) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkStatus forall typ. (typ ~ BlkStatus) => EntityField Block typ BlockStatus SqlExpr (Value BlkStatus) -> SqlExpr (Value BlkStatus) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.==. BlkStatus -> SqlExpr (Value BlkStatus) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkStatus BlkConfirmed [SqlExpr OrderBy] -> SqlQuery () Psql.orderBy [ SqlExpr (Value BlkHeight) -> SqlExpr OrderBy forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy Psql.desc (SqlExpr (Value BlkHeight) -> SqlExpr OrderBy) -> SqlExpr (Value BlkHeight) -> SqlExpr OrderBy forall a b. (a -> b) -> a -> b $ SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkHeight -> SqlExpr (Value BlkHeight) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkHeight forall typ. (typ ~ BlkHeight) => EntityField Block typ BlockHeight ] Int64 -> SqlQuery () Psql.limit Int64 1 SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block)) forall (f :: * -> *) a. Applicative f => a -> f a pure SqlExpr (Entity Block) row Maybe (Entity Block) -> ReaderT SqlBackend m (Maybe (Entity Block)) forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe (Entity Block) -> ReaderT SqlBackend m (Maybe (Entity Block))) -> Maybe (Entity Block) -> ReaderT SqlBackend m (Maybe (Entity Block)) forall a b. (a -> b) -> a -> b $ [Entity Block] -> Maybe (Entity Block) forall a. [a] -> Maybe a listToMaybe [Entity Block] xs getBlockByHeightSql :: ( MonadIO m ) => BlkHeight -> ReaderT Psql.SqlBackend m [Entity Block] getBlockByHeightSql :: forall (m :: * -> *). MonadIO m => BlkHeight -> ReaderT SqlBackend m [Entity Block] getBlockByHeightSql BlkHeight blkHeight = do SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block] forall a r (m :: * -> *). (SqlSelect a r, MonadIO m) => SqlQuery a -> SqlReadT m [r] Psql.select (SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block]) -> SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block] forall a b. (a -> b) -> a -> b $ (SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block)) forall a b. From a => (a -> SqlQuery b) -> SqlQuery b Psql.from ((SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block))) -> (SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block)) forall a b. (a -> b) -> a -> b $ \SqlExpr (Entity Block) row -> do LockingKind -> SqlQuery () Psql.locking LockingKind Psql.ForUpdate SqlExpr (Value Bool) -> SqlQuery () Psql.where_ (SqlExpr (Value Bool) -> SqlQuery ()) -> SqlExpr (Value Bool) -> SqlQuery () forall a b. (a -> b) -> a -> b $ ( SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkHeight -> SqlExpr (Value BlkHeight) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkHeight forall typ. (typ ~ BlkHeight) => EntityField Block typ BlockHeight SqlExpr (Value BlkHeight) -> SqlExpr (Value BlkHeight) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.==. BlkHeight -> SqlExpr (Value BlkHeight) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkHeight blkHeight ) SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) Psql.&&. ( SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkStatus -> SqlExpr (Value BlkStatus) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkStatus forall typ. (typ ~ BlkStatus) => EntityField Block typ BlockStatus SqlExpr (Value BlkStatus) -> SqlExpr (Value BlkStatus) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.==. BlkStatus -> SqlExpr (Value BlkStatus) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkStatus BlkConfirmed ) SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block)) forall (f :: * -> *) a. Applicative f => a -> f a pure SqlExpr (Entity Block) row getBlocksHigherSql :: ( MonadIO m ) => BlkHeight -> ReaderT Psql.SqlBackend m [Entity Block] getBlocksHigherSql :: forall (m :: * -> *). MonadIO m => BlkHeight -> ReaderT SqlBackend m [Entity Block] getBlocksHigherSql BlkHeight blkHeight = do SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block] forall a r (m :: * -> *). (SqlSelect a r, MonadIO m) => SqlQuery a -> SqlReadT m [r] Psql.select (SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block]) -> SqlQuery (SqlExpr (Entity Block)) -> ReaderT SqlBackend m [Entity Block] forall a b. (a -> b) -> a -> b $ (SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block)) forall a b. From a => (a -> SqlQuery b) -> SqlQuery b Psql.from ((SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block))) -> (SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block))) -> SqlQuery (SqlExpr (Entity Block)) forall a b. (a -> b) -> a -> b $ \SqlExpr (Entity Block) row -> do LockingKind -> SqlQuery () Psql.locking LockingKind Psql.ForUpdate SqlExpr (Value Bool) -> SqlQuery () Psql.where_ (SqlExpr (Value Bool) -> SqlQuery ()) -> SqlExpr (Value Bool) -> SqlQuery () forall a b. (a -> b) -> a -> b $ ( SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkHeight -> SqlExpr (Value BlkHeight) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkHeight forall typ. (typ ~ BlkHeight) => EntityField Block typ BlockHeight SqlExpr (Value BlkHeight) -> SqlExpr (Value BlkHeight) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.>. BlkHeight -> SqlExpr (Value BlkHeight) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkHeight blkHeight ) SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) Psql.&&. ( SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkStatus -> SqlExpr (Value BlkStatus) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkStatus forall typ. (typ ~ BlkStatus) => EntityField Block typ BlockStatus SqlExpr (Value BlkStatus) -> SqlExpr (Value BlkStatus) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.==. BlkStatus -> SqlExpr (Value BlkStatus) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkStatus BlkConfirmed ) SqlExpr (Entity Block) -> SqlQuery (SqlExpr (Entity Block)) forall (f :: * -> *) a. Applicative f => a -> f a pure SqlExpr (Entity Block) row updateOrphanHigherSql :: ( MonadIO m ) => BlkHeight -> ReaderT Psql.SqlBackend m () updateOrphanHigherSql :: forall (m :: * -> *). MonadIO m => BlkHeight -> ReaderT SqlBackend m () updateOrphanHigherSql BlkHeight height = do UTCTime ct <- ReaderT SqlBackend m UTCTime forall (m :: * -> *). MonadIO m => m UTCTime getCurrentTime (SqlExpr (Entity Block) -> SqlQuery ()) -> ReaderT SqlBackend m () forall (m :: * -> *) val. (MonadIO m, PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val)) => (SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m () Psql.update ((SqlExpr (Entity Block) -> SqlQuery ()) -> ReaderT SqlBackend m ()) -> (SqlExpr (Entity Block) -> SqlQuery ()) -> ReaderT SqlBackend m () forall a b. (a -> b) -> a -> b $ \SqlExpr (Entity Block) row -> do SqlExpr (Entity Block) -> [SqlExpr (Entity Block) -> SqlExpr Update] -> SqlQuery () forall val. PersistEntity val => SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery () Psql.set SqlExpr (Entity Block) row [ EntityField Block BlkStatus forall typ. (typ ~ BlkStatus) => EntityField Block typ BlockStatus EntityField Block BlkStatus -> SqlExpr (Value BlkStatus) -> SqlExpr (Entity Block) -> SqlExpr Update forall val typ. (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update Psql.=. BlkStatus -> SqlExpr (Value BlkStatus) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkStatus BlkOrphan, EntityField Block UTCTime forall typ. (typ ~ UTCTime) => EntityField Block typ BlockUpdatedAt EntityField Block UTCTime -> SqlExpr (Value UTCTime) -> SqlExpr (Entity Block) -> SqlExpr Update forall val typ. (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update Psql.=. UTCTime -> SqlExpr (Value UTCTime) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val UTCTime ct ] SqlExpr (Value Bool) -> SqlQuery () Psql.where_ (SqlExpr (Value Bool) -> SqlQuery ()) -> SqlExpr (Value Bool) -> SqlQuery () forall a b. (a -> b) -> a -> b $ ( SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkHeight -> SqlExpr (Value BlkHeight) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkHeight forall typ. (typ ~ BlkHeight) => EntityField Block typ BlockHeight SqlExpr (Value BlkHeight) -> SqlExpr (Value BlkHeight) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.>. BlkHeight -> SqlExpr (Value BlkHeight) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkHeight height ) SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) Psql.&&. ( SqlExpr (Entity Block) row SqlExpr (Entity Block) -> EntityField Block BlkStatus -> SqlExpr (Value BlkStatus) forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) Psql.^. EntityField Block BlkStatus forall typ. (typ ~ BlkStatus) => EntityField Block typ BlockStatus SqlExpr (Value BlkStatus) -> SqlExpr (Value BlkStatus) -> SqlExpr (Value Bool) forall typ. PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) Psql.==. BlkStatus -> SqlExpr (Value BlkStatus) forall typ. PersistField typ => typ -> SqlExpr (Value typ) Psql.val BlkStatus BlkConfirmed ) withLockedRowSql :: ( MonadIO m ) => BlockId -> (BlkStatus -> Bool) -> (Block -> ReaderT Psql.SqlBackend m a) -> ReaderT Psql.SqlBackend m (Either (Entity Block) a) withLockedRowSql :: forall (m :: * -> *) a. MonadIO m => BlockId -> (BlkStatus -> Bool) -> (Block -> ReaderT SqlBackend m a) -> ReaderT SqlBackend m (Either (Entity Block) a) withLockedRowSql BlockId rowId BlkStatus -> Bool pre Block -> ReaderT SqlBackend m a action = do Block rowVal <- BlockId -> SqlPersistT m Block forall (m :: * -> *) a. (MonadIO m, HasTable a, ToBackendKey SqlBackend a) => Key a -> SqlPersistT m a Util.lockByRow BlockId rowId if BlkStatus -> Bool pre (BlkStatus -> Bool) -> BlkStatus -> Bool forall a b. (a -> b) -> a -> b $ Block -> BlkStatus blockStatus Block rowVal then a -> Either (Entity Block) a forall a b. b -> Either a b Right (a -> Either (Entity Block) a) -> ReaderT SqlBackend m a -> ReaderT SqlBackend m (Either (Entity Block) a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Block -> ReaderT SqlBackend m a action Block rowVal else Either (Entity Block) a -> ReaderT SqlBackend m (Either (Entity Block) a) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either (Entity Block) a -> ReaderT SqlBackend m (Either (Entity Block) a)) -> (Entity Block -> Either (Entity Block) a) -> Entity Block -> ReaderT SqlBackend m (Either (Entity Block) a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Entity Block -> Either (Entity Block) a forall a b. a -> Either a b Left (Entity Block -> ReaderT SqlBackend m (Either (Entity Block) a)) -> Entity Block -> ReaderT SqlBackend m (Either (Entity Block) a) forall a b. (a -> b) -> a -> b $ BlockId -> Block -> Entity Block forall record. Key record -> record -> Entity record Entity BlockId rowId Block rowVal