{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

module Haskoin.Store.Cache
  ( CacheConfig (..),
    CacheMetrics,
    CacheT,
    CacheError (..),
    newCacheMetrics,
    withCache,
    connectRedis,
    blockRefScore,
    scoreBlockRef,
    CacheWriter,
    CacheWriterInbox,
    cacheNewBlock,
    cacheNewTx,
    cacheWriter,
    cacheDelXPubs,
    isInCache,
  )
where

import Control.DeepSeq (NFData)
import Control.Monad (forM, forM_, forever, guard, unless, void, when, (>=>))
import Control.Monad.Logger
  ( MonadLoggerIO,
    logDebugS,
    logErrorS,
    logInfoS,
    logWarnS,
  )
import Control.Monad.Reader (ReaderT (..), ask, asks)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Bits (complement, shift, (.&.), (.|.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Default (def)
import Data.Either (fromRight, isRight, rights)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import qualified Data.IntMap.Strict as I
import Data.List (sort)
import qualified Data.Map.Strict as Map
import Data.Maybe
  ( catMaybes,
    fromMaybe,
    isJust,
    isNothing,
    mapMaybe,
  )
import Data.Serialize (Serialize, decode, encode)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Time.Clock (NominalDiffTime, diffUTCTime)
import Data.Time.Clock.System
  ( getSystemTime,
    systemSeconds,
    systemToUTCTime,
  )
import Data.Word (Word32, Word64)
import Database.Redis
  ( Connection,
    Redis,
    RedisCtx,
    Reply,
    checkedConnect,
    defaultConnectInfo,
    hgetall,
    parseConnectInfo,
    zadd,
    zrangeWithscores,
    zrangebyscoreWithscoresLimit,
    zrem,
  )
import qualified Database.Redis as Redis
import GHC.Generics (Generic)
import Haskoin
  ( Address,
    BlockHash,
    BlockHeader (..),
    BlockNode (..),
    DerivPathI (..),
    KeyIndex,
    OutPoint (..),
    Tx (..),
    TxHash,
    TxIn (..),
    TxOut (..),
    XPubKey,
    blockHashToHex,
    derivePubPath,
    eitherToMaybe,
    headerHash,
    pathToList,
    scriptToAddressBS,
    txHash,
    txHashToHex,
    xPubAddr,
    xPubCompatWitnessAddr,
    xPubExport,
    xPubWitnessAddr,
  )
import Haskoin.Node
  ( Chain,
    chainBlockMain,
    chainGetAncestor,
    chainGetBest,
    chainGetBlock,
  )
import Haskoin.Store.Common
import Haskoin.Store.Data
import Haskoin.Store.Stats
import NQE
  ( Inbox,
    Listen,
    Mailbox,
    inboxToMailbox,
    query,
    receive,
    send,
  )
import qualified System.Metrics as Metrics
import qualified System.Metrics.Counter as Metrics (Counter)
import qualified System.Metrics.Counter as Metrics.Counter
import qualified System.Metrics.Distribution as Metrics (Distribution)
import qualified System.Metrics.Distribution as Metrics.Distribution
import qualified System.Metrics.Gauge as Metrics (Gauge)
import qualified System.Metrics.Gauge as Metrics.Gauge
import System.Random (randomIO, randomRIO)
import UnliftIO
  ( Exception,
    MonadIO,
    MonadUnliftIO,
    TQueue,
    TVar,
    async,
    atomically,
    bracket,
    liftIO,
    link,
    modifyTVar,
    newTVarIO,
    readTQueue,
    readTVar,
    throwIO,
    wait,
    withAsync,
    writeTQueue,
    writeTVar,
  )
import UnliftIO.Concurrent (threadDelay)

runRedis :: MonadLoggerIO m => Redis (Either Reply a) -> CacheX m a
runRedis :: Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply a)
action =
  (CacheConfig -> Connection) -> ReaderT CacheConfig m Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Connection
cacheConn ReaderT CacheConfig m Connection
-> (Connection -> CacheX m a) -> CacheX m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Connection
conn ->
    IO (Either Reply a) -> ReaderT CacheConfig m (Either Reply a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> Redis (Either Reply a) -> IO (Either Reply a)
forall a. Connection -> Redis a -> IO a
Redis.runRedis Connection
conn Redis (Either Reply a)
action) ReaderT CacheConfig m (Either Reply a)
-> (Either Reply a -> CacheX m a) -> CacheX m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right a
x -> a -> CacheX m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      Left Reply
e -> do
        $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logErrorS) LogSource
"Cache" (LogSource -> ReaderT CacheConfig m ())
-> LogSource -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Got error from Redis: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Reply -> String
forall a. Show a => a -> String
show Reply
e)
        CacheError -> CacheX m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Reply -> CacheError
RedisError Reply
e)

data CacheConfig = CacheConfig
  { CacheConfig -> Connection
cacheConn :: !Connection,
    CacheConfig -> Int
cacheMin :: !Int,
    CacheConfig -> Integer
cacheMax :: !Integer,
    CacheConfig -> Chain
cacheChain :: !Chain,
    CacheConfig -> Int
cacheRetryDelay :: !Int, -- microseconds
    CacheConfig -> Maybe CacheMetrics
cacheMetrics :: !(Maybe CacheMetrics)
  }

data CacheMetrics = CacheMetrics
  { CacheMetrics -> Counter
cacheHits :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheMisses :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheLockAcquired :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheLockReleased :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheLockFailed :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheXPubBals :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheXPubUnspents :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheXPubTxs :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheXPubTxCount :: !Metrics.Counter,
    CacheMetrics -> StatDist
cacheIndexTime :: !StatDist
  }

newCacheMetrics :: MonadIO m => Metrics.Store -> m CacheMetrics
newCacheMetrics :: Store -> m CacheMetrics
newCacheMetrics Store
s = IO CacheMetrics -> m CacheMetrics
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CacheMetrics -> m CacheMetrics)
-> IO CacheMetrics -> m CacheMetrics
forall a b. (a -> b) -> a -> b
$ do
  Counter
cacheHits <- LogSource -> IO Counter
c LogSource
"cache.hits"
  Counter
cacheMisses <- LogSource -> IO Counter
c LogSource
"cache.misses"
  Counter
cacheLockAcquired <- LogSource -> IO Counter
c LogSource
"cache.lock_acquired"
  Counter
cacheLockReleased <- LogSource -> IO Counter
c LogSource
"cache.lock_released"
  Counter
cacheLockFailed <- LogSource -> IO Counter
c LogSource
"cache.lock_failed"
  StatDist
cacheIndexTime <- LogSource -> IO StatDist
forall (m :: * -> *). MonadIO m => LogSource -> m StatDist
d LogSource
"cache.index"
  Counter
cacheXPubBals <- LogSource -> IO Counter
c LogSource
"cache.xpub_balances_cached"
  Counter
cacheXPubUnspents <- LogSource -> IO Counter
c LogSource
"cache.xpub_unspents_cached"
  Counter
cacheXPubTxs <- LogSource -> IO Counter
c LogSource
"cache.xpub_txs_cached"
  Counter
cacheXPubTxCount <- LogSource -> IO Counter
c LogSource
"cache.xpub_tx_count_cached"
  return CacheMetrics :: Counter
-> Counter
-> Counter
-> Counter
-> Counter
-> Counter
-> Counter
-> Counter
-> Counter
-> StatDist
-> CacheMetrics
CacheMetrics {Counter
StatDist
cacheXPubTxCount :: Counter
cacheXPubTxs :: Counter
cacheXPubUnspents :: Counter
cacheXPubBals :: Counter
cacheIndexTime :: StatDist
cacheLockFailed :: Counter
cacheLockReleased :: Counter
cacheLockAcquired :: Counter
cacheMisses :: Counter
cacheHits :: Counter
cacheIndexTime :: StatDist
cacheXPubTxCount :: Counter
cacheXPubTxs :: Counter
cacheXPubUnspents :: Counter
cacheXPubBals :: Counter
cacheLockFailed :: Counter
cacheLockReleased :: Counter
cacheLockAcquired :: Counter
cacheMisses :: Counter
cacheHits :: Counter
..}
  where
    c :: LogSource -> IO Counter
c LogSource
x = LogSource -> Store -> IO Counter
Metrics.createCounter LogSource
x Store
s
    d :: LogSource -> m StatDist
d LogSource
x = LogSource -> Store -> m StatDist
forall (m :: * -> *). MonadIO m => LogSource -> Store -> m StatDist
createStatDist LogSource
x Store
s

withMetrics ::
  MonadUnliftIO m =>
  (CacheMetrics -> StatDist) ->
  CacheX m a ->
  CacheX m a
withMetrics :: (CacheMetrics -> StatDist) -> CacheX m a -> CacheX m a
withMetrics CacheMetrics -> StatDist
df CacheX m a
go =
  (CacheConfig -> Maybe CacheMetrics)
-> ReaderT CacheConfig m (Maybe CacheMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Maybe CacheMetrics
cacheMetrics ReaderT CacheConfig m (Maybe CacheMetrics)
-> (Maybe CacheMetrics -> CacheX m a) -> CacheX m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe CacheMetrics
Nothing -> CacheX m a
go
    Just CacheMetrics
m ->
      ReaderT CacheConfig m UTCTime
-> (UTCTime -> ReaderT CacheConfig m ())
-> (UTCTime -> CacheX m a)
-> CacheX m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime)
-> ReaderT CacheConfig m SystemTime
-> ReaderT CacheConfig m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> ReaderT CacheConfig m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime)
        (CacheMetrics -> UTCTime -> ReaderT CacheConfig m ()
forall (m :: * -> *). MonadIO m => CacheMetrics -> UTCTime -> m ()
end CacheMetrics
m)
        (CacheX m a -> UTCTime -> CacheX m a
forall a b. a -> b -> a
const CacheX m a
go)
  where
    end :: CacheMetrics -> UTCTime -> m ()
end CacheMetrics
metrics UTCTime
t1 = do
      UTCTime
t2 <- SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> m SystemTime -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
      let diff :: Int64
diff = NominalDiffTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> Int64) -> NominalDiffTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t2 UTCTime
t1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000
      CacheMetrics -> StatDist
df CacheMetrics
metrics StatDist -> Int64 -> m ()
forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
`addStatTime` Int64
diff
      StatDist -> m ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addStatQuery (CacheMetrics -> StatDist
df CacheMetrics
metrics)

incrementCounter ::
  MonadIO m =>
  (CacheMetrics -> Metrics.Counter) ->
  Int ->
  CacheX m ()
incrementCounter :: (CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
f Int
i =
  (CacheConfig -> Maybe CacheMetrics)
-> ReaderT CacheConfig m (Maybe CacheMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Maybe CacheMetrics
cacheMetrics ReaderT CacheConfig m (Maybe CacheMetrics)
-> (Maybe CacheMetrics -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just CacheMetrics
s -> IO () -> CacheX m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CacheX m ()) -> IO () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Counter -> Int64 -> IO ()
Metrics.Counter.add (CacheMetrics -> Counter
f CacheMetrics
s) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    Maybe CacheMetrics
Nothing -> () -> CacheX m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

type CacheT = ReaderT (Maybe CacheConfig)

type CacheX = ReaderT CacheConfig

data CacheError
  = RedisError Reply
  | RedisTxError !String
  | LogicError !String
  deriving (Int -> CacheError -> ShowS
[CacheError] -> ShowS
CacheError -> String
(Int -> CacheError -> ShowS)
-> (CacheError -> String)
-> ([CacheError] -> ShowS)
-> Show CacheError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheError] -> ShowS
$cshowList :: [CacheError] -> ShowS
show :: CacheError -> String
$cshow :: CacheError -> String
showsPrec :: Int -> CacheError -> ShowS
$cshowsPrec :: Int -> CacheError -> ShowS
Show, CacheError -> CacheError -> Bool
(CacheError -> CacheError -> Bool)
-> (CacheError -> CacheError -> Bool) -> Eq CacheError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheError -> CacheError -> Bool
$c/= :: CacheError -> CacheError -> Bool
== :: CacheError -> CacheError -> Bool
$c== :: CacheError -> CacheError -> Bool
Eq, (forall x. CacheError -> Rep CacheError x)
-> (forall x. Rep CacheError x -> CacheError) -> Generic CacheError
forall x. Rep CacheError x -> CacheError
forall x. CacheError -> Rep CacheError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CacheError x -> CacheError
$cfrom :: forall x. CacheError -> Rep CacheError x
Generic, CacheError -> ()
(CacheError -> ()) -> NFData CacheError
forall a. (a -> ()) -> NFData a
rnf :: CacheError -> ()
$crnf :: CacheError -> ()
NFData, Show CacheError
Typeable CacheError
Typeable CacheError
-> Show CacheError
-> (CacheError -> SomeException)
-> (SomeException -> Maybe CacheError)
-> (CacheError -> String)
-> Exception CacheError
SomeException -> Maybe CacheError
CacheError -> String
CacheError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: CacheError -> String
$cdisplayException :: CacheError -> String
fromException :: SomeException -> Maybe CacheError
$cfromException :: SomeException -> Maybe CacheError
toException :: CacheError -> SomeException
$ctoException :: CacheError -> SomeException
$cp2Exception :: Show CacheError
$cp1Exception :: Typeable CacheError
Exception)

connectRedis :: MonadIO m => String -> m Connection
connectRedis :: String -> m Connection
connectRedis String
redisurl = do
  ConnectInfo
conninfo <-
    if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
redisurl
      then ConnectInfo -> m ConnectInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectInfo
defaultConnectInfo
      else case String -> Either String ConnectInfo
parseConnectInfo String
redisurl of
        Left String
e -> String -> m ConnectInfo
forall a. HasCallStack => String -> a
error String
e
        Right ConnectInfo
r -> ConnectInfo -> m ConnectInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectInfo
r
  IO Connection -> m Connection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ConnectInfo -> IO Connection
checkedConnect ConnectInfo
conninfo)

instance
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  StoreReadBase (CacheT m)
  where
  getNetwork :: CacheT m Network
getNetwork = m Network -> CacheT m Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  getBestBlock :: CacheT m (Maybe BlockHash)
getBestBlock = m (Maybe BlockHash) -> CacheT m (Maybe BlockHash)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
  getBlocksAtHeight :: BlockHeight -> CacheT m [BlockHash]
getBlocksAtHeight = m [BlockHash] -> CacheT m [BlockHash]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [BlockHash] -> CacheT m [BlockHash])
-> (BlockHeight -> m [BlockHash])
-> BlockHeight
-> CacheT m [BlockHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeight -> m [BlockHash]
forall (m :: * -> *).
StoreReadBase m =>
BlockHeight -> m [BlockHash]
getBlocksAtHeight
  getBlock :: BlockHash -> CacheT m (Maybe BlockData)
getBlock = m (Maybe BlockData) -> CacheT m (Maybe BlockData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe BlockData) -> CacheT m (Maybe BlockData))
-> (BlockHash -> m (Maybe BlockData))
-> BlockHash
-> CacheT m (Maybe BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
  getTxData :: TxHash -> CacheT m (Maybe TxData)
getTxData = m (Maybe TxData) -> CacheT m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TxData) -> CacheT m (Maybe TxData))
-> (TxHash -> m (Maybe TxData))
-> TxHash
-> CacheT m (Maybe TxData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData
  getSpender :: OutPoint -> CacheT m (Maybe Spender)
getSpender = m (Maybe Spender) -> CacheT m (Maybe Spender)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Spender) -> CacheT m (Maybe Spender))
-> (OutPoint -> m (Maybe Spender))
-> OutPoint
-> CacheT m (Maybe Spender)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> m (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender
  getBalance :: Address -> CacheT m (Maybe Balance)
getBalance = m (Maybe Balance) -> CacheT m (Maybe Balance)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Balance) -> CacheT m (Maybe Balance))
-> (Address -> m (Maybe Balance))
-> Address
-> CacheT m (Maybe Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance
  getUnspent :: OutPoint -> CacheT m (Maybe Unspent)
getUnspent = m (Maybe Unspent) -> CacheT m (Maybe Unspent)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Unspent) -> CacheT m (Maybe Unspent))
-> (OutPoint -> m (Maybe Unspent))
-> OutPoint
-> CacheT m (Maybe Unspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent
  getMempool :: CacheT m [(UnixTime, TxHash)]
getMempool = m [(UnixTime, TxHash)] -> CacheT m [(UnixTime, TxHash)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(UnixTime, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)]
getMempool

instance
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  StoreReadExtra (CacheT m)
  where
  getBalances :: [Address] -> CacheT m [Balance]
getBalances = m [Balance] -> CacheT m [Balance]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Balance] -> CacheT m [Balance])
-> ([Address] -> m [Balance]) -> [Address] -> CacheT m [Balance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances
  getAddressesTxs :: [Address] -> Limits -> CacheT m [TxRef]
getAddressesTxs [Address]
addrs = m [TxRef] -> CacheT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> CacheT m [TxRef])
-> (Limits -> m [TxRef]) -> Limits -> CacheT m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs
  getAddressTxs :: Address -> Limits -> CacheT m [TxRef]
getAddressTxs Address
addr = m [TxRef] -> CacheT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> CacheT m [TxRef])
-> (Limits -> m [TxRef]) -> Limits -> CacheT m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr
  getAddressUnspents :: Address -> Limits -> CacheT m [Unspent]
getAddressUnspents Address
addr = m [Unspent] -> CacheT m [Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Unspent] -> CacheT m [Unspent])
-> (Limits -> m [Unspent]) -> Limits -> CacheT m [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
addr
  getAddressesUnspents :: [Address] -> Limits -> CacheT m [Unspent]
getAddressesUnspents [Address]
addrs = m [Unspent] -> CacheT m [Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Unspent] -> CacheT m [Unspent])
-> (Limits -> m [Unspent]) -> Limits -> CacheT m [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
addrs
  getMaxGap :: CacheT m BlockHeight
getMaxGap = m BlockHeight -> CacheT m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getMaxGap
  getInitialGap :: CacheT m BlockHeight
getInitialGap = m BlockHeight -> CacheT m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getInitialGap
  getNumTxData :: UnixTime -> CacheT m [TxData]
getNumTxData = m [TxData] -> CacheT m [TxData]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxData] -> CacheT m [TxData])
-> (UnixTime -> m [TxData]) -> UnixTime -> CacheT m [TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnixTime -> m [TxData]
forall (m :: * -> *). StoreReadExtra m => UnixTime -> m [TxData]
getNumTxData
  xPubBals :: XPubSpec -> CacheT m [XPubBal]
xPubBals XPubSpec
xpub =
    ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
-> (Maybe CacheConfig -> CacheT m [XPubBal]) -> CacheT m [XPubBal]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m [XPubBal] -> CacheT m [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubBal] -> CacheT m [XPubBal])
-> m [XPubBal] -> CacheT m [XPubBal]
forall a b. (a -> b) -> a -> b
$
          XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      Just CacheConfig
cfg ->
        m [XPubBal] -> CacheT m [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubBal] -> CacheT m [XPubBal])
-> m [XPubBal] -> CacheT m [XPubBal]
forall a b. (a -> b) -> a -> b
$
          ReaderT CacheConfig m [XPubBal] -> CacheConfig -> m [XPubBal]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (XPubSpec -> ReaderT CacheConfig m [XPubBal]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m [XPubBal]
getXPubBalances XPubSpec
xpub) CacheConfig
cfg
  xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> CacheT m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits =
    ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
-> (Maybe CacheConfig -> CacheT m [XPubUnspent])
-> CacheT m [XPubUnspent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m [XPubUnspent] -> CacheT m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubUnspent] -> CacheT m [XPubUnspent])
-> m [XPubUnspent] -> CacheT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$
          XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits
      Just CacheConfig
cfg ->
        m [XPubUnspent] -> CacheT m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubUnspent] -> CacheT m [XPubUnspent])
-> m [XPubUnspent] -> CacheT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$
          ReaderT CacheConfig m [XPubUnspent]
-> CacheConfig -> m [XPubUnspent]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (XPubSpec
-> [XPubBal] -> Limits -> ReaderT CacheConfig m [XPubUnspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> Limits -> CacheX m [XPubUnspent]
getXPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits) CacheConfig
cfg
  xPubTxs :: XPubSpec -> [XPubBal] -> Limits -> CacheT m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits =
    ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
-> (Maybe CacheConfig -> CacheT m [TxRef]) -> CacheT m [TxRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m [TxRef] -> CacheT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> CacheT m [TxRef]) -> m [TxRef] -> CacheT m [TxRef]
forall a b. (a -> b) -> a -> b
$
          XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits
      Just CacheConfig
cfg ->
        m [TxRef] -> CacheT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> CacheT m [TxRef]) -> m [TxRef] -> CacheT m [TxRef]
