module BtcLsp.Storage.Util
  ( lockByTable,
    lockByRow,
    lockByUnique,
  )
where

import BtcLsp.Class.Storage
import BtcLsp.Data.Kind
import BtcLsp.Import.External
import qualified BtcLsp.Import.Psql as Psql
import qualified Database.Esqueleto.Legacy as Esqueleto
import qualified Universum

-- | This ugly fake type is here just to
-- make Haskell type system compatible
-- with weird Postgres semantics
-- for pg_advisory_xact_lock
data VoidSQL
  = VoidSQL

instance Psql.RawSql VoidSQL where
  rawSqlCols :: (Text -> Text) -> VoidSQL -> (Int, [Text])
rawSqlCols Text -> Text
_ VoidSQL
_ = (Int
1, [])
  rawSqlColCountReason :: VoidSQL -> String
rawSqlColCountReason VoidSQL
_ = String
""
  rawSqlProcessRow :: [PersistValue] -> Either Text VoidSQL
rawSqlProcessRow [PersistValue
Psql.PersistNull] = VoidSQL -> Either Text VoidSQL
forall a b. b -> Either a b
Right VoidSQL
VoidSQL
  rawSqlProcessRow [PersistValue]
_ = Text -> Either Text VoidSQL
forall a b. a -> Either a b
Left Text
"Unexpected VoidSQL expr"

lockByTable :: (MonadIO m) => Table -> Psql.SqlPersistT m ()
lockByTable :: forall (m :: * -> *). MonadIO m => Table -> SqlPersistT m ()
lockByTable Table
x =
  ReaderT SqlBackend m [VoidSQL] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    ( Text -> [PersistValue] -> ReaderT SqlBackend m [VoidSQL]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
Psql.rawSql
        Text
"SELECT pg_advisory_xact_lock(?)"
        [Int64 -> PersistValue
Psql.PersistInt64 (Int64 -> PersistValue) -> (Int -> Int64) -> Int -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (Int -> PersistValue) -> Int -> PersistValue
forall a b. (a -> b) -> a -> b
$ Table -> Int
forall a. Enum a => a -> Int
fromEnum Table
x] ::
        (MonadIO m) => Psql.SqlPersistT m [VoidSQL]
    )

lockByRow ::
  ( MonadIO m,
    HasTable a,
    Psql.ToBackendKey Psql.SqlBackend a
  ) =>
  Psql.Key a ->
  Psql.SqlPersistT m a
lockByRow :: forall (m :: * -> *) a.
(MonadIO m, HasTable a, ToBackendKey SqlBackend a) =>
Key a -> SqlPersistT m a
lockByRow Key a
rowId = do
  ReaderT SqlBackend m [VoidSQL] -> ReaderT SqlBackend m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    ( Text -> [PersistValue] -> ReaderT SqlBackend m [VoidSQL]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
Psql.rawSql
        Text
"SELECT pg_advisory_xact_lock(?,?)"
        [ Int64 -> PersistValue
Psql.PersistInt64 (Int64 -> PersistValue)
-> (Table -> Int64) -> Table -> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall source target.
(From source target, 'False ~ (source == target)) =>
source -> target
from (Int -> Int64) -> (Table -> Int) -> Table -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> Int
forall a. Enum a => a -> Int
fromEnum (Table -> PersistValue) -> Table -> PersistValue
forall a b. (a -> b) -> a -> b
$ Key a -> Table
forall a. HasTable a => Key a -> Table
getTable Key a
rowId,
          Int64 -> PersistValue
Psql.PersistInt64 (Int64 -> PersistValue) -> Int64 -> PersistValue
forall a b. (a -> b) -> a -> b
$ Key a -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
Psql.fromSqlKey Key a
rowId
        ] ::
        (MonadIO m) => Psql.SqlPersistT m [VoidSQL]
    )
  SqlPersistT m a
-> (a -> SqlPersistT m a)
-> ReaderT SqlBackend m (Maybe a)
-> SqlPersistT m a
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM
    (Text -> SqlPersistT m a
forall a. HasCallStack => Text -> a
error (Text -> SqlPersistT m a) -> Text -> SqlPersistT m a
forall a b. (a -> b) -> a -> b
$ Text
"Impossible missing row " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key a -> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show Key a
rowId)
    a -> SqlPersistT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ReaderT SqlBackend m (Maybe a) -> SqlPersistT m a)
-> (ReaderT SqlBackend m [Entity a]
    -> ReaderT SqlBackend m (Maybe a))
