{-# LANGUAGE TemplateHaskell #-}

module BtcLsp.Thread.Expirer
  ( apply,
  )
where

import BtcLsp.Data.Orphan ()
import BtcLsp.Import
import BtcLsp.Import.Psql as Psql
import qualified BtcLsp.Storage.Model.SwapIntoLn as SwapIntoLn

apply :: (Env m) => m ()
apply :: forall (m :: * -> *). Env m => m ()
apply =
  m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    ReaderT SqlBackend m () -> m ()
forall (m :: * -> *) a. Storage m => ReaderT SqlBackend m a -> m a
runSql (ReaderT SqlBackend m () -> m ())
-> ReaderT SqlBackend m () -> m ()
forall a b. (a -> b) -> a -> b
$
      Entity SwapIntoLn -> Key SwapIntoLn
forall record. Entity record -> Key record
entityKey (Entity SwapIntoLn -> Key SwapIntoLn)
-> ReaderT SqlBackend m [Entity SwapIntoLn]
-> ReaderT SqlBackend m [Key SwapIntoLn]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> ReaderT SqlBackend m [Entity SwapIntoLn]
forall (m :: * -> *).
MonadIO m =>
ReaderT SqlBackend m [Entity SwapIntoLn]
SwapIntoLn.getSwapsAboutToExpirySql
        --
        -- NOTE : We need to always sort id list before working
        -- with the row locks to avoid possible deadlocks.
        --
        ReaderT SqlBackend m [Key SwapIntoLn]
-> ([Key SwapIntoLn] -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element [Key SwapIntoLn] -> ReaderT SqlBackend m ())
-> [Key SwapIntoLn] -> ReaderT SqlBackend m ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_ Element [Key SwapIntoLn] -> ReaderT SqlBackend m ()
forall (m :: * -> *).
KatipContext m =>
Key SwapIntoLn -> ReaderT SqlBackend m ()
updateExpiredSwapSql ([Key SwapIntoLn] -> ReaderT SqlBackend m ())
-> ([Key SwapIntoLn] -> [Key SwapIntoLn])
-> [Key SwapIntoLn]
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key SwapIntoLn] -> [Key SwapIntoLn]
forall a. Ord a => [a] -> [a]
sort
    m ()
forall (m :: * -> *). MonadIO m => m ()
sleep300ms

updateExpiredSwapSql ::
  ( KatipContext m
  ) =>
  SwapIntoLnId ->
  ReaderT Psql.SqlBackend m ()
updateExpiredSwapSql :: forall (m :: * -> *).
KatipContext m =>
Key SwapIntoLn -> ReaderT SqlBackend m ()
updateExpiredSwapSql Key SwapIntoLn
rowId = do
  Either (Entity SwapIntoLn) ()
res <-
    Key SwapIntoLn
-> (SwapStatus -> Bool)
-> (SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall (m :: * -> *) a.
MonadIO m =>
Key SwapIntoLn
-> (SwapStatus -> Bool)
-> (SwapIntoLn -> ReaderT SqlBackend m a)
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) a)
SwapIntoLn.withLockedRowSql
      Key SwapIntoLn
rowId
      (Element [SwapStatus] -> [SwapStatus] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [SwapStatus]
swapStatusChain)
      ((SwapIntoLn -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ()))
-> (ReaderT SqlBackend m ()
    -> SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend m () -> SwapIntoLn -> ReaderT SqlBackend m ()
forall a b. a -> b -> a
const
      (ReaderT SqlBackend m ()
 -> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ()))
-> ReaderT SqlBackend m ()
-> ReaderT SqlBackend m (Either (Entity SwapIntoLn) ())
forall a b. (a -> b) -> a -> b
$ Key SwapIntoLn -> ReaderT SqlBackend m ()
forall (m :: * -> *).
(MonadIO m, KatipContext m) =>
Key SwapIntoLn -> ReaderT SqlBackend m ()
SwapIntoLn.updateExpiredSql Key SwapIntoLn
rowId
  Either (Entity SwapIntoLn) ()
-> (Entity SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (l -> f ()) -> f ()
whenLeft Either (Entity SwapIntoLn) ()
res ((Entity SwapIntoLn -> ReaderT SqlBackend m ())
 -> ReaderT SqlBackend m ())
-> (Entity SwapIntoLn -> ReaderT SqlBackend m ())
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$
    $(logTM) Severity
ErrorS
      (LogStr -> ReaderT SqlBackend m ())
-> (Entity SwapIntoLn -> LogStr)
-> Entity SwapIntoLn
-> ReaderT SqlBackend m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall a. StringConv a Text => a -> LogStr
logStr
      (Text -> LogStr)
-> (Entity SwapIntoLn -> Text) -> Entity SwapIntoLn -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Expiry update failed for the swap " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (Text -> Text)
-> (Entity SwapIntoLn -> Text) -> Entity SwapIntoLn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SwapIntoLn -> Text
forall a. Out a => a -> Text
inspect