forall a b. (a -> b) -> a -> b
$
          ReaderT CacheConfig m [TxRef] -> CacheConfig -> m [TxRef]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (XPubSpec -> [XPubBal] -> Limits -> ReaderT CacheConfig m [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> Limits -> CacheX m [TxRef]
getXPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits) CacheConfig
cfg
  xPubTxCount :: XPubSpec -> [XPubBal] -> CacheT m BlockHeight
xPubTxCount XPubSpec
xpub [XPubBal]
xbals =
    ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
-> (Maybe CacheConfig -> CacheT m BlockHeight)
-> CacheT m BlockHeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m BlockHeight -> CacheT m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m BlockHeight -> CacheT m BlockHeight)
-> m BlockHeight -> CacheT m BlockHeight
forall a b. (a -> b) -> a -> b
$
          XPubSpec -> [XPubBal] -> m BlockHeight
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m BlockHeight
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
      Just CacheConfig
cfg ->
        m BlockHeight -> CacheT m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m BlockHeight -> CacheT m BlockHeight)
-> m BlockHeight -> CacheT m BlockHeight
forall a b. (a -> b) -> a -> b
$
          ReaderT CacheConfig m BlockHeight -> CacheConfig -> m BlockHeight
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (XPubSpec -> [XPubBal] -> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m BlockHeight
getXPubTxCount XPubSpec
xpub [XPubBal]
xbals) CacheConfig
cfg

withCache :: StoreReadBase m => Maybe CacheConfig -> CacheT m a -> m a
withCache :: Maybe CacheConfig -> CacheT m a -> m a
withCache Maybe CacheConfig
s CacheT m a
f = CacheT m a -> Maybe CacheConfig -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CacheT m a
f Maybe CacheConfig
s

balancesPfx :: ByteString
balancesPfx :: ByteString
balancesPfx = ByteString
"b"

txSetPfx :: ByteString
txSetPfx :: ByteString
txSetPfx = ByteString
"t"

utxoPfx :: ByteString
utxoPfx :: ByteString
utxoPfx = ByteString
"u"

idxPfx :: ByteString
idxPfx :: ByteString
idxPfx = ByteString
"i"

getXPubTxs ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  Limits ->
  CacheX m [TxRef]
getXPubTxs :: XPubSpec -> [XPubBal] -> Limits -> CacheX m [TxRef]
getXPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits = Bool -> CacheX m [TxRef]
forall (m :: * -> *).
(MonadLoggerIO m, StoreReadExtra m, MonadUnliftIO m) =>
Bool -> ReaderT CacheConfig m [TxRef]
go Bool
False
  where
    go :: Bool -> ReaderT CacheConfig m [TxRef]
go Bool
m =
      XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool
-> (Bool -> ReaderT CacheConfig m [TxRef])
-> ReaderT CacheConfig m [TxRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
          [TxRef]
txs <- XPubSpec -> Limits -> ReaderT CacheConfig m [TxRef]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs XPubSpec
xpub Limits
limits
          (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubTxs ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
          return [TxRef]
txs
        Bool
False ->
          case Bool
m of
            Bool
True -> m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> ReaderT CacheConfig m [TxRef])
-> m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits
            Bool
False -> do
              XPubSpec -> [XPubBal] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals
              Bool -> ReaderT CacheConfig m [TxRef]
go Bool
True

getXPubTxCount ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  CacheX m Word32
getXPubTxCount :: XPubSpec -> [XPubBal] -> CacheX m BlockHeight
getXPubTxCount XPubSpec
xpub [XPubBal]
xbals =
  Bool -> CacheX m BlockHeight
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m, StoreReadExtra m) =>
Bool -> ReaderT CacheConfig m BlockHeight
go Bool
False
  where
    go :: Bool -> ReaderT CacheConfig m BlockHeight
go Bool
t =
      XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool
-> (Bool -> ReaderT CacheConfig m BlockHeight)
-> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
          (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubTxCount Int
1
          XPubSpec -> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m BlockHeight
cacheGetXPubTxCount XPubSpec
xpub
        Bool
False ->
          if Bool
t
            then m BlockHeight -> ReaderT CacheConfig m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m BlockHeight -> ReaderT CacheConfig m BlockHeight)
-> m BlockHeight -> ReaderT CacheConfig m BlockHeight
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> m BlockHeight
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m BlockHeight
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
            else do
              XPubSpec -> [XPubBal] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals
              Bool -> ReaderT CacheConfig m BlockHeight
go Bool
True

getXPubUnspents ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  Limits ->
  CacheX m [XPubUnspent]
getXPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> CacheX m [XPubUnspent]
getXPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits =
  Bool -> CacheX m [XPubUnspent]
go Bool
False
  where
    xm :: HashMap Address XPubBal
xm =
      let f :: XPubBal -> (Address, XPubBal)
f XPubBal
x = (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
x), XPubBal
x)
          g :: XPubBal -> Bool
g = (UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
> UnixTime
0) (UnixTime -> Bool) -> (XPubBal -> UnixTime) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> UnixTime
balanceUnspentCount (Balance -> UnixTime)
-> (XPubBal -> Balance) -> XPubBal -> UnixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal
       in [(Address, XPubBal)] -> HashMap Address XPubBal
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, XPubBal)] -> HashMap Address XPubBal)
-> [(Address, XPubBal)] -> HashMap Address XPubBal
forall a b. (a -> b) -> a -> b
$ (XPubBal -> (Address, XPubBal))
-> [XPubBal] -> [(Address, XPubBal)]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, XPubBal)
f ([XPubBal] -> [(Address, XPubBal)])
-> [XPubBal] -> [(Address, XPubBal)]
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
g [XPubBal]
xbals
    go :: Bool -> CacheX m [XPubUnspent]
go Bool
m =
      XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool
-> (Bool -> CacheX m [XPubUnspent]) -> CacheX m [XPubUnspent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
          CacheX m [XPubUnspent]
process
        Bool
False -> case Bool
m of
          Bool
True -> do
            [XPubUnspent]
us <- m [XPubUnspent] -> CacheX m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubUnspent] -> CacheX m [XPubUnspent])
-> m [XPubUnspent] -> CacheX m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits
            return [XPubUnspent]
us
          Bool
False -> do
            XPubSpec -> [XPubBal] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals
            Bool -> CacheX m [XPubUnspent]
go Bool
True
    process :: CacheX m [XPubUnspent]
process = do
      [OutPoint]
ops <- ((BlockRef, OutPoint) -> OutPoint)
-> [(BlockRef, OutPoint)] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map (BlockRef, OutPoint) -> OutPoint
forall a b. (a, b) -> b
snd ([(BlockRef, OutPoint)] -> [OutPoint])
-> ReaderT CacheConfig m [(BlockRef, OutPoint)]
-> ReaderT CacheConfig m [OutPoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> Limits -> ReaderT CacheConfig m [(BlockRef, OutPoint)]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents XPubSpec
xpub Limits
limits
      [Unspent]
uns <- [Maybe Unspent] -> [Unspent]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Unspent] -> [Unspent])
-> ReaderT CacheConfig m [Maybe Unspent]
-> ReaderT CacheConfig m [Unspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Maybe Unspent] -> ReaderT CacheConfig m [Maybe Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((OutPoint -> m (Maybe Unspent)) -> [OutPoint] -> m [Maybe Unspent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent [OutPoint]
ops)
      let f :: Unspent -> Maybe (Address, Unspent)
f Unspent
u =
            (String -> Maybe (Address, Unspent))
-> (Address -> Maybe (Address, Unspent))
-> Either String Address
-> Maybe (Address, Unspent)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (Maybe (Address, Unspent) -> String -> Maybe (Address, Unspent)
forall a b. a -> b -> a
const Maybe (Address, Unspent)
forall a. Maybe a
Nothing)
              (\Address
a -> (Address, Unspent) -> Maybe (Address, Unspent)
forall a. a -> Maybe a
Just (Address
a, Unspent
u))
              (ByteString -> Either String Address
scriptToAddressBS (Unspent -> ByteString
unspentScript Unspent
u))
          g :: Address -> Maybe XPubBal
g Address
a = Address -> HashMap Address XPubBal -> Maybe XPubBal
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Address
a HashMap Address XPubBal
xm
          h :: Unspent -> XPubBal -> XPubUnspent
h Unspent
u XPubBal
x =
            XPubUnspent :: Unspent -> [BlockHeight] -> XPubUnspent
XPubUnspent
              { xPubUnspent :: Unspent
xPubUnspent = Unspent
u,
                xPubUnspentPath :: [BlockHeight]
xPubUnspentPath = XPubBal -> [BlockHeight]
xPubBalPath XPubBal
x
              }
          us :: [(Address, Unspent)]
us = (Unspent -> Maybe (Address, Unspent))
-> [Unspent] -> [(Address, Unspent)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Unspent -> Maybe (Address, Unspent)
f [Unspent]
uns
          i :: Address -> Unspent -> Maybe XPubUnspent
i Address
a Unspent
u = Unspent -> XPubBal -> XPubUnspent
h Unspent
u (XPubBal -> XPubUnspent) -> Maybe XPubBal -> Maybe XPubUnspent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> Maybe XPubBal
g Address
a
      (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubUnspents ([(Address, Unspent)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Address, Unspent)]
us)
      return $ ((Address, Unspent) -> Maybe XPubUnspent)
-> [(Address, Unspent)] -> [XPubUnspent]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Address -> Unspent -> Maybe XPubUnspent)
-> (Address, Unspent) -> Maybe XPubUnspent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> Unspent -> Maybe XPubUnspent
i) [(Address, Unspent)]
us

getXPubBalances ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  CacheX m [XPubBal]
getXPubBalances :: XPubSpec -> CacheX m [XPubBal]
getXPubBalances XPubSpec
xpub =
  XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool -> (Bool -> CacheX m [XPubBal]) -> CacheX m [XPubBal]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      [XPubBal]
xbals <- XPubSpec -> CacheX m [XPubBal]
forall (m :: * -> *).
MonadLoggerIO m =>
XPubSpec -> CacheX m [XPubBal]
cacheGetXPubBalances XPubSpec
xpub
      (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubBals ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
      return [XPubBal]
xbals
    Bool
False -> do
      [XPubBal]
bals <- m [XPubBal] -> CacheX m [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubBal] -> CacheX m [XPubBal])
-> m [XPubBal] -> CacheX m [XPubBal]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      XPubSpec -> [XPubBal] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
bals
      return [XPubBal]
bals

isInCache :: MonadLoggerIO m => XPubSpec -> CacheT m Bool
isInCache :: XPubSpec -> CacheT m Bool
isInCache XPubSpec
xpub =
  ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
-> (Maybe CacheConfig -> CacheT m Bool) -> CacheT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe CacheConfig
Nothing -> Bool -> CacheT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just CacheConfig
cfg -> ReaderT CacheConfig (ReaderT (Maybe CacheConfig) m) Bool
-> CacheConfig -> CacheT m Bool
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (XPubSpec
-> ReaderT CacheConfig (ReaderT (Maybe CacheConfig) m) Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub) CacheConfig
cfg

isXPubCached :: MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached :: XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub = do
  Bool
cached <- Redis (Either Reply Bool) -> CacheX m Bool
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (XPubSpec -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
XPubSpec -> m (f Bool)
redisIsXPubCached XPubSpec
xpub)
  if Bool
cached
    then (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheHits Int
1
    else (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheMisses Int
1
  return Bool
cached

redisIsXPubCached :: RedisCtx m f => XPubSpec -> m (f Bool)
redisIsXPubCached :: XPubSpec -> m (f Bool)
redisIsXPubCached XPubSpec
xpub = ByteString -> m (f Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Bool)
Redis.exists (ByteString
balancesPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)

cacheGetXPubBalances :: MonadLoggerIO m => XPubSpec -> CacheX m [XPubBal]
cacheGetXPubBalances :: XPubSpec -> CacheX m [XPubBal]
cacheGetXPubBalances XPubSpec
xpub = do
  [XPubBal]
bals <- Redis (Either Reply [XPubBal]) -> CacheX m [XPubBal]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [XPubBal]) -> CacheX m [XPubBal])
-> Redis (Either Reply [XPubBal]) -> CacheX m [XPubBal]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> Redis (Either Reply [XPubBal])
forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub
  [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
  return [XPubBal]
bals

cacheGetXPubTxCount ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  CacheX m Word32
cacheGetXPubTxCount :: XPubSpec -> CacheX m BlockHeight
cacheGetXPubTxCount XPubSpec
xpub = do
  BlockHeight
count <- Integer -> BlockHeight
forall a. Num a => Integer -> a
fromInteger (Integer -> BlockHeight)
-> ReaderT CacheConfig m Integer -> CacheX m BlockHeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (XPubSpec -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
XPubSpec -> m (f Integer)
redisGetXPubTxCount XPubSpec
xpub)
  [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
  return BlockHeight
count

redisGetXPubTxCount :: RedisCtx m f => XPubSpec -> m (f Integer)
redisGetXPubTxCount :: XPubSpec -> m (f Integer)
redisGetXPubTxCount XPubSpec
xpub = ByteString -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Redis.zcard (ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)

cacheGetXPubTxs ::
  (StoreReadBase m, MonadLoggerIO m) =>
  XPubSpec ->
  Limits ->
  CacheX m [TxRef]
cacheGetXPubTxs :: XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs XPubSpec
xpub Limits
limits =
  case Limits -> Maybe Start
start Limits
limits of
    Maybe Start
Nothing ->
      Maybe Double -> CacheX m [TxRef]
forall (m :: * -> *).
MonadLoggerIO m =>
Maybe Double -> ReaderT CacheConfig m [TxRef]
go1 Maybe Double
forall a. Maybe a
Nothing
    Just (AtTx TxHash
th) ->
      m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th) ReaderT CacheConfig m (Maybe TxData)
-> (Maybe TxData -> CacheX m [TxRef]) -> CacheX m [TxRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just TxData {txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef {}} ->
          Maybe Double -> CacheX m [TxRef]
forall (m :: * -> *).
MonadLoggerIO m =>
Maybe Double -> ReaderT CacheConfig m [TxRef]
go1 (Maybe Double -> CacheX m [TxRef])
-> Maybe Double -> CacheX m [TxRef]
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore BlockRef
b)
        Maybe TxData
_ ->
          TxHash -> CacheX m [TxRef]
forall (m :: * -> *).
MonadLoggerIO m =>
TxHash -> ReaderT CacheConfig m [TxRef]
go2 TxHash
th
    Just (AtBlock BlockHeight
h) ->
      Maybe Double -> CacheX m [TxRef]
forall (m :: * -> *).
MonadLoggerIO m =>
Maybe Double -> ReaderT CacheConfig m [TxRef]
go1 (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore (BlockHeight -> BlockHeight -> BlockRef
BlockRef BlockHeight
h BlockHeight
forall a. Bounded a => a
maxBound)))
  where
    go1 :: Maybe Double -> ReaderT CacheConfig m [TxRef]
go1 Maybe Double
score = do
      [(TxHash, Double)]
xs <-
        Redis (Either Reply [(TxHash, Double)])
-> CacheX m [(TxHash, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(TxHash, Double)])
 -> CacheX m [(TxHash, Double)])
-> Redis (Either Reply [(TxHash, Double)])
-> CacheX m [(TxHash, Double)]
forall a b. (a -> b) -> a -> b
$
          ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(TxHash, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet
            (ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
            Maybe Double
score
            (Limits -> BlockHeight
offset Limits
limits)
            (Limits -> BlockHeight
limit Limits
limits)
      [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
      return $ ((TxHash, Double) -> TxRef) -> [(TxHash, Double)] -> [TxRef]
forall a b. (a -> b) -> [a] -> [b]
map ((TxHash -> Double -> TxRef) -> (TxHash, Double) -> TxRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxHash -> Double -> TxRef
f) [(TxHash, Double)]
xs
    go2 :: TxHash -> ReaderT CacheConfig m [TxRef]
go2 TxHash
hash = do
      [(TxHash, Double)]
xs <-
        Redis (Either Reply [(TxHash, Double)])
-> CacheX m [(TxHash, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(TxHash, Double)])
 -> CacheX m [(TxHash, Double)])
-> Redis (Either Reply [(TxHash, Double)])
-> CacheX m [(TxHash, Double)]
forall a b. (a -> b) -> a -> b
$
          ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(TxHash, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet
            (ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
            Maybe Double
forall a. Maybe a
Nothing
            BlockHeight
0
            BlockHeight
0
      [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
      let xs' :: [(TxHash, Double)]
xs' =
            if ((TxHash, Double) -> Bool) -> [(TxHash, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== TxHash
hash) (TxHash -> Bool)
-> ((TxHash, Double) -> TxHash) -> (TxHash, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxHash, Double) -> TxHash
forall a b. (a, b) -> a
fst) [(TxHash, Double)]
xs
              then ((TxHash, Double) -> Bool)
-> [(TxHash, Double)] -> [(TxHash, Double)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
/= TxHash
hash) (TxHash -> Bool)
-> ((TxHash, Double) -> TxHash) -> (TxHash, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxHash, Double) -> TxHash
forall a b. (a, b) -> a
fst) [(TxHash, Double)]
xs
              else []
      [TxRef] -> ReaderT CacheConfig m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TxRef] -> ReaderT CacheConfig m [TxRef])
-> [TxRef] -> ReaderT CacheConfig m [TxRef]
forall a b. (a -> b) -> a -> b
$
        ((TxHash, Double) -> TxRef) -> [(TxHash, Double)] -> [TxRef]
forall a b. (a -> b) -> [a] -> [b]
map ((TxHash -> Double -> TxRef) -> (TxHash, Double) -> TxRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxHash -> Double -> TxRef
f) ([(TxHash, Double)] -> [TxRef]) -> [(TxHash, Double)] -> [TxRef]
forall a b. (a -> b) -> a -> b
$
          [(TxHash, Double)] -> [(TxHash, Double)]
forall a. [a] -> [a]
l ([(TxHash, Double)] -> [(TxHash, Double)])
-> [(TxHash, Double)] -> [(TxHash, Double)]
forall a b. (a -> b) -> a -> b
$
            Int -> [(TxHash, Double)] -> [(TxHash, Double)]
forall a. Int -> [a] -> [a]
drop (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Limits -> BlockHeight
offset Limits
limits)) [(TxHash, Double)]
xs'
    l :: [a] -> [a]
l =
      if Limits -> BlockHeight
limit Limits
limits BlockHeight -> BlockHeight -> Bool
forall a. Ord a => a -> a -> Bool
> BlockHeight
0
        then Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Limits -> BlockHeight
limit Limits
limits))
        else [a] -> [a]
forall a. a -> a
id
    f :: TxHash -> Double -> TxRef
f TxHash
t Double
s = TxRef :: BlockRef -> TxHash -> TxRef
TxRef {txRefHash :: TxHash
txRefHash = TxHash
t, txRefBlock :: BlockRef
txRefBlock = Double -> BlockRef
scoreBlockRef Double
s}

cacheGetXPubUnspents ::
  (StoreReadBase m, MonadLoggerIO m) =>
  XPubSpec ->
  Limits ->
  CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents :: XPubSpec -> Limits -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents XPubSpec
xpub Limits
limits =
  case Limits -> Maybe Start
start Limits
limits of
    Maybe Start
Nothing ->
      Maybe Double -> CacheX m [(BlockRef, OutPoint)]
forall (m :: * -> *) b.
(MonadLoggerIO m, Serialize b) =>
Maybe Double -> ReaderT CacheConfig m [(BlockRef, b)]
go1 Maybe Double
forall a. Maybe a
Nothing
    Just (AtTx TxHash
th) ->
      m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th) ReaderT CacheConfig m (Maybe TxData)
-> (Maybe TxData -> CacheX m [(BlockRef, OutPoint)])
-> CacheX m [(BlockRef, OutPoint)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just TxData {txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef {}} ->
          Maybe Double -> CacheX m [(BlockRef, OutPoint)]
forall (m :: * -> *) b.
(MonadLoggerIO m, Serialize b) =>
Maybe Double -> ReaderT CacheConfig m [(BlockRef, b)]
go1 (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore BlockRef
b))
        Maybe TxData
_ ->
          TxHash -> CacheX m [(BlockRef, OutPoint)]
forall (m :: * -> *).
MonadLoggerIO m =>
TxHash -> ReaderT CacheConfig m [(BlockRef, OutPoint)]
go2 TxHash
th
    Just (AtBlock BlockHeight
h) ->
      Maybe Double -> CacheX m [(BlockRef, OutPoint)]