-> ReaderT SqlBackend m [Entity a]
-> SqlPersistT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity a -> a
forall record. Entity record -> record
entityVal (Entity a -> a)
-> ReaderT SqlBackend m (Maybe (Entity a))
-> ReaderT SqlBackend m (Maybe a)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>>)
    (ReaderT SqlBackend m (Maybe (Entity a))
 -> ReaderT SqlBackend m (Maybe a))
-> (ReaderT SqlBackend m [Entity a]
    -> ReaderT SqlBackend m (Maybe (Entity a)))
-> ReaderT SqlBackend m [Entity a]
-> ReaderT SqlBackend m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Entity a] -> Maybe (Entity a)
forall a. [a] -> Maybe a
listToMaybe ([Entity a] -> Maybe (Entity a))
-> ReaderT SqlBackend m [Entity a]
-> ReaderT SqlBackend m (Maybe (Entity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    (ReaderT SqlBackend m [Entity a] -> SqlPersistT m a)
-> ReaderT SqlBackend m [Entity a] -> SqlPersistT m a
forall a b. (a -> b) -> a -> b
$ SqlQuery (SqlExpr (Entity a)) -> ReaderT SqlBackend m [Entity a]
forall a r (m :: * -> *).
(SqlSelect a r, MonadIO m) =>
SqlQuery a -> SqlReadT m [r]
Psql.select (SqlQuery (SqlExpr (Entity a)) -> ReaderT SqlBackend m [Entity a])
-> SqlQuery (SqlExpr (Entity a)) -> ReaderT SqlBackend m [Entity a]
forall a b. (a -> b) -> a -> b
$
      (SqlExpr (Entity a) -> SqlQuery (SqlExpr (Entity a)))
-> SqlQuery (SqlExpr (Entity a))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
Psql.from ((SqlExpr (Entity a) -> SqlQuery (SqlExpr (Entity a)))
 -> SqlQuery (SqlExpr (Entity a)))
-> (SqlExpr (Entity a) -> SqlQuery (SqlExpr (Entity a)))
-> SqlQuery (SqlExpr (Entity a))
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity a)
row -> do
        LockingKind -> SqlQuery ()
Psql.locking LockingKind
Psql.ForUpdate
        SqlExpr (Value Bool) -> SqlQuery ()
Psql.where_
          ( SqlExpr (Entity a)
row SqlExpr (Entity a)
-> EntityField a (Key a) -> SqlExpr (Value (Key a))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
Psql.^. EntityField a (Key a)
forall record.
PersistEntity record =>
EntityField record (Key record)
Psql.persistIdField
              SqlExpr (Value (Key a))
-> SqlExpr (Value (Key a)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
Psql.==. Key a -> SqlExpr (Value (Key a))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
Psql.val Key a
rowId
          )
        SqlExpr (Entity a) -> SqlQuery (SqlExpr (Entity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Entity a)
row

lockByUnique ::
  ( MonadIO m,
    HasTable a,
    Psql.ToBackendKey Psql.SqlBackend a
  ) =>
  Psql.Unique a ->
  Psql.SqlPersistT m (Maybe (Entity a))
lockByUnique :: forall (m :: * -> *) a.
(MonadIO m, HasTable a, ToBackendKey SqlBackend a) =>
Unique a -> SqlPersistT m (Maybe (Entity a))
lockByUnique =
  ReaderT SqlBackend m (Maybe (Entity a))
-> (Entity a -> ReaderT SqlBackend m (Maybe (Entity a)))
-> ReaderT SqlBackend m (Maybe (Entity a))
-> ReaderT SqlBackend m (Maybe (Entity a))
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM
    (Maybe (Entity a) -> ReaderT SqlBackend m (Maybe (Entity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entity a)
forall a. Maybe a
Nothing)
    (\(Entity Key a
x a
_) -> Entity a -> Maybe (Entity a)
forall a. a -> Maybe a
Just (Entity a -> Maybe (Entity a))
-> (a -> Entity a) -> a -> Maybe (Entity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> a -> Entity a
forall record. Key record -> record -> Entity record
Entity Key a
x (a -> Maybe (Entity a))
-> ReaderT SqlBackend m a
-> ReaderT SqlBackend m (Maybe (Entity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key a -> ReaderT SqlBackend m a
forall (m :: * -> *) a.
(MonadIO m, HasTable a, ToBackendKey SqlBackend a) =>
Key a -> SqlPersistT m a
lockByRow Key a
x)
    (ReaderT SqlBackend m (Maybe (Entity a))
 -> ReaderT SqlBackend m (Maybe (Entity a)))
-> (Unique a -> ReaderT SqlBackend m (Maybe (Entity a)))
-> Unique a
-> ReaderT SqlBackend m (Maybe (Entity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique a -> ReaderT SqlBackend m (Maybe (Entity a))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
Esqueleto.getBy