forall (m :: * -> *) b.
(MonadLoggerIO m, Serialize b) =>
Maybe Double -> ReaderT CacheConfig m [(BlockRef, b)]
go1 (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore (BlockHeight -> BlockHeight -> BlockRef
BlockRef BlockHeight
h BlockHeight
forall a. Bounded a => a
maxBound)))
  where
    go1 :: Maybe Double -> ReaderT CacheConfig m [(BlockRef, b)]
go1 Maybe Double
score = do
      [(b, Double)]
xs <-
        Redis (Either Reply [(b, Double)]) -> CacheX m [(b, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(b, Double)]) -> CacheX m [(b, Double)])
-> Redis (Either Reply [(b, Double)]) -> CacheX m [(b, Double)]
forall a b. (a -> b) -> a -> b
$
          ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(b, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet
            (ByteString
utxoPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
            Maybe Double
score
            (Limits -> BlockHeight
offset Limits
limits)
            (Limits -> BlockHeight
limit Limits
limits)
      [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
      return $ ((b, Double) -> (BlockRef, b)) -> [(b, Double)] -> [(BlockRef, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> Double -> (BlockRef, b)) -> (b, Double) -> (BlockRef, b)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry b -> Double -> (BlockRef, b)
forall b. b -> Double -> (BlockRef, b)
f) [(b, Double)]
xs
    go2 :: TxHash -> ReaderT CacheConfig m [(BlockRef, OutPoint)]
go2 TxHash
hash = do
      [(OutPoint, Double)]
xs <-
        Redis (Either Reply [(OutPoint, Double)])
-> CacheX m [(OutPoint, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(OutPoint, Double)])
 -> CacheX m [(OutPoint, Double)])
-> Redis (Either Reply [(OutPoint, Double)])
-> CacheX m [(OutPoint, Double)]
forall a b. (a -> b) -> a -> b
$
          ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(OutPoint, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet
            (ByteString
utxoPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
            Maybe Double
forall a. Maybe a
Nothing
            BlockHeight
0
            BlockHeight
0
      [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
      let xs' :: [(OutPoint, Double)]
xs' =
            if ((OutPoint, Double) -> Bool) -> [(OutPoint, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== TxHash
hash) (TxHash -> Bool)
-> ((OutPoint, Double) -> TxHash) -> (OutPoint, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> TxHash
outPointHash (OutPoint -> TxHash)
-> ((OutPoint, Double) -> OutPoint) -> (OutPoint, Double) -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutPoint, Double) -> OutPoint
forall a b. (a, b) -> a
fst) [(OutPoint, Double)]
xs
              then ((OutPoint, Double) -> Bool)
-> [(OutPoint, Double)] -> [(OutPoint, Double)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
/= TxHash
hash) (TxHash -> Bool)
-> ((OutPoint, Double) -> TxHash) -> (OutPoint, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> TxHash
outPointHash (OutPoint -> TxHash)
-> ((OutPoint, Double) -> OutPoint) -> (OutPoint, Double) -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutPoint, Double) -> OutPoint
forall a b. (a, b) -> a
fst) [(OutPoint, Double)]
xs
              else []
      [(BlockRef, OutPoint)]
-> ReaderT CacheConfig m [(BlockRef, OutPoint)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(BlockRef, OutPoint)]
 -> ReaderT CacheConfig m [(BlockRef, OutPoint)])
-> [(BlockRef, OutPoint)]
-> ReaderT CacheConfig m [(BlockRef, OutPoint)]
forall a b. (a -> b) -> a -> b
$
        ((OutPoint, Double) -> (BlockRef, OutPoint))
-> [(OutPoint, Double)] -> [(BlockRef, OutPoint)]
forall a b. (a -> b) -> [a] -> [b]
map ((OutPoint -> Double -> (BlockRef, OutPoint))
-> (OutPoint, Double) -> (BlockRef, OutPoint)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OutPoint -> Double -> (BlockRef, OutPoint)
forall b. b -> Double -> (BlockRef, b)
f) ([(OutPoint, Double)] -> [(BlockRef, OutPoint)])
-> [(OutPoint, Double)] -> [(BlockRef, OutPoint)]
forall a b. (a -> b) -> a -> b
$
          [(OutPoint, Double)] -> [(OutPoint, Double)]
forall a. [a] -> [a]
l ([(OutPoint, Double)] -> [(OutPoint, Double)])
-> [(OutPoint, Double)] -> [(OutPoint, Double)]
forall a b. (a -> b) -> a -> b
$
            Int -> [(OutPoint, Double)] -> [(OutPoint, Double)]
forall a. Int -> [a] -> [a]
drop (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Limits -> BlockHeight
offset Limits
limits)) [(OutPoint, Double)]
xs'
    l :: [a] -> [a]
l =
      if Limits -> BlockHeight
limit Limits
limits BlockHeight -> BlockHeight -> Bool
forall a. Ord a => a -> a -> Bool
> BlockHeight
0
        then Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Limits -> BlockHeight
limit Limits
limits))
        else [a] -> [a]
forall a. a -> a
id
    f :: b -> Double -> (BlockRef, b)
f b
o Double
s = (Double -> BlockRef
scoreBlockRef Double
s, b
o)

redisGetXPubBalances :: (Functor f, RedisCtx m f) => XPubSpec -> m (f [XPubBal])
redisGetXPubBalances :: XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub =
  ([([BlockHeight], Balance)] -> [XPubBal])
-> f [([BlockHeight], Balance)] -> f [XPubBal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([XPubBal] -> [XPubBal]
forall a. Ord a => [a] -> [a]
sort ([XPubBal] -> [XPubBal])
-> ([([BlockHeight], Balance)] -> [XPubBal])
-> [([BlockHeight], Balance)]
-> [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([BlockHeight], Balance) -> XPubBal)
-> [([BlockHeight], Balance)] -> [XPubBal]
forall a b. (a -> b) -> [a] -> [b]
map (([BlockHeight] -> Balance -> XPubBal)
-> ([BlockHeight], Balance) -> XPubBal
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [BlockHeight] -> Balance -> XPubBal
f)) (f [([BlockHeight], Balance)] -> f [XPubBal])
-> m (f [([BlockHeight], Balance)]) -> m (f [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (f [([BlockHeight], Balance)])
forall (f :: * -> *) (m :: * -> *) k v.
(Functor f, RedisCtx m f, Serialize k, Serialize v) =>
ByteString -> m (f [(k, v)])
getAllFromMap (ByteString
balancesPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
  where
    f :: [BlockHeight] -> Balance -> XPubBal
f [BlockHeight]
p Balance
b = XPubBal :: [BlockHeight] -> Balance -> XPubBal
XPubBal {xPubBalPath :: [BlockHeight]
xPubBalPath = [BlockHeight]
p, xPubBal :: Balance
xPubBal = Balance
b}

blockRefScore :: BlockRef -> Double
blockRefScore :: BlockRef -> Double
blockRefScore BlockRef {blockRefHeight :: BlockRef -> BlockHeight
blockRefHeight = BlockHeight
h, blockRefPos :: BlockRef -> BlockHeight
blockRefPos = BlockHeight
p} =
  UnixTime -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UnixTime
0x001fffffffffffff UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
- (UnixTime
h' UnixTime -> UnixTime -> UnixTime
forall a. Bits a => a -> a -> a
.|. UnixTime
p'))
  where
    h' :: UnixTime
h' = (BlockHeight -> UnixTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
h UnixTime -> UnixTime -> UnixTime
forall a. Bits a => a -> a -> a
.&. UnixTime
0x07ffffff) UnixTime -> Int -> UnixTime
forall a. Bits a => a -> Int -> a
`shift` Int
26 :: Word64
    p' :: UnixTime
p' = (BlockHeight -> UnixTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
p UnixTime -> UnixTime -> UnixTime
forall a. Bits a => a -> a -> a
.&. UnixTime
0x03ffffff) :: Word64
blockRefScore MemRef {memRefTime :: BlockRef -> UnixTime
memRefTime = UnixTime
t} = Double -> Double
forall a. Num a => a -> a
negate Double
t'
  where
    t' :: Double
t' = UnixTime -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UnixTime
t UnixTime -> UnixTime -> UnixTime
forall a. Bits a => a -> a -> a
.&. UnixTime
0x001fffffffffffff)

scoreBlockRef :: Double -> BlockRef
scoreBlockRef :: Double -> BlockRef
scoreBlockRef Double
s
  | Double
s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = MemRef :: UnixTime -> BlockRef
MemRef {memRefTime :: UnixTime
memRefTime = UnixTime
n}
  | Bool
otherwise = BlockRef :: BlockHeight -> BlockHeight -> BlockRef
BlockRef {blockRefHeight :: BlockHeight
blockRefHeight = BlockHeight
h, blockRefPos :: BlockHeight
blockRefPos = BlockHeight
p}
  where
    n :: UnixTime
n = Double -> UnixTime
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Num a => a -> a
abs Double
s) :: Word64
    m :: UnixTime
m = UnixTime
0x001fffffffffffff UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
- UnixTime
n
    h :: BlockHeight
h = UnixTime -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UnixTime
m UnixTime -> Int -> UnixTime
forall a. Bits a => a -> Int -> a
`shift` (-Int
26))
    p :: BlockHeight
p = UnixTime -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UnixTime
m UnixTime -> UnixTime -> UnixTime
forall a. Bits a => a -> a -> a
.&. UnixTime
0x03ffffff)

getFromSortedSet ::
  (Applicative f, RedisCtx m f, Serialize a) =>
  ByteString ->
  Maybe Double ->
  Word32 ->
  Word32 ->
  m (f [(a, Double)])
getFromSortedSet :: ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet ByteString
key Maybe Double
Nothing BlockHeight
off BlockHeight
0 = do
  f [(ByteString, Double)]
xs <- ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores ByteString
key (BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
off) (-Integer
1)
  return $ do
    [Either String (a, Double)]
ys <- ((ByteString, Double) -> Either String (a, Double))
-> [(ByteString, Double)] -> [Either String (a, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) (a -> (a, Double)) -> Either String a -> Either String (a, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) ([(ByteString, Double)] -> [Either String (a, Double)])
-> f [(ByteString, Double)] -> f [Either String (a, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return ([Either String (a, Double)] -> [(a, Double)]
forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)
getFromSortedSet ByteString
key Maybe Double
Nothing BlockHeight
off BlockHeight
count = do
  f [(ByteString, Double)]
xs <-
    ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores
      ByteString
key
      (BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
off)
      (BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
off Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
count Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  return $ do
    [Either String (a, Double)]
ys <- ((ByteString, Double) -> Either String (a, Double))
-> [(ByteString, Double)] -> [Either String (a, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) (a -> (a, Double)) -> Either String a -> Either String (a, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) ([(ByteString, Double)] -> [Either String (a, Double)])
-> f [(ByteString, Double)] -> f [Either String (a, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return ([Either String (a, Double)] -> [(a, Double)]
forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)
getFromSortedSet ByteString
key (Just Double
score) BlockHeight
off BlockHeight
0 = do
  f [(ByteString, Double)]
xs <-
    ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit
      ByteString
key
      Double
score
      (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
      (BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
off)
      (-Integer
1)
  return $ do
    [Either String (a, Double)]
ys <- ((ByteString, Double) -> Either String (a, Double))
-> [(ByteString, Double)] -> [Either String (a, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) (a -> (a, Double)) -> Either String a -> Either String (a, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) ([(ByteString, Double)] -> [Either String (a, Double)])
-> f [(ByteString, Double)] -> f [Either String (a, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return ([Either String (a, Double)] -> [(a, Double)]
forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)
getFromSortedSet ByteString
key (Just Double
score) BlockHeight
off BlockHeight
count = do
  f [(ByteString, Double)]
xs <-
    ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit
      ByteString
key
      Double
score
      (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)
      (BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
off)
      (BlockHeight -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
count)
  return $ do
    [Either String (a, Double)]
ys <- ((ByteString, Double) -> Either String (a, Double))
-> [(ByteString, Double)] -> [Either String (a, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) (a -> (a, Double)) -> Either String a -> Either String (a, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) ([(ByteString, Double)] -> [Either String (a, Double)])
-> f [(ByteString, Double)] -> f [Either String (a, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return ([Either String (a, Double)] -> [(a, Double)]
forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)

getAllFromMap ::
  (Functor f, RedisCtx m f, Serialize k, Serialize v) =>
  ByteString ->
  m (f [(k, v)])
getAllFromMap :: ByteString -> m (f [(k, v)])
getAllFromMap ByteString
n = do
  f [(ByteString, ByteString)]
fxs <- ByteString -> m (f [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
hgetall ByteString
n
  return $ do
    [(ByteString, ByteString)]
xs <- f [(ByteString, ByteString)]
fxs
    return
      [ (k
k, v
v)
        | (ByteString
k', ByteString
v') <- [(ByteString, ByteString)]
xs,
          let Right k
k = ByteString -> Either String k
forall a. Serialize a => ByteString -> Either String a
decode ByteString
k',
          let Right v
v = ByteString -> Either String v
forall a. Serialize a => ByteString -> Either String a
decode ByteString
v'
      ]

data CacheWriterMessage
  = CacheNewBlock
  | CacheNewTx TxHash

type CacheWriterInbox = Inbox CacheWriterMessage

type CacheWriter = Mailbox CacheWriterMessage

data AddressXPub = AddressXPub
  { AddressXPub -> XPubSpec
addressXPubSpec :: !XPubSpec,
    AddressXPub -> [BlockHeight]
addressXPubPath :: ![KeyIndex]
  }
  deriving (Int -> AddressXPub -> ShowS
[AddressXPub] -> ShowS
AddressXPub -> String
(Int -> AddressXPub -> ShowS)
-> (AddressXPub -> String)
-> ([AddressXPub] -> ShowS)
-> Show AddressXPub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressXPub] -> ShowS
$cshowList :: [AddressXPub] -> ShowS
show :: AddressXPub -> String
$cshow :: AddressXPub -> String
showsPrec :: Int -> AddressXPub -> ShowS
$cshowsPrec :: Int -> AddressXPub -> ShowS
Show, AddressXPub -> AddressXPub -> Bool
(AddressXPub -> AddressXPub -> Bool)
-> (AddressXPub -> AddressXPub -> Bool) -> Eq AddressXPub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressXPub -> AddressXPub -> Bool
$c/= :: AddressXPub -> AddressXPub -> Bool
== :: AddressXPub -> AddressXPub -> Bool
$c== :: AddressXPub -> AddressXPub -> Bool
Eq, (forall x. AddressXPub -> Rep AddressXPub x)
-> (forall x. Rep AddressXPub x -> AddressXPub)
-> Generic AddressXPub
forall x. Rep AddressXPub x -> AddressXPub
forall x. AddressXPub -> Rep AddressXPub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressXPub x -> AddressXPub
$cfrom :: forall x. AddressXPub -> Rep AddressXPub x
Generic, AddressXPub -> ()
(AddressXPub -> ()) -> NFData AddressXPub
forall a. (a -> ()) -> NFData a
rnf :: AddressXPub -> ()
$crnf :: AddressXPub -> ()
NFData, Get AddressXPub
Putter AddressXPub
Putter AddressXPub -> Get AddressXPub -> Serialize AddressXPub
forall t. Putter t -> Get t -> Serialize t
get :: Get AddressXPub
$cget :: Get AddressXPub
put :: Putter AddressXPub
$cput :: Putter AddressXPub
Serialize)

mempoolSetKey :: ByteString
mempoolSetKey :: ByteString
mempoolSetKey = ByteString
"mempool"

addrPfx :: ByteString
addrPfx :: ByteString
addrPfx = ByteString
"a"

bestBlockKey :: ByteString
bestBlockKey :: ByteString
bestBlockKey = ByteString
"head"

maxKey :: ByteString
maxKey :: ByteString
maxKey = ByteString
"max"

xPubAddrFunction :: DeriveType -> XPubKey -> Address
xPubAddrFunction :: DeriveType -> XPubKey -> Address
xPubAddrFunction DeriveType
DeriveNormal = XPubKey -> Address
xPubAddr
xPubAddrFunction DeriveType
DeriveP2SH = XPubKey -> Address
xPubCompatWitnessAddr
xPubAddrFunction DeriveType
DeriveP2WPKH = XPubKey -> Address
xPubWitnessAddr

cacheWriter ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheConfig ->
  CacheWriterInbox ->
  m ()
cacheWriter :: CacheConfig -> CacheWriterInbox -> m ()
cacheWriter CacheConfig
cfg CacheWriterInbox
inbox =
  ReaderT CacheConfig m () -> CacheConfig -> m ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT CacheConfig m ()
forall a. ReaderT CacheConfig m a
go CacheConfig
cfg
  where
    go :: ReaderT CacheConfig m a
go = do
      ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
      ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC
      ReaderT CacheConfig m () -> ReaderT CacheConfig m a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ReaderT CacheConfig m () -> ReaderT CacheConfig m a)
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m a
forall a b. (a -> b) -> a -> b
$ do
        CacheWriterMessage
x <- CacheWriterInbox -> ReaderT CacheConfig m CacheWriterMessage
forall (mbox :: * -> *) (m :: * -> *) msg.
(InChan mbox, MonadIO m) =>
mbox msg -> m msg
receive CacheWriterInbox
inbox
        CacheWriterMessage -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheWriterMessage -> CacheX m ()
cacheWriterReact CacheWriterMessage
x

lockIt :: MonadLoggerIO m => CacheX m (Maybe Word32)
lockIt :: CacheX m (Maybe BlockHeight)
lockIt = do
  BlockHeight
rnd <- IO BlockHeight -> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO BlockHeight
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
  BlockHeight -> ReaderT CacheConfig m (Either Reply Status)
forall (m :: * -> *) a.
(MonadIO m, MonadReader CacheConfig m, Show a) =>
a -> m (Either Reply Status)
go BlockHeight
rnd ReaderT CacheConfig m (Either Reply Status)
-> (Either Reply Status -> CacheX m (Maybe BlockHeight))
-> CacheX m (Maybe BlockHeight)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Status
Redis.Ok -> do
      $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logDebugS) LogSource
"Cache" (LogSource -> ReaderT CacheConfig m ())
-> LogSource -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Acquired lock with value " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHeight -> String
forall a. Show a => a -> String
show BlockHeight
rnd)
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockAcquired Int
1
      return (BlockHeight -> Maybe BlockHeight
forall a. a -> Maybe a
Just BlockHeight
rnd)
    Right Status
Redis.Pong -> do
      $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logErrorS)
        LogSource
"Cache"
        LogSource
"Unexpected pong when acquiring lock"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      return Maybe BlockHeight
forall a. Maybe a
Nothing
    Right (Redis.Status ByteString
s) -> do
      $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logErrorS) LogSource
"Cache" (LogSource -> ReaderT CacheConfig m ())
-> LogSource -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Unexpected status acquiring lock: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
s
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      return Maybe BlockHeight
forall a. Maybe a
Nothing
    Left (Redis.Bulk Maybe ByteString
Nothing) -> do
      $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logDebugS) LogSource
"Cache" LogSource
"Lock already taken"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      return Maybe BlockHeight
forall a. Maybe a
Nothing
    Left Reply
e -> do
      $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logErrorS)
        LogSource
"Cache"
        LogSource
"Error when trying to acquire lock"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      CacheError -> CacheX m (Maybe BlockHeight)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Reply -> CacheError
RedisError Reply
e)
  where
    go :: a -> m (Either Reply Status)
go a
rnd = do
      Connection
conn <- (CacheConfig -> Connection) -> m Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Connection
cacheConn
      IO (Either Reply Status) -> m (Either Reply Status)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Reply Status) -> m (Either Reply Status))
-> (Redis (Either Reply Status) -> IO (Either Reply Status))
-> Redis (Either Reply Status)
-> m (Either Reply Status)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection
-> Redis (Either Reply Status) -> IO (Either Reply Status)
forall a. Connection -> Redis a -> IO a
Redis.runRedis Connection
conn (Redis (Either Reply Status) -> m (Either Reply Status))
-> Redis (Either Reply Status) -> m (Either Reply Status)
forall a b. (a -> b) -> a -> b
$ do
        let opts :: SetOpts
opts =
              SetOpts :: Maybe Integer -> Maybe Integer -> Maybe Condition -> SetOpts
Redis.SetOpts
                { setSeconds :: Maybe Integer
Redis.setSeconds = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
300,
                  setMilliseconds :: Maybe Integer
Redis.setMilliseconds = Maybe Integer
forall a. Maybe a
Nothing,
                  setCondition :: Maybe Condition
Redis.setCondition = Condition -> Maybe Condition
forall a. a -> Maybe a
Just Condition
Redis.Nx
                }
        ByteString -> ByteString -> SetOpts -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> SetOpts -> m (f Status)
Redis.setOpts ByteString
"lock" (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (a -> String
forall a. Show a => a -> String
show a
rnd)) SetOpts
opts

unlockIt :: MonadLoggerIO m => Maybe Word32 -> CacheX m ()
unlockIt :: Maybe BlockHeight -> CacheX m ()
unlockIt Maybe BlockHeight
Nothing = () -> CacheX m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unlockIt (Just BlockHeight
i) =
  Redis (Either Reply (Maybe ByteString))
-> CacheX m (Maybe ByteString)
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get ByteString
"lock") CacheX m (Maybe ByteString)
-> (Maybe ByteString -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ByteString
Nothing ->
      $(LogSource -> LogSource -> CacheX m ()
logErrorS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Not releasing lock with value " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHeight -> String
forall a. Show a => a -> String
show BlockHeight
i)
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": not locked"
    Just ByteString
bs ->
      if String -> BlockHeight
forall a. Read a => String -> a
read (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
bs) BlockHeight -> BlockHeight -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHeight
i
        then do
          ReaderT CacheConfig m Integer -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m Integer -> CacheX m ())
-> ReaderT CacheConfig m Integer -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis ([ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
"lock"])
          $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Released lock with value "
              LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHeight -> String
forall a. Show a => a -> String
show BlockHeight
i)
          (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockReleased Int
1
        else
          $(LogSource -> LogSource -> CacheX m ()
logErrorS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Could not release lock: value is not "
              LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHeight -> String
forall a. Show a => a -> String
show BlockHeight
i)

withLock ::
  (MonadLoggerIO m, MonadUnliftIO m) =>
  CacheX m a ->
  CacheX m (Maybe a)
withLock :: CacheX m a -> CacheX m (Maybe a)
withLock CacheX m a
f =
  ReaderT CacheConfig m (Maybe BlockHeight)
-> (Maybe BlockHeight -> ReaderT CacheConfig m ())
-> (Maybe BlockHeight -> CacheX m (Maybe a))
-> CacheX m (Maybe a)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ReaderT CacheConfig m (Maybe BlockHeight)
forall (m :: * -> *).
MonadLoggerIO m =>
CacheX m (Maybe BlockHeight)
lockIt Maybe BlockHeight -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadLoggerIO m =>
Maybe BlockHeight -> CacheX m ()
unlockIt ((Maybe BlockHeight -> CacheX m (Maybe a)) -> CacheX m (Maybe a))
-> (Maybe BlockHeight -> CacheX m (Maybe a)) -> CacheX m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
    Just BlockHeight
_ -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> CacheX m a -> CacheX m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheX m a
f
    Maybe BlockHeight
Nothing -> Maybe a -> CacheX m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

smallDelay :: MonadUnliftIO m => CacheX m ()
smallDelay :: CacheX m ()
smallDelay = do
  Int
delay <- (CacheConfig -> Int) -> ReaderT CacheConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Int
cacheRetryDelay
  let delayMin :: Int
delayMin = Int
delay Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
  let delayMax :: Int
delayMax = Int
delay Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
  Int -> CacheX m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> CacheX m ()) -> ReaderT CacheConfig m Int -> CacheX m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Int -> ReaderT CacheConfig m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
delayMin, Int
delayMax))

withLockForever ::
  (MonadLoggerIO m, MonadUnliftIO m) =>
  CacheX m a ->
  CacheX m a
withLockForever :: CacheX m a -> CacheX m a
withLockForever CacheX m a
go =
  CacheX m a -> CacheX m (Maybe a)
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock CacheX m a
go CacheX m (Maybe a) -> (Maybe a -> CacheX m a) -> CacheX m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe a
Nothing -> do
      CacheX m ()
forall (m :: * -> *). MonadUnliftIO m => CacheX m ()
smallDelay
      $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Retrying lock aquisition without limits"
      CacheX m a -> CacheX m a
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m a
withLockForever CacheX m a
go
    Just a
x -> a -> CacheX m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

withLockRetry ::
  (MonadLoggerIO m, MonadUnliftIO m) =>
  Int ->
  CacheX m a ->
  CacheX m (Maybe a)
withLockRetry :: Int -> CacheX m a -> CacheX m (Maybe a)
withLockRetry Int
i CacheX m a
f
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe a -> CacheX m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise =
    CacheX m a -> CacheX m (Maybe a)
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock CacheX m a
f CacheX m (Maybe a)
-> (Maybe a -> CacheX m (Maybe a)) -> CacheX m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe a
Nothing -> do
        CacheX m ()
forall (m :: * -> *). MonadUnliftIO m => CacheX m ()
smallDelay
        $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
          LogSource
"Retrying lock acquisition: "
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
i)
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" tries remaining"
        Int -> CacheX m a -> CacheX m (Maybe a)
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
Int -> CacheX m a -> CacheX m (Maybe a)
withLockRetry (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) CacheX m a
f
      Maybe a
x -> Maybe a -> CacheX m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x

isFull ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  CacheX m Bool
isFull :: CacheX m Bool
isFull = do
  Integer
x <- (CacheConfig -> Integer) -> ReaderT CacheConfig m Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Integer
cacheMax
  Integer
s <- Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Integer)
Redis.dbsize
  return $ Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
x

pruneDB ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  CacheX m Integer
pruneDB :: CacheX m Integer
pruneDB = do
  Integer
x <- (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10) (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
8) (Integer -> Integer) -> CacheX m Integer -> CacheX m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CacheConfig -> Integer) -> CacheX m Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Integer
cacheMax -- Prune to 80% of max
  Integer
s <- Redis (Either Reply Integer) -> CacheX m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Integer)
Redis.dbsize
  if Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
x then Integer -> CacheX m Integer
forall a (m :: * -> *).
(Integral a, MonadLoggerIO m, MonadUnliftIO m, StoreReadBase m) =>
a -> ReaderT CacheConfig m Integer
flush (Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
x) else Integer -> CacheX m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
  where
    flush :: a -> ReaderT CacheConfig m Integer
flush a
n =
      case a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
64 of
        a
0 -> Integer -> ReaderT CacheConfig m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
        a
x -> do
          [XPubSpec]
ks <-
            ([(XPubSpec, Double)] -> [XPubSpec])
-> ReaderT CacheConfig m [(XPubSpec, Double)]
-> ReaderT CacheConfig m [XPubSpec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((XPubSpec, Double) -> XPubSpec)
-> [(XPubSpec, Double)] -> [XPubSpec]
forall a b. (a -> b) -> [a] -> [b]
map (XPubSpec, Double) -> XPubSpec
forall a b. (a, b) -> a
fst) (ReaderT CacheConfig m [(XPubSpec, Double)]
 -> ReaderT CacheConfig m [XPubSpec])
-> (Redis (Either Reply [(XPubSpec, Double)])
    -> ReaderT CacheConfig m [(XPubSpec, Double)])
-> Redis (Either Reply [(XPubSpec, Double)])
-> ReaderT CacheConfig m [XPubSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply [(XPubSpec, Double)])
-> ReaderT CacheConfig m [(XPubSpec, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(XPubSpec, Double)])
 -> ReaderT CacheConfig m [XPubSpec])
-> Redis (Either Reply [(XPubSpec, Double)])
-> ReaderT CacheConfig m [XPubSpec]
forall a b. (a -> b) -> a -> b
$
              ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(XPubSpec, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet ByteString
maxKey Maybe Double
forall a. Maybe a
Nothing BlockHeight
0 (a -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
          $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logDebugS) LogSource
"Cache" (LogSource -> ReaderT CacheConfig m ())
-> LogSource -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Pruning " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubSpec] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
ks)) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" old xpubs"
          [XPubSpec] -> ReaderT CacheConfig m Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheX m Integer
delXPubKeys [XPubSpec]
ks

touchKeys :: MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys :: [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec]
xpubs = do
  Int64
now <- SystemTime -> Int64
systemSeconds (SystemTime -> Int64)
-> ReaderT CacheConfig m SystemTime -> ReaderT CacheConfig m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> ReaderT CacheConfig m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
  Redis (Either Reply ()) -> CacheX m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> CacheX m ())
-> Redis (Either Reply ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> [XPubSpec] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, RedisCtx m f, Real a) =>
a -> [XPubSpec] -> m (f ())
redisTouchKeys Int64
now [XPubSpec]
xpubs

redisTouchKeys :: (Monad f, RedisCtx m f, Real a) => a -> [XPubSpec] -> m (f ())
redisTouchKeys :: a -> [XPubSpec] -> m (f ())
redisTouchKeys a
_ [] = f () -> m (f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (f () -> m (f ())) -> f () -> m (f ())
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
redisTouchKeys a
now [XPubSpec]
xpubs =
  f Integer -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f Integer -> f ()) -> m (f Integer) -> m (f ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [(Double, ByteString)] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
Redis.zadd ByteString
maxKey ((XPubSpec -> (Double, ByteString))
-> [XPubSpec] -> [(Double, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
now,) (ByteString -> (Double, ByteString))
-> (XPubSpec -> ByteString) -> XPubSpec -> (Double, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode) [XPubSpec]
xpubs)

cacheWriterReact ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheWriterMessage ->
  CacheX m ()
cacheWriterReact :: CacheWriterMessage -> CacheX m ()
cacheWriterReact CacheWriterMessage
CacheNewBlock =
  CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
doSync
cacheWriterReact (CacheNewTx TxHash
txid) =
  CacheX m () -> CacheX m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock CacheX m ()
go CacheX m (Maybe ()) -> (Maybe () -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just () -> () -> CacheX m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe ()
Nothing -> CacheX m ()
forall (m :: * -> *). MonadUnliftIO m => CacheX m ()
smallDelay CacheX m () -> CacheX m () -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CacheWriterMessage -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheWriterMessage -> CacheX m ()
cacheWriterReact (TxHash -> CacheWriterMessage
CacheNewTx TxHash
txid)
  where
    hex :: LogSource
hex = TxHash -> LogSource
txHashToHex TxHash
txid
    go :: CacheX m ()
go =
      $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource
"Locking to import tx: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
hex)
        CacheX m ()
-> ReaderT CacheConfig m Bool -> ReaderT CacheConfig m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxHash -> ReaderT CacheConfig m Bool
forall (m :: * -> *). MonadLoggerIO m => TxHash -> CacheX m Bool
cacheIsInMempool TxHash
txid ReaderT CacheConfig m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True ->
            $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Already imported tx: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
hex
          Bool
False ->
            m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
txid) ReaderT CacheConfig m (Maybe TxData)
-> (Maybe TxData -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TxData -> ReaderT CacheConfig m Integer)
-> Maybe TxData -> CacheX m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \TxData
tx -> do
              $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Importing mempool tx: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
hex
              [TxData] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC [TxData
tx]
              ReaderT CacheConfig m Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Integer
pruneDB

doSync ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m ()
doSync :: CacheX m ()
doSync = CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC

lenNotNull :: [XPubBal] -> Int
lenNotNull :: [XPubBal] -> Int
lenNotNull = [XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([XPubBal] -> Int) -> ([XPubBal] -> [XPubBal]) -> [XPubBal] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (XPubBal -> Bool) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal)

newXPubC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  CacheX m ()
newXPubC :: XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals =
  ReaderT CacheConfig m Bool
should_index ReaderT CacheConfig m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
i -> Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
i (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    ReaderT CacheConfig m Bool
-> (Bool -> CacheX m ()) -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ReaderT CacheConfig m Bool
set_index Bool -> CacheX m ()
forall (m :: * -> *).
MonadLoggerIO m =>
Bool -> ReaderT CacheConfig m ()
unset_index ((Bool -> CacheX m ()) -> CacheX m ())
-> (Bool -> CacheX m ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ \Bool
j -> Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
j (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
      (CacheMetrics -> StatDist) -> CacheX m () -> CacheX m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(CacheMetrics -> StatDist) -> CacheX m a -> CacheX m a
withMetrics CacheMetrics -> StatDist
cacheIndexTime (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
        LogSource
xpubtxt <- XPubSpec -> CacheX m LogSource
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m LogSource
xpubText XPubSpec
xpub
        $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
          LogSource
"Caching " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
xpubtxt LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": "
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals))
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" addresses / "
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
lenNotNull [XPubBal]
xbals))
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" used"
        [XPubUnspent]
utxo <- m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent])
-> m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
forall a. Default a => a
def
        $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
          LogSource
"Caching " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
xpubtxt LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubUnspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
utxo))
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" utxos"
        [TxRef]
xtxs <- m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> ReaderT CacheConfig m [TxRef])
-> m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
forall a. Default a => a
def
        $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
          LogSource
"Caching " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
xpubtxt LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
xtxs))
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" txs"
        Int64
now <- SystemTime -> Int64
systemSeconds (SystemTime -> Int64)
-> ReaderT CacheConfig m SystemTime -> ReaderT CacheConfig m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> ReaderT CacheConfig m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
        Redis (Either Reply ()) -> CacheX m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> CacheX m ())
-> Redis (Either Reply ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
          Either Reply ()
b <- Int64 -> [XPubSpec] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, RedisCtx m f, Real a) =>
a -> [XPubSpec] -> m (f ())
redisTouchKeys Int64
now [XPubSpec
xpub]
          Either Reply ()
c <- XPubSpec -> [XPubBal] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances XPubSpec
xpub [XPubBal]
xbals
          Either Reply Integer
d <- XPubSpec -> [(OutPoint, BlockRef)] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents XPubSpec
xpub ((XPubUnspent -> (OutPoint, BlockRef))
-> [XPubUnspent] -> [(OutPoint, BlockRef)]
forall a b. (a -> b) -> [a] -> [b]
map XPubUnspent -> (OutPoint, BlockRef)
op [XPubUnspent]
utxo)
          Either Reply Integer
e <- XPubSpec -> [TxRef] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs XPubSpec
xpub [TxRef]
xtxs
          return $ Either Reply ()
b Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
c Either Reply () -> Either Reply Integer -> Either Reply Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
d Either Reply Integer
-> Either Reply Integer -> Either Reply Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
e Either Reply Integer -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either Reply ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Cached " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
xpubtxt
  where
    op :: XPubUnspent -> (OutPoint, BlockRef)
op XPubUnspent {xPubUnspent :: XPubUnspent -> Unspent
xPubUnspent = Unspent
u} = (Unspent -> OutPoint
unspentPoint Unspent
u, Unspent -> BlockRef
unspentBlock Unspent
u)
    should_index :: ReaderT CacheConfig m Bool
should_index =
      (CacheConfig -> Int) -> ReaderT CacheConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Int
cacheMin ReaderT CacheConfig m Int
-> (Int -> ReaderT CacheConfig m Bool)
-> ReaderT CacheConfig m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
x ->
        if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [XPubBal] -> Int
lenNotNull [XPubBal]
xbals
          then
            ReaderT CacheConfig m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync ReaderT CacheConfig m Bool
-> (Bool -> ReaderT CacheConfig m Bool)
-> ReaderT CacheConfig m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s ->
              if Bool
s
                then Bool -> Bool
not (Bool -> Bool)
-> ReaderT CacheConfig m Bool -> ReaderT CacheConfig m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT CacheConfig m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Bool
isFull
                else Bool -> ReaderT CacheConfig m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else Bool -> ReaderT CacheConfig m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    key :: ByteString
key = ByteString
idxPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub
    opts :: SetOpts
opts =
      SetOpts :: Maybe Integer -> Maybe Integer -> Maybe Condition -> SetOpts
Redis.SetOpts
        { setSeconds :: Maybe Integer
Redis.setSeconds = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
600,
          setMilliseconds :: Maybe Integer
Redis.setMilliseconds = Maybe Integer
forall a. Maybe a
Nothing,
          setCondition :: Maybe Condition
Redis.setCondition = Condition -> Maybe Condition
forall a. a -> Maybe a
Just Condition
Redis.Nx
        }
    red :: Redis (Either Reply Status)
red = ByteString -> ByteString -> SetOpts -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> SetOpts -> m (f Status)
Redis.setOpts ByteString
key ByteString
"1" SetOpts
opts
    unset_index :: Bool -> ReaderT CacheConfig m ()
unset_index Bool
y = Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
y (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> (Redis (Either Reply Integer) -> ReaderT CacheConfig m ())
-> Redis (Either Reply Integer)
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m Integer -> ReaderT CacheConfig m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m Integer -> ReaderT CacheConfig m ())
-> (Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer)
-> Redis (Either Reply Integer)
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply Integer) -> ReaderT CacheConfig m ())
-> Redis (Either Reply Integer) -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
key]
    set_index :: ReaderT CacheConfig m Bool
set_index =
      (CacheConfig -> Connection) -> ReaderT CacheConfig m Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Connection
cacheConn ReaderT CacheConfig m Connection
-> (Connection -> ReaderT CacheConfig m Bool)
-> ReaderT CacheConfig m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Connection
conn ->
        IO (Either Reply Status)
-> ReaderT CacheConfig m (Either Reply Status)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection
-> Redis (Either Reply Status) -> IO (Either Reply Status)
forall a. Connection -> Redis a -> IO a
Redis.runRedis Connection
conn Redis (Either Reply Status)
red) ReaderT CacheConfig m (Either Reply Status)
-> (Either Reply Status -> ReaderT CacheConfig m Bool)
-> ReaderT CacheConfig m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ReaderT CacheConfig m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ReaderT CacheConfig m Bool)
-> (Either Reply Status -> Bool)
-> Either Reply Status
-> ReaderT CacheConfig m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Reply Status -> Bool
forall a b. Either a b -> Bool
isRight

inSync ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m Bool
inSync :: CacheX m Bool
inSync =
  m (Maybe BlockHash) -> ReaderT CacheConfig m (Maybe BlockHash)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ReaderT CacheConfig m (Maybe BlockHash)
-> (Maybe BlockHash -> CacheX m Bool) -> CacheX m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockHash
Nothing -> Bool -> CacheX m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just BlockHash
bb ->
      (CacheConfig -> Chain) -> ReaderT CacheConfig m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain ReaderT CacheConfig m Chain
-> (Chain -> CacheX m Bool) -> CacheX m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Chain
ch ->
        Chain -> ReaderT CacheConfig m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch ReaderT CacheConfig m BlockNode
-> (BlockNode -> CacheX m Bool) -> CacheX m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BlockNode
cb ->
          Bool -> CacheX m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CacheX m Bool) -> Bool -> CacheX m Bool
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
cb) BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bb

newBlockC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m ()
newBlockC :: CacheX m ()
newBlockC =
  CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s ->
    Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
      (CacheConfig -> Chain) -> ReaderT CacheConfig m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain ReaderT CacheConfig m Chain
-> (Chain -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Chain
ch ->
        Chain -> ReaderT CacheConfig m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch ReaderT CacheConfig m BlockNode
-> (BlockNode -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BlockNode
bn ->
          CacheX m (Maybe BlockHash)
forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead CacheX m (Maybe BlockHash)
-> (Maybe BlockHash -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockHash
Nothing ->
              $(LogSource -> LogSource -> CacheX m ()
logInfoS) LogSource
"Cache" LogSource
"Initializing best cache block"
                CacheX m ()
-> ReaderT CacheConfig m (Maybe ())
-> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CacheX m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (BlockNode -> CacheX m ()
do_import BlockNode
bn) ReaderT CacheConfig m (Maybe ())
-> (Maybe () -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Maybe ()
Nothing -> CacheX m ()
forall (m :: * -> *). MonadUnliftIO m => CacheX m ()
smallDelay CacheX m () -> CacheX m () -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
                  Just () -> () -> CacheX m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just BlockHash
hb ->
              if BlockHash
hb BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
bn)
                then $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Cache in sync"
                else
                  CacheX m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (Chain -> BlockHash -> BlockNode -> CacheX m ()
sync Chain
ch BlockHash
hb BlockNode
bn CacheX m () -> CacheX m () -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT CacheConfig m Integer -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ReaderT CacheConfig m Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Integer
pruneDB) ReaderT CacheConfig m (Maybe ())
-> (Maybe () -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe ()
Nothing -> CacheX m ()
forall (m :: * -> *). MonadUnliftIO m => CacheX m ()
smallDelay CacheX m () -> CacheX m () -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
                    Just () -> () -> CacheX m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    sync :: Chain -> BlockHash -> BlockNode -> CacheX m ()
sync Chain
ch BlockHash
hb BlockNode
bn =
      BlockHash -> Chain -> ReaderT CacheConfig m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
BlockHash -> Chain -> m (Maybe BlockNode)
chainGetBlock BlockHash
hb Chain
ch ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockNode
Nothing -> do
          $(LogSource -> LogSource -> CacheX m ()
logErrorS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Cache head block node not found: "
              LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
hb
        Just BlockNode
hn ->
          BlockHash -> Chain -> CacheX m Bool
forall (m :: * -> *). MonadIO m => BlockHash -> Chain -> m Bool
chainBlockMain BlockHash
hb Chain
ch CacheX m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
m ->
            if Bool
m
              then Chain -> BlockNode -> BlockNode -> CacheX m ()
next Chain
ch BlockNode
bn BlockNode
hn
              else do
                $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
                  LogSource
"Reverting cache head not in main chain: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
hb
                BlockHash -> CacheX m ()
forall (m :: * -> *).
(StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
removeHeadC BlockHash
hb
                CacheX m (Maybe BlockHash)
forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead CacheX m (Maybe BlockHash)
-> (Maybe BlockHash -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Maybe BlockHash
Nothing -> BlockNode -> CacheX m ()
do_import BlockNode
bn
                  Just BlockHash
hb' -> Chain -> BlockHash -> BlockNode -> CacheX m ()
sync Chain
ch BlockHash
hb' BlockNode
bn
    next :: Chain -> BlockNode -> BlockNode -> CacheX m ()
next Chain
ch BlockNode
bn BlockNode
hn =
      if
          | BlockHeader -> BlockHash
prevBlock (BlockNode -> BlockHeader
nodeHeader BlockNode
bn) BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
hn) ->
            BlockNode -> CacheX m ()
do_import BlockNode
bn
          | BlockNode -> BlockHeight
nodeHeight BlockNode
bn BlockHeight -> BlockHeight -> Bool
forall a. Ord a => a -> a -> Bool
> BlockNode -> BlockHeight
nodeHeight BlockNode
hn ->
            BlockHeight
-> BlockNode -> Chain -> ReaderT CacheConfig m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
BlockHeight -> BlockNode -> Chain -> m (Maybe BlockNode)
chainGetAncestor (BlockNode -> BlockHeight
nodeHeight BlockNode
hn BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ BlockHeight
1) BlockNode
bn Chain
ch ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe BlockNode
Nothing -> do
                $(LogSource -> LogSource -> CacheX m ()
logErrorS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
                  LogSource
"Ancestor not found at height "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHeight -> String
forall a. Show a => a -> String
show (BlockNode -> BlockHeight
nodeHeight BlockNode
hn BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ BlockHeight
1))
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" for block: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
bn))
                CacheError -> CacheX m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CacheError -> CacheX m ()) -> CacheError -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
                  String -> CacheError
LogicError (String -> CacheError) -> String -> CacheError
forall a b. (a -> b) -> a -> b
$
                    String
"Ancestor not found at height "
                      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BlockHeight -> String
forall a. Show a => a -> String
show (BlockNode -> BlockHeight
nodeHeight BlockNode
hn BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ BlockHeight
1)
                      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for block: "
                      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> LogSource -> String
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHash -> LogSource
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
bn)))
              Just BlockNode
hn' -> do
                BlockNode -> CacheX m ()
do_import BlockNode
hn'
                Chain -> BlockNode -> BlockNode -> CacheX m ()
next Chain
ch BlockNode
bn BlockNode
hn'
          | Bool
otherwise ->
            $(LogSource -> LogSource -> CacheX m ()
logInfoS) LogSource
"Cache" LogSource
"Cache best block higher than this node's"
    do_import :: BlockNode -> CacheX m ()
do_import = BlockHash -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
importBlockC (BlockHash -> CacheX m ())
-> (BlockNode -> BlockHash) -> BlockNode -> CacheX m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> BlockHash
headerHash (BlockHeader -> BlockHash)
-> (BlockNode -> BlockHeader) -> BlockNode -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
nodeHeader

importBlockC ::
  (MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
  BlockHash ->
  CacheX m ()
importBlockC :: BlockHash -> CacheX m ()
importBlockC BlockHash
bh =
  m (Maybe BlockData) -> ReaderT CacheConfig m (Maybe BlockData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh) ReaderT CacheConfig m (Maybe BlockData)
-> (Maybe BlockData -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just BlockData
bd -> do
      let ths :: [TxHash]
ths = BlockData -> [TxHash]
blockDataTxs BlockData
bd
      [TxData]
tds <- [TxData] -> [TxData]
sortTxData ([TxData] -> [TxData])
-> ([Maybe TxData] -> [TxData]) -> [Maybe TxData] -> [TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe TxData] -> [TxData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TxData] -> [TxData])
-> ReaderT CacheConfig m [Maybe TxData]
-> ReaderT CacheConfig m [TxData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ReaderT CacheConfig m (Maybe TxData))
-> [TxHash] -> ReaderT CacheConfig m [Maybe TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData))
-> (TxHash -> m (Maybe TxData))
-> TxHash
-> ReaderT CacheConfig m (Maybe TxData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData) [TxHash]
ths
      $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Importing " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
tds))
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" transactions from block "
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
      [TxData] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC [TxData]
tds
      $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Done importing " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
tds))
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" transactions from block "
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
      BlockHash -> CacheX m ()
forall (m :: * -> *).
(MonadLoggerIO m, StoreReadBase m) =>
BlockHash -> CacheX m ()
cacheSetHead BlockHash
bh
    Maybe BlockData
Nothing -> do
      $(LogSource -> LogSource -> CacheX m ()
logErrorS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Could not get block: "
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
      CacheError -> CacheX m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CacheError -> CacheX m ())
-> (LogSource -> CacheError) -> LogSource -> CacheX m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CacheError
LogicError (String -> CacheError)
-> (LogSource -> String) -> LogSource -> CacheError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> String
forall a b. ConvertibleStrings a b => a -> b
cs (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Could not get block: "
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh

removeHeadC ::
  (StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
  BlockHash ->
  CacheX m ()
removeHeadC :: BlockHash -> CacheX m ()
removeHeadC BlockHash
cb =
  ReaderT CacheConfig m (Maybe ()) -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m (Maybe ()) -> CacheX m ())
-> (MaybeT (ReaderT CacheConfig m) ()
    -> ReaderT CacheConfig m (Maybe ()))
-> MaybeT (ReaderT CacheConfig m) ()
-> CacheX m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT (ReaderT CacheConfig m) ()
-> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ReaderT CacheConfig m) () -> CacheX m ())
-> MaybeT (ReaderT CacheConfig m) () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
    BlockHash
bh <- ReaderT CacheConfig m (Maybe BlockHash)
-> MaybeT (ReaderT CacheConfig m) BlockHash
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ReaderT CacheConfig m (Maybe BlockHash)
forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead
    Bool -> MaybeT (ReaderT CacheConfig m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BlockHash
cb BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bh)
    BlockData
bd <- ReaderT CacheConfig m (Maybe BlockData)
-> MaybeT (ReaderT CacheConfig m) BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> ReaderT CacheConfig m (Maybe BlockData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh))
    CacheX m () -> MaybeT (ReaderT CacheConfig m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CacheX m () -> MaybeT (ReaderT CacheConfig m) ())
-> CacheX m () -> MaybeT (ReaderT CacheConfig m) ()
forall a b. (a -> b) -> a -> b
$ do
      [TxData]
tds <-
        [TxData] -> [TxData]
sortTxData ([TxData] -> [TxData])
-> ([Maybe TxData] -> [TxData]) -> [Maybe TxData] -> [TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe TxData] -> [TxData]
forall a. [Maybe a] -> [a]
catMaybes
          ([Maybe TxData] -> [TxData])
-> ReaderT CacheConfig m [Maybe TxData]
-> ReaderT CacheConfig m [TxData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ReaderT CacheConfig m (Maybe TxData))
-> [TxHash] -> ReaderT CacheConfig m [Maybe TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData))
-> (TxHash -> m (Maybe TxData))
-> TxHash
-> ReaderT CacheConfig m (Maybe TxData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData) (BlockData -> [TxHash]
blockDataTxs BlockData
bd)
      $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Reverting head: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
      [TxData] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC [TxData]
tds
      $(LogSource -> LogSource -> CacheX m ()
logWarnS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Reverted block head "
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" to parent "
          LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex (BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bd))
      BlockHash -> CacheX m ()
forall (m :: * -> *).
(MonadLoggerIO m, StoreReadBase m) =>
BlockHash -> CacheX m ()
cacheSetHead (BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bd))

importMultiTxC ::
  (MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
  [TxData] ->
  CacheX m ()
importMultiTxC :: [TxData] -> CacheX m ()
importMultiTxC [TxData]
txs = do
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Processing " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
txs)) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" txs"
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    LogSource
"Getting address information for "
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show (HashSet Address -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashSet Address
alladdrs))
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" addresses"
  HashMap Address AddressXPub
addrmap <- ReaderT CacheConfig m (HashMap Address AddressXPub)
getaddrmap
  let addrs :: [Address]
addrs = HashMap Address AddressXPub -> [Address]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Address AddressXPub
addrmap
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    LogSource
"Getting balances for "
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show (HashMap Address AddressXPub -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap Address AddressXPub
addrmap))
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" addresses"
  HashMap Address Balance
balmap <- [Address] -> ReaderT CacheConfig m (HashMap Address Balance)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, Monad (t m), StoreReadBase m) =>
[Address] -> t m (HashMap Address Balance)
getbalances [Address]
addrs
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    LogSource
"Getting unspent data for "
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([OutPoint] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OutPoint]
allops))
      LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" outputs"
  HashMap OutPoint Unspent
unspentmap <- ReaderT CacheConfig m (HashMap OutPoint Unspent)
getunspents
  BlockHeight
gap <- m BlockHeight -> ReaderT CacheConfig m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getMaxGap
  Int64
now <- SystemTime -> Int64
systemSeconds (SystemTime -> Int64)
-> ReaderT CacheConfig m SystemTime -> ReaderT CacheConfig m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> ReaderT CacheConfig m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
  let xpubs :: [XPubSpec]
xpubs = HashMap Address AddressXPub -> [XPubSpec]
forall k. HashMap k AddressXPub -> [XPubSpec]
allxpubsls HashMap Address AddressXPub
addrmap
  [(Int, XPubSpec)]
-> ((Int, XPubSpec) -> CacheX m ()) -> CacheX m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [XPubSpec] -> [(Int, XPubSpec)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int) ..] [XPubSpec]
xpubs) (((Int, XPubSpec) -> CacheX m ()) -> CacheX m ())
-> ((Int, XPubSpec) -> CacheX m ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, XPubSpec
xpub) -> do
    LogSource
xpubtxt <- XPubSpec -> CacheX m LogSource
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m LogSource
xpubText XPubSpec
xpub
    $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
      LogSource
"Affected xpub "
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
i)
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
"/"
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubSpec] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
xpubs))
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
": "
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
xpubtxt
  [(Address, AddressXPub)]
addrs' <- do
    $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
      LogSource
"Getting xpub balances for "
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubSpec] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
xpubs))
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" xpubs"
    HashMap XPubSpec [XPubBal]
xmap <- [XPubSpec] -> ReaderT CacheConfig m (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
MonadLoggerIO m =>
[XPubSpec] -> ReaderT CacheConfig m (HashMap XPubSpec [XPubBal])
getxbals [XPubSpec]
xpubs
    let addrmap' :: HashMap Address AddressXPub
addrmap' = HashSet XPubSpec
-> HashMap Address AddressXPub -> HashMap Address AddressXPub
forall (t :: * -> *) k.
Foldable t =>
t XPubSpec -> HashMap k AddressXPub -> HashMap k AddressXPub
faddrmap (HashMap XPubSpec [XPubBal] -> HashSet XPubSpec
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap XPubSpec [XPubBal]
xmap) HashMap Address AddressXPub
addrmap
    $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Starting Redis import pipeline"
    Redis (Either Reply ()) -> CacheX m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> CacheX m ())
-> Redis (Either Reply ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
      Either Reply ()
x <- HashMap Address AddressXPub
-> HashMap OutPoint Unspent -> [TxData] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
HashMap Address AddressXPub
-> HashMap OutPoint Unspent -> [TxData] -> m (f ())
redisImportMultiTx HashMap Address AddressXPub
addrmap' HashMap OutPoint Unspent
unspentmap [TxData]
txs
      Either Reply ()
y <- HashMap Address AddressXPub
-> HashMap Address Balance -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
HashMap Address AddressXPub -> HashMap Address Balance -> m (f ())
redisUpdateBalances HashMap Address AddressXPub
addrmap' HashMap Address Balance
balmap
      Either Reply ()
z <- Int64 -> [XPubSpec] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, RedisCtx m f, Real a) =>
a -> [XPubSpec] -> m (f ())
redisTouchKeys Int64
now (HashMap XPubSpec [XPubBal] -> [XPubSpec]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap XPubSpec [XPubBal]
xmap)
      return $ Either Reply ()
x Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
y Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
z Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either Reply ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Completed Redis pipeline"
    return $ BlockHeight
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
-> [(Address, AddressXPub)]
getNewAddrs BlockHeight
gap HashMap XPubSpec [XPubBal]
xmap (HashMap Address AddressXPub -> [AddressXPub]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap Address AddressXPub
addrmap')
  [(Address, AddressXPub)] -> CacheX m ()
forall (m :: * -> *).
(StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
[(Address, AddressXPub)] -> CacheX m ()
cacheAddAddresses [(Address, AddressXPub)]
addrs'
  where
    alladdrsls :: [Address]
alladdrsls = HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
alladdrs
    faddrmap :: t XPubSpec -> HashMap k AddressXPub -> HashMap k AddressXPub
faddrmap t XPubSpec
xmap = (AddressXPub -> Bool)
-> HashMap k AddressXPub -> HashMap k AddressXPub
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (\AddressXPub
a -> AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
a XPubSpec -> t XPubSpec -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t XPubSpec
xmap)
    getaddrmap :: ReaderT CacheConfig m (HashMap Address AddressXPub)
getaddrmap =
      [(Address, AddressXPub)] -> HashMap Address AddressXPub
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, AddressXPub)] -> HashMap Address AddressXPub)
-> ([Maybe AddressXPub] -> [(Address, AddressXPub)])
-> [Maybe AddressXPub]
-> HashMap Address AddressXPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Address, AddressXPub)] -> [(Address, AddressXPub)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Address, AddressXPub)] -> [(Address, AddressXPub)])
-> ([Maybe AddressXPub] -> [Maybe (Address, AddressXPub)])
-> [Maybe AddressXPub]
-> [(Address, AddressXPub)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address -> Maybe AddressXPub -> Maybe (Address, AddressXPub))
-> [Address]
-> [Maybe AddressXPub]
-> [Maybe (Address, AddressXPub)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Address
a -> (AddressXPub -> (Address, AddressXPub))
-> Maybe AddressXPub -> Maybe (Address, AddressXPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address
a,)) [Address]
alladdrsls
        ([Maybe AddressXPub] -> HashMap Address AddressXPub)
-> ReaderT CacheConfig m [Maybe AddressXPub]
-> ReaderT CacheConfig m (HashMap Address AddressXPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Address] -> ReaderT CacheConfig m [Maybe AddressXPub]
forall (m :: * -> *).
MonadLoggerIO m =>
[Address] -> CacheX m [Maybe AddressXPub]
cacheGetAddrsInfo [Address]
alladdrsls
    getunspents :: ReaderT CacheConfig m (HashMap OutPoint Unspent)
getunspents =
      [(OutPoint, Unspent)] -> HashMap OutPoint Unspent
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(OutPoint, Unspent)] -> HashMap OutPoint Unspent)
-> ([Maybe Unspent] -> [(OutPoint, Unspent)])
-> [Maybe Unspent]
-> HashMap OutPoint Unspent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (OutPoint, Unspent)] -> [(OutPoint, Unspent)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (OutPoint, Unspent)] -> [(OutPoint, Unspent)])
-> ([Maybe Unspent] -> [Maybe (OutPoint, Unspent)])
-> [Maybe Unspent]
-> [(OutPoint, Unspent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OutPoint -> Maybe Unspent -> Maybe (OutPoint, Unspent))
-> [OutPoint] -> [Maybe Unspent] -> [Maybe (OutPoint, Unspent)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\OutPoint
p -> (Unspent -> (OutPoint, Unspent))
-> Maybe Unspent -> Maybe (OutPoint, Unspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutPoint
p,)) [OutPoint]
allops
        ([Maybe Unspent] -> HashMap OutPoint Unspent)
-> ReaderT CacheConfig m [Maybe Unspent]
-> ReaderT CacheConfig m (HashMap OutPoint Unspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Maybe Unspent] -> ReaderT CacheConfig m [Maybe Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((OutPoint -> m (Maybe Unspent)) -> [OutPoint] -> m [Maybe Unspent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent [OutPoint]
allops)
    getbalances :: [Address] -> t m (HashMap Address Balance)
getbalances [Address]
addrs =
      [(Address, Balance)] -> HashMap Address Balance
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Balance)] -> HashMap Address Balance)
-> ([Balance] -> [(Address, Balance)])
-> [Balance]
-> HashMap Address Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> [Balance] -> [(Address, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Address]
addrs ([Balance] -> HashMap Address Balance)
-> t m [Balance] -> t m (HashMap Address Balance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address -> t m Balance) -> [Address] -> t m [Balance]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m Balance -> t m Balance
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Balance -> t m Balance)
-> (Address -> m Balance) -> Address -> t m Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance) [Address]
addrs
    getxbals :: [XPubSpec] -> ReaderT CacheConfig m (HashMap XPubSpec [XPubBal])
getxbals [XPubSpec]
xpubs = do
      [(XPubSpec, [XPubBal])]
bals <- Redis (Either Reply [(XPubSpec, [XPubBal])])
-> CacheX m [(XPubSpec, [XPubBal])]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(XPubSpec, [XPubBal])])
 -> CacheX m [(XPubSpec, [XPubBal])])
-> ((XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
    -> Redis (Either Reply [(XPubSpec, [XPubBal])]))
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> CacheX m [(XPubSpec, [XPubBal])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Either Reply (XPubSpec, [XPubBal])]
 -> Either Reply [(XPubSpec, [XPubBal])])
-> Redis [Either Reply (XPubSpec, [XPubBal])]
-> Redis (Either Reply [(XPubSpec, [XPubBal])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either Reply (XPubSpec, [XPubBal])]
-> Either Reply [(XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Redis [Either Reply (XPubSpec, [XPubBal])]
 -> Redis (Either Reply [(XPubSpec, [XPubBal])]))
-> ((XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
    -> Redis [Either Reply (XPubSpec, [XPubBal])])
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> Redis (Either Reply [(XPubSpec, [XPubBal])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XPubSpec]
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> Redis [Either Reply (XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [XPubSpec]
xpubs ((XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
 -> CacheX m [(XPubSpec, [XPubBal])])
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> CacheX m [(XPubSpec, [XPubBal])]
forall a b. (a -> b) -> a -> b
$ \XPubSpec
xpub -> do
        Either Reply [XPubBal]
bs <- XPubSpec -> Redis (Either Reply [XPubBal])
forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub
        return $ (,) XPubSpec
xpub ([XPubBal] -> (XPubSpec, [XPubBal]))
-> Either Reply [XPubBal] -> Either Reply (XPubSpec, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Reply [XPubBal]
bs
      return $ ([XPubBal] -> Bool)
-> HashMap XPubSpec [XPubBal] -> HashMap XPubSpec [XPubBal]
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (Bool -> Bool
not (Bool -> Bool) -> ([XPubBal] -> Bool) -> [XPubBal] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XPubBal] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(XPubSpec, [XPubBal])]
bals)
    allops :: [OutPoint]
allops = ((Address, OutPoint) -> OutPoint)
-> [(Address, OutPoint)] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map (Address, OutPoint) -> OutPoint
forall a b. (a, b) -> b
snd ([(Address, OutPoint)] -> [OutPoint])
-> [(Address, OutPoint)] -> [OutPoint]
forall a b. (a -> b) -> a -> b
$ (TxData -> [(Address, OutPoint)])
-> [TxData] -> [(Address, OutPoint)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TxData -> [(Address, OutPoint)]
txInputs [TxData]
txs [(Address, OutPoint)]
-> [(Address, OutPoint)] -> [(Address, OutPoint)]
forall a. Semigroup a => a -> a -> a
<> (TxData -> [(Address, OutPoint)])
-> [TxData] -> [(Address, OutPoint)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TxData -> [(Address, OutPoint)]
txOutputs [TxData]
txs
    alladdrs :: HashSet Address
alladdrs =
      [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address)
-> ([(Address, OutPoint)] -> [Address])
-> [(Address, OutPoint)]
-> HashSet Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, OutPoint) -> Address)
-> [(Address, OutPoint)] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Address, OutPoint) -> Address
forall a b. (a, b) -> a
fst ([(Address, OutPoint)] -> HashSet Address)
-> [(Address, OutPoint)] -> HashSet Address
forall a b. (a -> b) -> a -> b
$
        (TxData -> [(Address, OutPoint)])
-> [TxData] -> [(Address, OutPoint)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TxData -> [(Address, OutPoint)]
txInputs [TxData]
txs [(Address, OutPoint)]
-> [(Address, OutPoint)] -> [(Address, OutPoint)]
forall a. Semigroup a => a -> a -> a
<> (TxData -> [(Address, OutPoint)])
-> [TxData] -> [(Address, OutPoint)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TxData -> [(Address, OutPoint)]
txOutputs [TxData]
txs
    allxpubsls :: HashMap k AddressXPub -> [XPubSpec]
allxpubsls HashMap k AddressXPub
addrmap = HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList (HashMap k AddressXPub -> HashSet XPubSpec
forall k. HashMap k AddressXPub -> HashSet XPubSpec
allxpubs HashMap k AddressXPub
addrmap)
    allxpubs :: HashMap k AddressXPub -> HashSet XPubSpec
allxpubs HashMap k AddressXPub
addrmap =
      [XPubSpec] -> HashSet XPubSpec
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([XPubSpec] -> HashSet XPubSpec)
-> ([AddressXPub] -> [XPubSpec])
-> [AddressXPub]
-> HashSet XPubSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressXPub -> XPubSpec) -> [AddressXPub] -> [XPubSpec]
forall a b. (a -> b) -> [a] -> [b]
map AddressXPub -> XPubSpec
addressXPubSpec ([AddressXPub] -> HashSet XPubSpec)
-> [AddressXPub] -> HashSet XPubSpec
forall a b. (a -> b) -> a -> b
$ HashMap k AddressXPub -> [AddressXPub]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap k AddressXPub
addrmap

redisImportMultiTx ::
  (Monad f, RedisCtx m f) =>
  HashMap Address AddressXPub ->
  HashMap OutPoint Unspent ->
  [TxData] ->
  m (f ())
redisImportMultiTx :: HashMap Address AddressXPub
-> HashMap OutPoint Unspent -> [TxData] -> m (f ())
redisImportMultiTx HashMap Address AddressXPub
addrmap HashMap OutPoint Unspent
unspentmap [TxData]
txs = do
  [f ()]
xs <- (TxData -> m (f ())) -> [TxData] -> m [f ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxData -> m (f ())
forall (f :: * -> *) (m :: * -> *).
(RedisCtx f m, Monad m) =>
TxData -> f (m ())
importtxentries [TxData]
txs
  return $ [f ()] -> f ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f ()]
xs
  where
    uns :: OutPoint -> AddressXPub -> m (f Integer)
uns OutPoint
p AddressXPub
i =
      case OutPoint -> HashMap OutPoint Unspent -> Maybe Unspent
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup OutPoint
p HashMap OutPoint Unspent
unspentmap of
        Just Unspent
u ->
          XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i) [(OutPoint
p, Unspent -> BlockRef
unspentBlock Unspent
u)]
        Maybe Unspent
Nothing -> XPubSpec -> [OutPoint] -> m (f Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [OutPoint] -> m (f Integer)
redisRemXPubUnspents (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i) [OutPoint
p]
    addtx :: TxData -> Address -> OutPoint -> f (m ())
addtx TxData
tx Address
a OutPoint
p =
      case Address -> HashMap Address AddressXPub -> Maybe AddressXPub
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Address
a HashMap Address AddressXPub
addrmap of
        Just AddressXPub
i -> do
          let tr :: TxRef
tr =
                TxRef :: BlockRef -> TxHash -> TxRef
TxRef
                  { txRefHash :: TxHash
txRefHash = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
tx),
                    txRefBlock :: BlockRef
txRefBlock = TxData -> BlockRef
txDataBlock TxData
tx
                  }
          m Integer
x <- XPubSpec -> [TxRef] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i) [TxRef
tr]
          m Integer
y <- OutPoint -> AddressXPub -> f (m Integer)
forall (m :: * -> *) (f :: * -> *).
(RedisCtx m f, Applicative f) =>
OutPoint -> AddressXPub -> m (f Integer)
uns OutPoint
p AddressXPub
i
          return $ m Integer
x m Integer -> m Integer -> m Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer
y m Integer -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe AddressXPub
Nothing -> m () -> f (m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    remtx :: TxData -> Address -> OutPoint -> f (m ())
remtx TxData
tx Address
a OutPoint
p =
      case Address -> HashMap Address AddressXPub -> Maybe AddressXPub
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Address
a HashMap Address AddressXPub
addrmap of
        Just AddressXPub
i -> do
          m Integer
x <- XPubSpec -> [TxHash] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i) [Tx -> TxHash
txHash (TxData -> Tx
txData TxData
tx)]
          m Integer
y <- OutPoint -> AddressXPub -> f (m Integer)
forall (m :: * -> *) (f :: * -> *).
(RedisCtx m f, Applicative f) =>
OutPoint -> AddressXPub -> m (f Integer)
uns OutPoint
p AddressXPub
i
          return $ m Integer
x m Integer -> m Integer -> m Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer
y m Integer -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe AddressXPub
Nothing -> m () -> f (m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    importtxentries :: TxData -> f (m ())
importtxentries TxData
tx =
      if TxData -> Bool
txDataDeleted TxData
tx
        then do
          [m ()]
x <- ((Address, OutPoint) -> f (m ()))
-> [(Address, OutPoint)] -> f [m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Address -> OutPoint -> f (m ()))
-> (Address, OutPoint) -> f (m ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TxData -> Address -> OutPoint -> f (m ())
forall (f :: * -> *) (m :: * -> *).
(RedisCtx f m, Monad m) =>
TxData -> Address -> OutPoint -> f (m ())
remtx TxData
tx)) (TxData -> [(Address, OutPoint)]
txaddrops TxData
tx)
          m Integer
y <- [TxHash] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
[TxHash] -> m (f Integer)
redisRemFromMempool [Tx -> TxHash
txHash (TxData -> Tx
txData TxData
tx)]
          return $ [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
x m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m Integer
y
        else do
          m [()]
a <- [m ()] -> m [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m ()] -> m [()]) -> f [m ()] -> f (m [()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Address, OutPoint) -> f (m ()))
-> [(Address, OutPoint)] -> f [m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Address -> OutPoint -> f (m ()))
-> (Address, OutPoint) -> f (m ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (TxData -> Address -> OutPoint -> f (m ())
forall (f :: * -> *) (m :: * -> *).
(RedisCtx f m, Monad m) =>
TxData -> Address -> OutPoint -> f (m ())
addtx TxData
tx)) (TxData -> [(Address, OutPoint)]
txaddrops TxData
tx)
          m Integer
b <-
            case TxData -> BlockRef
txDataBlock TxData
tx of
              b :: BlockRef
b@MemRef {} ->
                let tr :: TxRef
tr =
                      TxRef :: BlockRef -> TxHash -> TxRef
TxRef
                        { txRefHash :: TxHash
txRefHash = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
tx),
                          txRefBlock :: BlockRef
txRefBlock = BlockRef
b
                        }
                 in [TxRef] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
[TxRef] -> m (f Integer)
redisAddToMempool [TxRef
tr]
              BlockRef
_ -> [TxHash] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
[TxHash] -> m (f Integer)
redisRemFromMempool [Tx -> TxHash
txHash (TxData -> Tx
txData TxData
tx)]
          return $ m [()]
a m [()] -> m Integer -> m Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer
b m Integer -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    txaddrops :: TxData -> [(Address, OutPoint)]
txaddrops TxData
td = TxData -> [(Address, OutPoint)]
txInputs TxData
td [(Address, OutPoint)]
-> [(Address, OutPoint)] -> [(Address, OutPoint)]
forall a. Semigroup a => a -> a -> a
<> TxData -> [(Address, OutPoint)]
txOutputs TxData
td

redisUpdateBalances ::
  (Monad f, RedisCtx m f) =>
  HashMap Address AddressXPub ->
  HashMap Address Balance ->
  m (f ())
redisUpdateBalances :: HashMap Address AddressXPub -> HashMap Address Balance -> m (f ())
redisUpdateBalances HashMap Address AddressXPub
addrmap HashMap Address Balance
balmap =
  ([f ()] -> f ()) -> m [f ()] -> m (f ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([()] -> ()) -> f [()] -> f ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [()] -> ()
forall a. Monoid a => [a] -> a
mconcat (f [()] -> f ()) -> ([f ()] -> f [()]) -> [f ()] -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [f ()] -> f [()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence) (m [f ()] -> m (f ()))
-> ((Address -> m (f ())) -> m [f ()])
-> (Address -> m (f ()))
-> m (f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> (Address -> m (f ())) -> m [f ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap Address AddressXPub -> [Address]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Address AddressXPub
addrmap) ((Address -> m (f ())) -> m (f ()))
-> (Address -> m (f ())) -> m (f ())
forall a b. (a -> b) -> a -> b
$ \Address
a ->
    case (Address -> HashMap Address AddressXPub -> Maybe AddressXPub
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Address
a HashMap Address AddressXPub
addrmap, Address -> HashMap Address Balance -> Maybe Balance
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Address
a HashMap Address Balance
balmap) of
      (Just AddressXPub
ainfo, Just Balance
bal) ->
        XPubSpec -> [XPubBal] -> m (f ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
ainfo) [AddressXPub -> Balance -> XPubBal
xpubbal AddressXPub
ainfo Balance
bal]
      (Maybe AddressXPub, Maybe Balance)
_ -> f () -> m (f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  where
    xpubbal :: AddressXPub -> Balance -> XPubBal
xpubbal AddressXPub
ainfo Balance
bal =
      XPubBal :: [BlockHeight] -> Balance -> XPubBal
XPubBal {xPubBalPath :: [BlockHeight]
xPubBalPath = AddressXPub -> [BlockHeight]
addressXPubPath AddressXPub
ainfo, xPubBal :: Balance
xPubBal = Balance
bal}

cacheAddAddresses ::
  (StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
  [(Address, AddressXPub)] ->
  CacheX m ()
cacheAddAddresses :: [(Address, AddressXPub)] -> CacheX m ()
cacheAddAddresses [] = $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"No further addresses to add"
cacheAddAddresses [(Address, AddressXPub)]
addrs = do
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    LogSource
"Adding " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([(Address, AddressXPub)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Address, AddressXPub)]
addrs)) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" new generated addresses"
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Getting balances"
  HashMap XPubSpec [XPubBal]
balmap <- ([XPubBal] -> [XPubBal] -> [XPubBal])
-> [(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith [XPubBal] -> [XPubBal] -> [XPubBal]
forall a. Semigroup a => a -> a -> a
(<>) ([(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal])
-> ReaderT CacheConfig m [(XPubSpec, [XPubBal])]
-> ReaderT CacheConfig m (HashMap XPubSpec [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Address, AddressXPub)
 -> ReaderT CacheConfig m (XPubSpec, [XPubBal]))
-> [(Address, AddressXPub)]
-> ReaderT CacheConfig m [(XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Address
 -> AddressXPub -> ReaderT CacheConfig m (XPubSpec, [XPubBal]))
-> (Address, AddressXPub)
-> ReaderT CacheConfig m (XPubSpec, [XPubBal])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address
-> AddressXPub -> ReaderT CacheConfig m (XPubSpec, [XPubBal])
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, StoreReadBase m, Functor (t m)) =>
Address -> AddressXPub -> t m (XPubSpec, [XPubBal])
getbal) [(Address, AddressXPub)]
addrs
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Getting unspent outputs"
  HashMap XPubSpec [(OutPoint, BlockRef)]
utxomap <- ([(OutPoint, BlockRef)]
 -> [(OutPoint, BlockRef)] -> [(OutPoint, BlockRef)])
-> [(XPubSpec, [(OutPoint, BlockRef)])]
-> HashMap XPubSpec [(OutPoint, BlockRef)]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith [(OutPoint, BlockRef)]
-> [(OutPoint, BlockRef)] -> [(OutPoint, BlockRef)]
forall a. Semigroup a => a -> a -> a
(<>) ([(XPubSpec, [(OutPoint, BlockRef)])]
 -> HashMap XPubSpec [(OutPoint, BlockRef)])
-> ReaderT CacheConfig m [(XPubSpec, [(OutPoint, BlockRef)])]
-> ReaderT CacheConfig m (HashMap XPubSpec [(OutPoint, BlockRef)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Address, AddressXPub)
 -> ReaderT CacheConfig m (XPubSpec, [(OutPoint, BlockRef)]))
-> [(Address, AddressXPub)]
-> ReaderT CacheConfig m [(XPubSpec, [(OutPoint, BlockRef)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Address
 -> AddressXPub
 -> ReaderT CacheConfig m (XPubSpec, [(OutPoint, BlockRef)]))
-> (Address, AddressXPub)
-> ReaderT CacheConfig m (XPubSpec, [(OutPoint, BlockRef)])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address
-> AddressXPub
-> ReaderT CacheConfig m (XPubSpec, [(OutPoint, BlockRef)])
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, StoreReadExtra m, Functor (t m)) =>
Address -> AddressXPub -> t m (XPubSpec, [(OutPoint, BlockRef)])
getutxo) [(Address, AddressXPub)]
addrs
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Getting transactions"
  HashMap XPubSpec [TxRef]
txmap <- ([TxRef] -> [TxRef] -> [TxRef])
-> [(XPubSpec, [TxRef])] -> HashMap XPubSpec [TxRef]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith [TxRef] -> [TxRef] -> [TxRef]
forall a. Semigroup a => a -> a -> a
(<>) ([(XPubSpec, [TxRef])] -> HashMap XPubSpec [TxRef])
-> ReaderT CacheConfig m [(XPubSpec, [TxRef])]
-> ReaderT CacheConfig m (HashMap XPubSpec [TxRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Address, AddressXPub)
 -> ReaderT CacheConfig m (XPubSpec, [TxRef]))
-> [(Address, AddressXPub)]
-> ReaderT CacheConfig m [(XPubSpec, [TxRef])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Address
 -> AddressXPub -> ReaderT CacheConfig m (XPubSpec, [TxRef]))
-> (Address, AddressXPub)
-> ReaderT CacheConfig m (XPubSpec, [TxRef])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> AddressXPub -> ReaderT CacheConfig m (XPubSpec, [TxRef])
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, StoreReadExtra m, Functor (t m)) =>
Address -> AddressXPub -> t m (XPubSpec, [TxRef])
gettxmap) [(Address, AddressXPub)]
addrs
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Running Redis pipeline"
  Redis (Either Reply ()) -> CacheX m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> CacheX m ())
-> Redis (Either Reply ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
    [Either Reply ()]
a <- [(XPubSpec, [XPubBal])]
-> ((XPubSpec, [XPubBal]) -> Redis (Either Reply ()))
-> Redis [Either Reply ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [XPubBal]
balmap) ((XPubSpec -> [XPubBal] -> Redis (Either Reply ()))
-> (XPubSpec, [XPubBal]) -> Redis (Either Reply ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubSpec -> [XPubBal] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances)
    [Either Reply Integer]
b <- [(XPubSpec, [(OutPoint, BlockRef)])]
-> ((XPubSpec, [(OutPoint, BlockRef)])
    -> Redis (Either Reply Integer))
-> Redis [Either Reply Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap XPubSpec [(OutPoint, BlockRef)]
-> [(XPubSpec, [(OutPoint, BlockRef)])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [(OutPoint, BlockRef)]
utxomap) ((XPubSpec
 -> [(OutPoint, BlockRef)] -> Redis (Either Reply Integer))
-> (XPubSpec, [(OutPoint, BlockRef)])
-> Redis (Either Reply Integer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubSpec -> [(OutPoint, BlockRef)] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents)
    [Either Reply Integer]
c <- [(XPubSpec, [TxRef])]
-> ((XPubSpec, [TxRef]) -> Redis (Either Reply Integer))
-> Redis [Either Reply Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap XPubSpec [TxRef] -> [(XPubSpec, [TxRef])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [TxRef]
txmap) ((XPubSpec -> [TxRef] -> Redis (Either Reply Integer))
-> (XPubSpec, [TxRef]) -> Redis (Either Reply Integer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubSpec -> [TxRef] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs)
    return $ [Either Reply ()] -> Either Reply ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Either Reply ()]
a Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Either Reply Integer] -> Either Reply ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Either Reply Integer]
b Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Either Reply Integer] -> Either Reply ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Either Reply Integer]
c
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Completed Redis pipeline"
  let xpubs :: [XPubSpec]
xpubs =
        HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList
          (HashSet XPubSpec -> [XPubSpec])
-> ([AddressXPub] -> HashSet XPubSpec)
-> [AddressXPub]
-> [XPubSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XPubSpec] -> HashSet XPubSpec
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
          ([XPubSpec] -> HashSet XPubSpec)
-> ([AddressXPub] -> [XPubSpec])
-> [AddressXPub]
-> HashSet XPubSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressXPub -> XPubSpec) -> [AddressXPub] -> [XPubSpec]
forall a b. (a -> b) -> [a] -> [b]
map AddressXPub -> XPubSpec
addressXPubSpec
          ([AddressXPub] -> [XPubSpec]) -> [AddressXPub] -> [XPubSpec]
forall a b. (a -> b) -> a -> b
$ Map Address AddressXPub -> [AddressXPub]
forall k a. Map k a -> [a]
Map.elems Map Address AddressXPub
amap
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" LogSource
"Getting xpub balances"
  HashMap XPubSpec [XPubBal]
xmap <- [XPubSpec] -> ReaderT CacheConfig m (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
MonadLoggerIO m =>
[XPubSpec] -> ReaderT CacheConfig m (HashMap XPubSpec [XPubBal])
getbals [XPubSpec]
xpubs
  BlockHeight
gap <- m BlockHeight -> ReaderT CacheConfig m BlockHeight
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getMaxGap
  let notnulls :: [AddressXPub]
notnulls = HashMap XPubSpec [XPubBal] -> [AddressXPub]
getnotnull HashMap XPubSpec [XPubBal]
balmap
      addrs' :: [(Address, AddressXPub)]
addrs' = BlockHeight
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
-> [(Address, AddressXPub)]
getNewAddrs BlockHeight
gap HashMap XPubSpec [XPubBal]
xmap [AddressXPub]
notnulls
  [(Address, AddressXPub)] -> CacheX m ()
forall (m :: * -> *).
(StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
[(Address, AddressXPub)] -> CacheX m ()
cacheAddAddresses [(Address, AddressXPub)]
addrs'
  where
    getbals :: [XPubSpec] -> CacheX m (HashMap XPubSpec [XPubBal])
getbals [XPubSpec]
xpubs = Redis (Either Reply (HashMap XPubSpec [XPubBal]))
-> CacheX m (HashMap XPubSpec [XPubBal])
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply (HashMap XPubSpec [XPubBal]))
 -> CacheX m (HashMap XPubSpec [XPubBal]))
-> Redis (Either Reply (HashMap XPubSpec [XPubBal]))
-> CacheX m (HashMap XPubSpec [XPubBal])
forall a b. (a -> b) -> a -> b
$ do
      Either Reply [[XPubBal]]
bs <- [Either Reply [XPubBal]] -> Either Reply [[XPubBal]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either Reply [XPubBal]] -> Either Reply [[XPubBal]])
-> Redis [Either Reply [XPubBal]]
-> Redis (Either Reply [[XPubBal]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XPubSpec]
-> (XPubSpec -> Redis (Either Reply [XPubBal]))
-> Redis [Either Reply [XPubBal]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [XPubSpec]
xpubs XPubSpec -> Redis (Either Reply [XPubBal])
forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances
      return $
        ([XPubBal] -> Bool)
-> HashMap XPubSpec [XPubBal] -> HashMap XPubSpec [XPubBal]
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (Bool -> Bool
not (Bool -> Bool) -> ([XPubBal] -> Bool) -> [XPubBal] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XPubBal] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (HashMap XPubSpec [XPubBal] -> HashMap XPubSpec [XPubBal])
-> ([[XPubBal]] -> HashMap XPubSpec [XPubBal])
-> [[XPubBal]]
-> HashMap XPubSpec [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal])
-> ([[XPubBal]] -> [(XPubSpec, [XPubBal])])
-> [[XPubBal]]
-> HashMap XPubSpec [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XPubSpec] -> [[XPubBal]] -> [(XPubSpec, [XPubBal])]
forall a b. [a] -> [b] -> [(a, b)]
zip [XPubSpec]
xpubs ([[XPubBal]] -> HashMap XPubSpec [XPubBal])
-> Either Reply [[XPubBal]]
-> Either Reply (HashMap XPubSpec [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Reply [[XPubBal]]
bs
    amap :: Map Address AddressXPub
amap = [(Address, AddressXPub)] -> Map Address AddressXPub
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Address, AddressXPub)]
addrs
    getnotnull :: HashMap XPubSpec [XPubBal] -> [AddressXPub]
getnotnull =
      let f :: XPubSpec -> [XPubBal] -> [AddressXPub]
f XPubSpec
xpub =
            (XPubBal -> AddressXPub) -> [XPubBal] -> [AddressXPub]
forall a b. (a -> b) -> [a] -> [b]
map ((XPubBal -> AddressXPub) -> [XPubBal] -> [AddressXPub])
-> (XPubBal -> AddressXPub) -> [XPubBal] -> [AddressXPub]
forall a b. (a -> b) -> a -> b
$ \XPubBal
bal ->
              AddressXPub :: XPubSpec -> [BlockHeight] -> AddressXPub
AddressXPub
                { addressXPubSpec :: XPubSpec
addressXPubSpec = XPubSpec
xpub,
                  addressXPubPath :: [BlockHeight]
addressXPubPath = XPubBal -> [BlockHeight]
xPubBalPath XPubBal
bal
                }
          g :: [XPubBal] -> [XPubBal]
g = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (XPubBal -> Bool) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal)
       in ((XPubSpec, [XPubBal]) -> [AddressXPub])
-> [(XPubSpec, [XPubBal])] -> [AddressXPub]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubSpec -> [XPubBal] -> [AddressXPub])
-> (XPubSpec, [XPubBal]) -> [AddressXPub]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubSpec -> [XPubBal] -> [AddressXPub]
f) ([(XPubSpec, [XPubBal])] -> [AddressXPub])
-> (HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])])
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])])
-> (HashMap XPubSpec [XPubBal] -> HashMap XPubSpec [XPubBal])
-> HashMap XPubSpec [XPubBal]
-> [(XPubSpec, [XPubBal])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> [XPubBal])
-> HashMap XPubSpec [XPubBal] -> HashMap XPubSpec [XPubBal]
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map [XPubBal] -> [XPubBal]
g
    getbal :: Address -> AddressXPub -> t m (XPubSpec, [XPubBal])
getbal Address
a AddressXPub
i =
      let f :: Balance -> (XPubSpec, [XPubBal])
f Balance
b =
            ( AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i,
              [XPubBal :: [BlockHeight] -> Balance -> XPubBal
XPubBal {xPubBal :: Balance
xPubBal = Balance
b, xPubBalPath :: [BlockHeight]
xPubBalPath = AddressXPub -> [BlockHeight]
addressXPubPath AddressXPub
i}]
            )
       in Balance -> (XPubSpec, [XPubBal])
f (Balance -> (XPubSpec, [XPubBal]))
-> t m Balance -> t m (XPubSpec, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Balance -> t m Balance
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Address -> m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
a)
    getutxo :: Address -> AddressXPub -> t m (XPubSpec, [(OutPoint, BlockRef)])
getutxo Address
a AddressXPub
i =
      let f :: [Unspent] -> (XPubSpec, [(OutPoint, BlockRef)])
f [Unspent]
us =
            ( AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i,
              (Unspent -> (OutPoint, BlockRef))
-> [Unspent] -> [(OutPoint, BlockRef)]
forall a b. (a -> b) -> [a] -> [b]
map (\Unspent
u -> (Unspent -> OutPoint
unspentPoint Unspent
u, Unspent -> BlockRef
unspentBlock Unspent
u)) [Unspent]
us
            )
       in [Unspent] -> (XPubSpec, [(OutPoint, BlockRef)])
f ([Unspent] -> (XPubSpec, [(OutPoint, BlockRef)]))
-> t m [Unspent] -> t m (XPubSpec, [(OutPoint, BlockRef)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Unspent] -> t m [Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Address -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
a Limits
forall a. Default a => a
def)
    gettxmap :: Address -> AddressXPub -> t m (XPubSpec, [TxRef])
gettxmap Address
a AddressXPub
i =
      let f :: b -> (XPubSpec, b)
f b
ts = (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
i, b
ts)
       in [TxRef] -> (XPubSpec, [TxRef])
forall b. b -> (XPubSpec, b)
f ([TxRef] -> (XPubSpec, [TxRef]))
-> t m [TxRef] -> t m (XPubSpec, [TxRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [TxRef] -> t m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a Limits
forall a. Default a => a
def)

getNewAddrs ::
  KeyIndex ->
  HashMap XPubSpec [XPubBal] ->
  [AddressXPub] ->
  [(Address, AddressXPub)]
getNewAddrs :: BlockHeight
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
-> [(Address, AddressXPub)]
getNewAddrs BlockHeight
gap HashMap XPubSpec [XPubBal]
xpubs =
  (AddressXPub -> [(Address, AddressXPub)])
-> [AddressXPub] -> [(Address, AddressXPub)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((AddressXPub -> [(Address, AddressXPub)])
 -> [AddressXPub] -> [(Address, AddressXPub)])
-> (AddressXPub -> [(Address, AddressXPub)])
-> [AddressXPub]
-> [(Address, AddressXPub)]
forall a b. (a -> b) -> a -> b
$ \AddressXPub
a ->
    case XPubSpec -> HashMap XPubSpec [XPubBal] -> Maybe [XPubBal]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
a) HashMap XPubSpec [XPubBal]
xpubs of
      Maybe [XPubBal]
Nothing -> []
      Just [XPubBal]
bals -> BlockHeight -> [XPubBal] -> AddressXPub -> [(Address, AddressXPub)]
addrsToAdd BlockHeight
gap [XPubBal]
bals AddressXPub
a

syncMempoolC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m ()
syncMempoolC :: CacheX m ()
syncMempoolC = CacheX m () -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CacheX m () -> CacheX m ())
-> (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheX m () -> CacheX m ()
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m a
withLockForever (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
  HashSet TxHash
nodepool <- [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> ([(UnixTime, TxHash)] -> [TxHash])
-> [(UnixTime, TxHash)]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnixTime, TxHash) -> TxHash) -> [(UnixTime, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (UnixTime, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(UnixTime, TxHash)] -> HashSet TxHash)
-> ReaderT CacheConfig m [(UnixTime, TxHash)]
-> ReaderT CacheConfig m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [(UnixTime, TxHash)]
-> ReaderT CacheConfig m [(UnixTime, TxHash)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(UnixTime, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)]
getMempool
  HashSet TxHash
cachepool <- [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> ([(UnixTime, TxHash)] -> [TxHash])
-> [(UnixTime, TxHash)]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnixTime, TxHash) -> TxHash) -> [(UnixTime, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (UnixTime, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(UnixTime, TxHash)] -> HashSet TxHash)
-> ReaderT CacheConfig m [(UnixTime, TxHash)]
-> ReaderT CacheConfig m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT CacheConfig m [(UnixTime, TxHash)]
forall (m :: * -> *).
MonadLoggerIO m =>
CacheX m [(UnixTime, TxHash)]
cacheGetMempool
  HashSet TxHash -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
HashSet TxHash -> ReaderT CacheConfig m ()
getem (HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
nodepool HashSet TxHash
cachepool)
  HashSet TxHash -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
HashSet TxHash -> ReaderT CacheConfig m ()
getem (HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
cachepool HashSet TxHash
nodepool)
  where
    getem :: HashSet TxHash -> ReaderT CacheConfig m ()
getem HashSet TxHash
tset = do
      let tids :: [TxHash]
tids = HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
tset
      [TxData]
txs <- [Maybe TxData] -> [TxData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TxData] -> [TxData])
-> ReaderT CacheConfig m [Maybe TxData]
-> ReaderT CacheConfig m [TxData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ReaderT CacheConfig m (Maybe TxData))
-> [TxHash] -> ReaderT CacheConfig m [Maybe TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData))
-> (TxHash -> m (Maybe TxData))
-> TxHash
-> ReaderT CacheConfig m (Maybe TxData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData) [TxHash]
tids
      Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TxData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxData]
txs) (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ do
        $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logDebugS) LogSource
"Cache" (LogSource -> ReaderT CacheConfig m ())
-> LogSource -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
          LogSource
"Importing mempool transactions: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
txs))
        [TxData] -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC [TxData]
txs

cacheGetMempool :: MonadLoggerIO m => CacheX m [(UnixTime, TxHash)]
cacheGetMempool :: CacheX m [(UnixTime, TxHash)]
cacheGetMempool = Redis (Either Reply [(UnixTime, TxHash)])
-> CacheX m [(UnixTime, TxHash)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply [(UnixTime, TxHash)])
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
m (f [(UnixTime, TxHash)])
redisGetMempool

cacheIsInMempool :: MonadLoggerIO m => TxHash -> CacheX m Bool
cacheIsInMempool :: TxHash -> CacheX m Bool
cacheIsInMempool = Redis (Either Reply Bool) -> CacheX m Bool
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply Bool) -> CacheX m Bool)
-> (TxHash -> Redis (Either Reply Bool)) -> TxHash -> CacheX m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> Redis (Either Reply Bool)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
TxHash -> m (f Bool)
redisIsInMempool

cacheGetHead :: MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead :: CacheX m (Maybe BlockHash)
cacheGetHead = Redis (Either Reply (Maybe BlockHash))
-> CacheX m (Maybe BlockHash)
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply (Maybe BlockHash))
forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
m (f (Maybe BlockHash))
redisGetHead

cacheSetHead :: (MonadLoggerIO m, StoreReadBase m) => BlockHash -> CacheX m ()
cacheSetHead :: BlockHash -> CacheX m ()
cacheSetHead BlockHash
bh = do
  $(LogSource -> LogSource -> CacheX m ()
logDebugS) LogSource
"Cache" (LogSource -> CacheX m ()) -> LogSource -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Cache head set to: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
  ReaderT CacheConfig m Status -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m Status -> CacheX m ())
-> ReaderT CacheConfig m Status -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Redis (Either Reply Status) -> ReaderT CacheConfig m Status
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (BlockHash -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
BlockHash -> m (f Status)
redisSetHead BlockHash
bh)

cacheGetAddrsInfo ::
  MonadLoggerIO m => [Address] -> CacheX m [Maybe AddressXPub]
cacheGetAddrsInfo :: [Address] -> CacheX m [Maybe AddressXPub]
cacheGetAddrsInfo [Address]
as = Redis (Either Reply [Maybe AddressXPub])
-> CacheX m [Maybe AddressXPub]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis ([Address] -> Redis (Either Reply [Maybe AddressXPub])
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
[Address] -> m (f [Maybe AddressXPub])
redisGetAddrsInfo [Address]
as)

redisAddToMempool :: (Applicative f, RedisCtx m f) => [TxRef] -> m (f Integer)
redisAddToMempool :: [TxRef] -> m (f Integer)
redisAddToMempool [] = f Integer -> m (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisAddToMempool [TxRef]
btxs =
  ByteString -> [(Double, ByteString)] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd ByteString
mempoolSetKey ([(Double, ByteString)] -> m (f Integer))
-> [(Double, ByteString)] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$
    (TxRef -> (Double, ByteString))
-> [TxRef] -> [(Double, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map
      (\TxRef
btx -> (BlockRef -> Double
blockRefScore (TxRef -> BlockRef
txRefBlock TxRef
btx), TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode (TxRef -> TxHash
txRefHash TxRef
btx)))
      [TxRef]
btxs

redisIsInMempool :: (Applicative f, RedisCtx m f) => TxHash -> m (f Bool)
redisIsInMempool :: TxHash -> m (f Bool)
redisIsInMempool TxHash
txid =
  (Maybe Integer -> Bool) -> f (Maybe Integer) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (f (Maybe Integer) -> f Bool)
-> m (f (Maybe Integer)) -> m (f Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> m (f (Maybe Integer))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Redis.zrank ByteString
mempoolSetKey (TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode TxHash
txid)

redisRemFromMempool ::
  (Applicative f, RedisCtx m f) => [TxHash] -> m (f Integer)
redisRemFromMempool :: [TxHash] -> m (f Integer)
redisRemFromMempool [] = f Integer -> m (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisRemFromMempool [TxHash]
xs = ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
zrem ByteString
mempoolSetKey ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ (TxHash -> ByteString) -> [TxHash] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode [TxHash]
xs

redisSetAddrInfo ::
  (Functor f, RedisCtx m f) => Address -> AddressXPub -> m (f ())
redisSetAddrInfo :: Address -> AddressXPub -> m (f ())
redisSetAddrInfo Address
a AddressXPub
i = f Status -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f Status -> f ()) -> m (f Status) -> m (f ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> m (f Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set (ByteString
addrPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Address -> ByteString
forall a. Serialize a => a -> ByteString
encode Address
a) (AddressXPub -> ByteString
forall a. Serialize a => a -> ByteString
encode AddressXPub
i)

cacheDelXPubs ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  [XPubSpec] ->
  CacheT m Integer
cacheDelXPubs :: [XPubSpec] -> CacheT m Integer
cacheDelXPubs [XPubSpec]
xpubs = (Maybe CacheConfig -> m Integer) -> CacheT m Integer
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Maybe CacheConfig -> m Integer) -> CacheT m Integer)
-> (Maybe CacheConfig -> m Integer) -> CacheT m Integer
forall a b. (a -> b) -> a -> b
$ \case
  Just CacheConfig
cache -> ReaderT CacheConfig m Integer -> CacheConfig -> m Integer
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([XPubSpec] -> ReaderT CacheConfig m Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheX m Integer
delXPubKeys [XPubSpec]
xpubs) CacheConfig
cache
  Maybe CacheConfig
Nothing -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0

delXPubKeys ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  [XPubSpec] ->
  CacheX m Integer
delXPubKeys :: [XPubSpec] -> CacheX m Integer
delXPubKeys [] = Integer -> CacheX m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
delXPubKeys [XPubSpec]
xpubs = do
  [XPubSpec]
-> (XPubSpec -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [XPubSpec]
xpubs ((XPubSpec -> ReaderT CacheConfig m ())
 -> ReaderT CacheConfig m ())
-> (XPubSpec -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ \XPubSpec
x -> do
    LogSource
xtxt <- XPubSpec -> CacheX m LogSource
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m LogSource
xpubText XPubSpec
x
    $(LogSource -> LogSource -> ReaderT CacheConfig m ()
logDebugS) LogSource
"Cache" (LogSource -> ReaderT CacheConfig m ())
-> LogSource -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Deleting xpub: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
xtxt
  [(XPubSpec, [XPubBal])]
xbals <-
    Redis (Either Reply [(XPubSpec, [XPubBal])])
-> CacheX m [(XPubSpec, [XPubBal])]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(XPubSpec, [XPubBal])])
 -> CacheX m [(XPubSpec, [XPubBal])])
-> ((XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
    -> Redis (Either Reply [(XPubSpec, [XPubBal])]))
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> CacheX m [(XPubSpec, [XPubBal])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Either Reply (XPubSpec, [XPubBal])]
 -> Either Reply [(XPubSpec, [XPubBal])])
-> Redis [Either Reply (XPubSpec, [XPubBal])]
-> Redis (Either Reply [(XPubSpec, [XPubBal])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either Reply (XPubSpec, [XPubBal])]
-> Either Reply [(XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Redis [Either Reply (XPubSpec, [XPubBal])]
 -> Redis (Either Reply [(XPubSpec, [XPubBal])]))
-> ((XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
    -> Redis [Either Reply (XPubSpec, [XPubBal])])
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> Redis (Either Reply [(XPubSpec, [XPubBal])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XPubSpec]
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> Redis [Either Reply (XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [XPubSpec]
xpubs ((XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
 -> CacheX m [(XPubSpec, [XPubBal])])
-> (XPubSpec -> Redis (Either Reply (XPubSpec, [XPubBal])))
-> CacheX m [(XPubSpec, [XPubBal])]
forall a b. (a -> b) -> a -> b
$ \XPubSpec
xpub -> do
      Either Reply [XPubBal]
bs <- XPubSpec -> Redis (Either Reply [XPubBal])
forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub
      return $ (XPubSpec
xpub,) ([XPubBal] -> (XPubSpec, [XPubBal]))
-> Either Reply [XPubBal] -> Either Reply (XPubSpec, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Reply [XPubBal]
bs
  Redis (Either Reply Integer) -> CacheX m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply Integer) -> CacheX m Integer)
-> Redis (Either Reply Integer) -> CacheX m Integer
forall a b. (a -> b) -> a -> b
$ ([Integer] -> Integer)
-> Either Reply [Integer] -> Either Reply Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Either Reply [Integer] -> Either Reply Integer)
-> ([Either Reply Integer] -> Either Reply [Integer])
-> [Either Reply Integer]
-> Either Reply Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Reply Integer] -> Either Reply [Integer]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either Reply Integer] -> Either Reply Integer)
-> Redis [Either Reply Integer] -> Redis (Either Reply Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(XPubSpec, [XPubBal])]
-> ((XPubSpec, [XPubBal]) -> Redis (Either Reply Integer))
-> Redis [Either Reply Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(XPubSpec, [XPubBal])]
xbals ((XPubSpec -> [XPubBal] -> Redis (Either Reply Integer))
-> (XPubSpec, [XPubBal]) -> Redis (Either Reply Integer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubSpec -> [XPubBal] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f Integer)
redisDelXPubKeys)

redisDelXPubKeys ::
  (Monad f, RedisCtx m f) => XPubSpec -> [XPubBal] -> m (f Integer)
redisDelXPubKeys :: XPubSpec -> [XPubBal] -> m (f Integer)
redisDelXPubKeys XPubSpec
xpub [XPubBal]
bals = [Address] -> m (f Integer)
forall (f :: * -> *) (f :: * -> *) a.
(Applicative f, RedisCtx f f, Serialize a) =>
[a] -> f (f Integer)
go ((XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Address
balanceAddress (Balance -> Address) -> (XPubBal -> Balance) -> XPubBal -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
bals)
  where
    go :: [a] -> f (f Integer)
go [a]
addrs = do
      f Integer
addrcount <-
        case [a]
addrs of
          [] -> f Integer -> f (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
          [a]
_ -> [ByteString] -> f (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
addrPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Serialize a => a -> ByteString
encode) [a]
addrs)
      f Integer
txsetcount <- [ByteString] -> f (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      f Integer
utxocount <- [ByteString] -> f (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
utxoPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      f Integer
balcount <- [ByteString] -> f (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
balancesPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      f Integer
x <- ByteString -> [ByteString] -> f (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Redis.zrem ByteString
maxKey [XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      return $ do
        Integer
_ <- f Integer
x
        Integer
addrs' <- f Integer
addrcount
        Integer
txset' <- f Integer
txsetcount
        Integer
utxo' <- f Integer
utxocount
        Integer
bal' <- f Integer
balcount
        return $ Integer
addrs' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
txset' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
utxo' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
bal'

redisAddXPubTxs ::
  (Applicative f, RedisCtx m f) => XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs :: XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs XPubSpec
_ [] = f Integer -> m (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisAddXPubTxs XPubSpec
xpub [TxRef]
btxs =
  ByteString -> [(Double, ByteString)] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd (ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) ([(Double, ByteString)] -> m (f Integer))
-> [(Double, ByteString)] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$
    (TxRef -> (Double, ByteString))
-> [TxRef] -> [(Double, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\TxRef
t -> (BlockRef -> Double
blockRefScore (TxRef -> BlockRef
txRefBlock TxRef
t), TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode (TxRef -> TxHash
txRefHash TxRef
t))) [TxRef]
btxs

redisRemXPubTxs ::
  (Applicative f, RedisCtx m f) => XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs :: XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs XPubSpec
_ [] = f Integer -> m (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisRemXPubTxs XPubSpec
xpub [TxHash]
txhs = ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
zrem (ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) ((TxHash -> ByteString) -> [TxHash] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode [TxHash]
txhs)

redisAddXPubUnspents ::
  (Applicative f, RedisCtx m f) =>
  XPubSpec ->
  [(OutPoint, BlockRef)] ->
  m (f Integer)
redisAddXPubUnspents :: XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents XPubSpec
_ [] =
  f Integer -> m (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisAddXPubUnspents XPubSpec
xpub [(OutPoint, BlockRef)]
utxo =
  ByteString -> [(Double, ByteString)] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd (ByteString
utxoPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) ([(Double, ByteString)] -> m (f Integer))
-> [(Double, ByteString)] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$
    ((OutPoint, BlockRef) -> (Double, ByteString))
-> [(OutPoint, BlockRef)] -> [(Double, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(OutPoint
p, BlockRef
r) -> (BlockRef -> Double
blockRefScore BlockRef
r, OutPoint -> ByteString
forall a. Serialize a => a -> ByteString
encode OutPoint
p)) [(OutPoint, BlockRef)]
utxo

redisRemXPubUnspents ::
  (Applicative f, RedisCtx m f) => XPubSpec -> [OutPoint] -> m (f Integer)
redisRemXPubUnspents :: XPubSpec -> [OutPoint] -> m (f Integer)
redisRemXPubUnspents XPubSpec
_ [] =
  f Integer -> m (f Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisRemXPubUnspents XPubSpec
xpub [OutPoint]
ops =
  ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
zrem (ByteString
utxoPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) ((OutPoint -> ByteString) -> [OutPoint] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map OutPoint -> ByteString
forall a. Serialize a => a -> ByteString
encode [OutPoint]
ops)

redisAddXPubBalances ::
  (Monad f, RedisCtx m f) => XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances :: XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances XPubSpec
_ [] = f () -> m (f ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
redisAddXPubBalances XPubSpec
xpub [XPubBal]
bals = do
  [f Integer]
xs <- ((ByteString, ByteString) -> m (f Integer))
-> [(ByteString, ByteString)] -> m [f Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ByteString -> ByteString -> m (f Integer))
-> (ByteString, ByteString) -> m (f Integer)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ByteString -> ByteString -> ByteString -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
Redis.hset (ByteString
balancesPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub))) [(ByteString, ByteString)]
entries
  [f ()]
ys <- [XPubBal] -> (XPubBal -> m (f ())) -> m [f ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [XPubBal]
bals ((XPubBal -> m (f ())) -> m [f ()])
-> (XPubBal -> m (f ())) -> m [f ()]
forall a b. (a -> b) -> a -> b
$ \XPubBal
b ->
    Address -> AddressXPub -> m (f ())
forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
Address -> AddressXPub -> m (f ())
redisSetAddrInfo
      (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
b))
      AddressXPub :: XPubSpec -> [BlockHeight] -> AddressXPub
AddressXPub
        { addressXPubSpec :: XPubSpec
addressXPubSpec = XPubSpec
xpub,
          addressXPubPath :: [BlockHeight]
addressXPubPath = XPubBal -> [BlockHeight]
xPubBalPath XPubBal
b
        }
  return $ [f Integer] -> f ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f Integer]
xs f () -> f () -> f ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [f ()] -> f ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f ()]
ys
  where
    entries :: [(ByteString, ByteString)]
entries = (XPubBal -> (ByteString, ByteString))
-> [XPubBal] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\XPubBal
b -> ([BlockHeight] -> ByteString
forall a. Serialize a => a -> ByteString
encode (XPubBal -> [BlockHeight]
xPubBalPath XPubBal
b), Balance -> ByteString
forall a. Serialize a => a -> ByteString
encode (XPubBal -> Balance
xPubBal XPubBal
b))) [XPubBal]
bals

redisSetHead :: RedisCtx m f => BlockHash -> m (f Redis.Status)
redisSetHead :: BlockHash -> m (f Status)
redisSetHead BlockHash
bh = ByteString -> ByteString -> m (f Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set ByteString
bestBlockKey (BlockHash -> ByteString
forall a. Serialize a => a -> ByteString
encode BlockHash
bh)

redisGetAddrsInfo ::
  (Monad f, RedisCtx m f) => [Address] -> m (f [Maybe AddressXPub])
redisGetAddrsInfo :: [Address] -> m (f [Maybe AddressXPub])
redisGetAddrsInfo [] = f [Maybe AddressXPub] -> m (f [Maybe AddressXPub])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe AddressXPub] -> f [Maybe AddressXPub]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
redisGetAddrsInfo [Address]
as = do
  [f (Maybe ByteString)]
is <- (Address -> m (f (Maybe ByteString)))
-> [Address] -> m [f (Maybe ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Address
a -> ByteString -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get (ByteString
addrPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Address -> ByteString
forall a. Serialize a => a -> ByteString
encode Address
a)) [Address]
as
  return $ do
    [Maybe ByteString]
is' <- [f (Maybe ByteString)] -> f [Maybe ByteString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [f (Maybe ByteString)]
is
    return $ (Maybe ByteString -> Maybe AddressXPub)
-> [Maybe ByteString] -> [Maybe AddressXPub]
forall a b. (a -> b) -> [a] -> [b]
map (Either String AddressXPub -> Maybe AddressXPub
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String AddressXPub -> Maybe AddressXPub)
-> (ByteString -> Either String AddressXPub)
-> ByteString
-> Maybe AddressXPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String AddressXPub
forall a. Serialize a => ByteString -> Either String a
decode (ByteString -> Maybe AddressXPub)
-> Maybe ByteString -> Maybe AddressXPub
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) [Maybe ByteString]
is'

addrsToAdd :: KeyIndex -> [XPubBal] -> AddressXPub -> [(Address, AddressXPub)]
addrsToAdd :: BlockHeight -> [XPubBal] -> AddressXPub -> [(Address, AddressXPub)]
addrsToAdd BlockHeight
gap [XPubBal]
xbals AddressXPub
addrinfo
  | [XPubBal] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XPubBal]
fbals = []
  | Bool -> Bool
not Bool
haschange = (Address -> [BlockHeight] -> (Address, AddressXPub))
-> [Address] -> [[BlockHeight]] -> [(Address, AddressXPub)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Address -> [BlockHeight] -> (Address, AddressXPub)
forall a. a -> [BlockHeight] -> (a, AddressXPub)
f [Address]
addrs [[BlockHeight]]
list [(Address, AddressXPub)]
-> [(Address, AddressXPub)] -> [(Address, AddressXPub)]
forall a. Semigroup a => a -> a -> a
<> (Address -> [BlockHeight] -> (Address, AddressXPub))
-> [Address] -> [[BlockHeight]] -> [(Address, AddressXPub)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Address -> [BlockHeight] -> (Address, AddressXPub)
forall a. a -> [BlockHeight] -> (a, AddressXPub)
f [Address]
changeaddrs [[BlockHeight]]
changelist
  | Bool
otherwise = (Address -> [BlockHeight] -> (Address, AddressXPub))
-> [Address] -> [[BlockHeight]] -> [(Address, AddressXPub)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Address -> [BlockHeight] -> (Address, AddressXPub)
forall a. a -> [BlockHeight] -> (a, AddressXPub)
f [Address]
addrs [[BlockHeight]]
list
  where
    haschange :: Bool
haschange = (XPubBal -> Bool) -> [XPubBal] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((BlockHeight -> BlockHeight -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHeight
1) (BlockHeight -> Bool)
-> (XPubBal -> BlockHeight) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeight] -> BlockHeight
forall a. [a] -> a
head ([BlockHeight] -> BlockHeight)
-> (XPubBal -> [BlockHeight]) -> XPubBal -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> [BlockHeight]
xPubBalPath) [XPubBal]
xbals
    f :: a -> [BlockHeight] -> (a, AddressXPub)
f a
a [BlockHeight]
p = (a
a, AddressXPub :: XPubSpec -> [BlockHeight] -> AddressXPub
AddressXPub {addressXPubSpec :: XPubSpec
addressXPubSpec = XPubSpec
xpub, addressXPubPath :: [BlockHeight]
addressXPubPath = [BlockHeight]
p})
    dchain :: BlockHeight
dchain = [BlockHeight] -> BlockHeight
forall a. [a] -> a
head (AddressXPub -> [BlockHeight]
addressXPubPath AddressXPub
addrinfo)
    fbals :: [XPubBal]
fbals = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter ((BlockHeight -> BlockHeight -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHeight
dchain) (BlockHeight -> Bool)
-> (XPubBal -> BlockHeight) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeight] -> BlockHeight
forall a. [a] -> a
head ([BlockHeight] -> BlockHeight)
-> (XPubBal -> [BlockHeight]) -> XPubBal -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> [BlockHeight]
xPubBalPath) [XPubBal]
xbals
    maxidx :: BlockHeight
maxidx = [BlockHeight] -> BlockHeight
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((XPubBal -> BlockHeight) -> [XPubBal] -> [BlockHeight]
forall a b. (a -> b) -> [a] -> [b]
map ([BlockHeight] -> BlockHeight
forall a. [a] -> a
head ([BlockHeight] -> BlockHeight)
-> (XPubBal -> [BlockHeight]) -> XPubBal -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeight] -> [BlockHeight]
forall a. [a] -> [a]
tail ([BlockHeight] -> [BlockHeight])
-> (XPubBal -> [BlockHeight]) -> XPubBal -> [BlockHeight]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> [BlockHeight]
xPubBalPath) [XPubBal]
fbals)
    xpub :: XPubSpec
xpub = AddressXPub -> XPubSpec
addressXPubSpec AddressXPub
addrinfo
    aidx :: BlockHeight
aidx = ([BlockHeight] -> BlockHeight
forall a. [a] -> a
head ([BlockHeight] -> BlockHeight)
-> ([BlockHeight] -> [BlockHeight]) -> [BlockHeight] -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeight] -> [BlockHeight]
forall a. [a] -> [a]
tail) (AddressXPub -> [BlockHeight]
addressXPubPath AddressXPub
addrinfo)
    ixs :: [BlockHeight]
ixs =
      if BlockHeight
gap BlockHeight -> BlockHeight -> Bool
forall a. Ord a => a -> a -> Bool
> BlockHeight
maxidx BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
- BlockHeight
aidx
        then [BlockHeight
maxidx BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ BlockHeight
1 .. BlockHeight
aidx BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ BlockHeight
gap]
        else []
    paths :: [DerivPathI SoftDeriv]
paths = (BlockHeight -> DerivPathI SoftDeriv)
-> [BlockHeight] -> [DerivPathI SoftDeriv]
forall a b. (a -> b) -> [a] -> [b]
map (DerivPathI SoftDeriv
forall t. DerivPathI t
Deriv DerivPathI SoftDeriv -> BlockHeight -> DerivPathI SoftDeriv
forall t.
AnyOrSoft t =>
DerivPathI t -> BlockHeight -> DerivPathI t
:/ BlockHeight
dchain DerivPathI SoftDeriv -> BlockHeight -> DerivPathI SoftDeriv
forall t.
AnyOrSoft t =>
DerivPathI t -> BlockHeight -> DerivPathI t
:/) [BlockHeight]
ixs
    keys :: [DerivPathI SoftDeriv] -> [XPubKey]
keys = (DerivPathI SoftDeriv -> XPubKey)
-> [DerivPathI SoftDeriv] -> [XPubKey]
forall a b. (a -> b) -> [a] -> [b]
map (\DerivPathI SoftDeriv
p -> DerivPathI SoftDeriv -> XPubKey -> XPubKey
derivePubPath DerivPathI SoftDeriv
p (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub))
    list :: [[BlockHeight]]
list = (DerivPathI SoftDeriv -> [BlockHeight])
-> [DerivPathI SoftDeriv] -> [[BlockHeight]]
forall a b. (a -> b) -> [a] -> [b]
map DerivPathI SoftDeriv -> [BlockHeight]
forall t. DerivPathI t -> [BlockHeight]
pathToList [DerivPathI SoftDeriv]
paths
    xpubf :: XPubKey -> Address
xpubf = DeriveType -> XPubKey -> Address
xPubAddrFunction (XPubSpec -> DeriveType
xPubDeriveType XPubSpec
xpub)
    addrs :: [Address]
addrs = (XPubKey -> Address) -> [XPubKey] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map XPubKey -> Address
xpubf ([DerivPathI SoftDeriv] -> [XPubKey]
keys [DerivPathI SoftDeriv]
paths)
    changepaths :: [DerivPathI SoftDeriv]
changepaths = (BlockHeight -> DerivPathI SoftDeriv)
-> [BlockHeight] -> [DerivPathI SoftDeriv]
forall a b. (a -> b) -> [a] -> [b]
map (DerivPathI SoftDeriv
forall t. DerivPathI t
Deriv DerivPathI SoftDeriv -> BlockHeight -> DerivPathI SoftDeriv
forall t.
AnyOrSoft t =>
DerivPathI t -> BlockHeight -> DerivPathI t
:/ BlockHeight
1 DerivPathI SoftDeriv -> BlockHeight -> DerivPathI SoftDeriv
forall t.
AnyOrSoft t =>
DerivPathI t -> BlockHeight -> DerivPathI t
:/) [BlockHeight
0 .. BlockHeight
gap BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
- BlockHeight
1]
    changeaddrs :: [Address]
changeaddrs = (XPubKey -> Address) -> [XPubKey] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map XPubKey -> Address
xpubf ([DerivPathI SoftDeriv] -> [XPubKey]
keys [DerivPathI SoftDeriv]
changepaths)
    changelist :: [[BlockHeight]]
changelist = (DerivPathI SoftDeriv -> [BlockHeight])
-> [DerivPathI SoftDeriv] -> [[BlockHeight]]
forall a b. (a -> b) -> [a] -> [b]
map DerivPathI SoftDeriv -> [BlockHeight]
forall t. DerivPathI t -> [BlockHeight]
pathToList [DerivPathI SoftDeriv]
changepaths

sortTxData :: [TxData] -> [TxData]
sortTxData :: [TxData] -> [TxData]
sortTxData [TxData]
tds =
  let txm :: Map TxHash TxData
txm = [(TxHash, TxData)] -> Map TxHash TxData
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((TxData -> (TxHash, TxData)) -> [TxData] -> [(TxHash, TxData)]
forall a b. (a -> b) -> [a] -> [b]
map (\TxData
d -> (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
d), TxData
d)) [TxData]
tds)
      ths :: [TxHash]
ths = ((BlockHeight, Tx) -> TxHash) -> [(BlockHeight, Tx)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Tx -> TxHash
txHash (Tx -> TxHash)
-> ((BlockHeight, Tx) -> Tx) -> (BlockHeight, Tx) -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockHeight, Tx) -> Tx
forall a b. (a, b) -> b
snd) ([Tx] -> [(BlockHeight, Tx)]
sortTxs ((TxData -> Tx) -> [TxData] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map TxData -> Tx
txData [TxData]
tds))
   in (TxHash -> Maybe TxData) -> [TxHash] -> [TxData]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxHash -> Map TxHash TxData -> Maybe TxData
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map TxHash TxData
txm) [TxHash]
ths

txInputs :: TxData -> [(Address, OutPoint)]
txInputs :: TxData -> [(Address, OutPoint)]
txInputs TxData
td =
  let is :: [TxIn]
is = Tx -> [TxIn]
txIn (TxData -> Tx
txData TxData
td)
      ps :: [(Int, Prev)]
ps = IntMap Prev -> [(Int, Prev)]
forall a. IntMap a -> [(Int, a)]
I.toAscList (TxData -> IntMap Prev
txDataPrevs TxData
td)
      as :: [Either String Address]
as = ((Int, Prev) -> Either String Address)
-> [(Int, Prev)] -> [Either String Address]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Either String Address
scriptToAddressBS (ByteString -> Either String Address)
-> ((Int, Prev) -> ByteString)
-> (Int, Prev)
-> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prev -> ByteString
prevScript (Prev -> ByteString)
-> ((Int, Prev) -> Prev) -> (Int, Prev) -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Prev) -> Prev
forall a b. (a, b) -> b
snd) [(Int, Prev)]
ps
      f :: Either a a -> TxIn -> Maybe (a, OutPoint)
f (Right a
a) TxIn
i = (a, OutPoint) -> Maybe (a, OutPoint)
forall a. a -> Maybe a
Just (a
a, TxIn -> OutPoint
prevOutput TxIn
i)
      f (Left a
_) TxIn
_ = Maybe (a, OutPoint)
forall a. Maybe a
Nothing
   in [Maybe (Address, OutPoint)] -> [(Address, OutPoint)]
forall a. [Maybe a] -> [a]
catMaybes ((Either String Address -> TxIn -> Maybe (Address, OutPoint))
-> [Either String Address] -> [TxIn] -> [Maybe (Address, OutPoint)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Either String Address -> TxIn -> Maybe (Address, OutPoint)
forall a a. Either a a -> TxIn -> Maybe (a, OutPoint)
f [Either String Address]
as [TxIn]
is)

txOutputs :: TxData -> [(Address, OutPoint)]
txOutputs :: TxData -> [(Address, OutPoint)]
txOutputs TxData
td =
  let ps :: [OutPoint]
ps =
        (BlockHeight -> TxOut -> OutPoint)
-> [BlockHeight] -> [TxOut] -> [OutPoint]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          ( \BlockHeight
i TxOut
_ ->
              OutPoint :: TxHash -> BlockHeight -> OutPoint
OutPoint
                { outPointHash :: TxHash
outPointHash = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
td),
                  outPointIndex :: BlockHeight
outPointIndex = BlockHeight
i
                }
          )
          [BlockHeight
0 ..]
          (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
td))
      as :: [Either String Address]
as = (TxOut -> Either String Address)
-> [TxOut] -> [Either String Address]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Either String Address
scriptToAddressBS (ByteString -> Either String Address)
-> (TxOut -> ByteString) -> TxOut -> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput) (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
td))
      f :: Either a a -> b -> Maybe (a, b)
f (Right a
a) b
p = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
p)
      f (Left a
_) b
_ = Maybe (a, b)
forall a. Maybe a
Nothing
   in [Maybe (Address, OutPoint)] -> [(Address, OutPoint)]
forall a. [Maybe a] -> [a]
catMaybes ((Either String Address -> OutPoint -> Maybe (Address, OutPoint))
-> [Either String Address]
-> [OutPoint]
-> [Maybe (Address, OutPoint)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Either String Address -> OutPoint -> Maybe (Address, OutPoint)
forall a a b. Either a a -> b -> Maybe (a, b)
f [Either String Address]
as [OutPoint]
ps)

redisGetHead :: (Functor f, RedisCtx m f) => m (f (Maybe BlockHash))
redisGetHead :: m (f (Maybe BlockHash))
redisGetHead = do
  f (Maybe ByteString)
x <- ByteString -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get ByteString
bestBlockKey
  return $ (Either String BlockHash -> Maybe BlockHash
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String BlockHash -> Maybe BlockHash)
-> (ByteString -> Either String BlockHash)
-> ByteString
-> Maybe BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String BlockHash
forall a. Serialize a => ByteString -> Either String a
decode (ByteString -> Maybe BlockHash)
-> Maybe ByteString -> Maybe BlockHash
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe ByteString -> Maybe BlockHash)
-> f (Maybe ByteString) -> f (Maybe BlockHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe ByteString)
x

redisGetMempool :: (Applicative f, RedisCtx m f) => m (f [(UnixTime, TxHash)])
redisGetMempool :: m (f [(UnixTime, TxHash)])
redisGetMempool = do
  f [(TxHash, Double)]
xs <- ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(TxHash, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet ByteString
mempoolSetKey Maybe Double
forall a. Maybe a
Nothing BlockHeight
0 BlockHeight
0
  return $ ((TxHash, Double) -> (UnixTime, TxHash))
-> [(TxHash, Double)] -> [(UnixTime, TxHash)]
forall a b. (a -> b) -> [a] -> [b]
map ((TxHash -> Double -> (UnixTime, TxHash))
-> (TxHash, Double) -> (UnixTime, TxHash)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxHash -> Double -> (UnixTime, TxHash)
forall b. b -> Double -> (UnixTime, b)
f) ([(TxHash, Double)] -> [(UnixTime, TxHash)])
-> f [(TxHash, Double)] -> f [(UnixTime, TxHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(TxHash, Double)]
xs
  where
    f :: b -> Double -> (UnixTime, b)
f b
t Double
s = (BlockRef -> UnixTime
memRefTime (Double -> BlockRef
scoreBlockRef Double
s), b
t)

xpubText ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  XPubSpec ->
  CacheX m Text
xpubText :: XPubSpec -> CacheX m LogSource
xpubText XPubSpec
xpub = do
  Network
net <- m Network -> ReaderT CacheConfig m Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  let suffix :: LogSource
suffix = case XPubSpec -> DeriveType
xPubDeriveType XPubSpec
xpub of
        DeriveType
DeriveNormal -> LogSource
""
        DeriveType
DeriveP2SH -> LogSource
"/p2sh"
        DeriveType
DeriveP2WPKH -> LogSource
"/p2wpkh"
  LogSource -> CacheX m LogSource
forall (m :: * -> *) a. Monad m => a -> m a
return (LogSource -> CacheX m LogSource)
-> (LogSource -> LogSource) -> LogSource -> CacheX m LogSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (LogSource -> CacheX m LogSource)
-> LogSource -> CacheX m LogSource
forall a b. (a -> b) -> a -> b
$ LogSource
suffix LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> Network -> XPubKey -> LogSource
xPubExport Network
net (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub)

cacheNewBlock :: MonadIO m => CacheWriter -> m ()
cacheNewBlock :: CacheWriter -> m ()
cacheNewBlock = CacheWriterMessage -> CacheWriter -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
send CacheWriterMessage
CacheNewBlock

cacheNewTx :: MonadIO m => TxHash -> CacheWriter -> m ()
cacheNewTx :: TxHash -> CacheWriter -> m ()
cacheNewTx = CacheWriterMessage -> CacheWriter -> m ()
forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
send (CacheWriterMessage -> CacheWriter -> m ())
-> (TxHash -> CacheWriterMessage) -> TxHash -> CacheWriter -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> CacheWriterMessage
CacheNewTx