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

module Haskoin.Store.Cache
  ( CacheConfig (..),
    CacheMetrics,
    CacheT,
    CacheError (..),
    newCacheMetrics,
    withCache,
    connectRedis,
    blockRefScore,
    scoreBlockRef,
    CacheWriter,
    CacheWriterInbox,
    cacheNewBlock,
    cacheNewTx,
    cacheSyncMempool,
    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 Data.ByteString qualified as B
import Data.Default (def)
import Data.Either (fromRight, isRight, rights)
import Data.Functor ((<&>))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.IntMap.Strict qualified as I
import Data.List (sort)
import Data.Map.Strict qualified 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 Database.Redis qualified as Redis
import Database.Redis qualified as Reids
import GHC.Generics (Generic)
import Haskoin
  ( Address,
    BlockHash,
    BlockHeader (..),
    BlockNode (..),
    Ctx,
    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,
    chainGetParents,
    chainGetSplitBlock,
  )
import Haskoin.Store.Common
import Haskoin.Store.Data
import Haskoin.Store.Stats
import NQE
  ( Inbox,
    Listen,
    Mailbox,
    inboxToMailbox,
    query,
    receive,
    send,
  )
import System.Metrics qualified as Metrics
import System.Metrics.Counter qualified as Metrics (Counter)
import System.Metrics.Counter qualified as Metrics.Counter
import System.Metrics.Distribution qualified as Metrics (Distribution)
import System.Metrics.Distribution qualified as Metrics.Distribution
import System.Metrics.Gauge qualified as Metrics (Gauge)
import System.Metrics.Gauge qualified as Metrics.Gauge
import System.Random (randomIO, randomRIO)
import UnliftIO
  ( Exception,
    MonadIO,
    MonadUnliftIO,
    TQueue,
    TVar,
    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 :: forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply a)
action = do
  Connection
conn <- (CacheConfig -> Connection) -> ReaderT CacheConfig m Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.redis)
  IO (Either Reply a) -> ReaderT CacheConfig m (Either Reply a)
forall a. IO a -> ReaderT CacheConfig m 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 a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
x -> a -> CacheX m a
forall a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Left Reply
e -> do
      $(logErrorS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ Text
"Got error from Redis: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
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
redis :: !Connection,
    CacheConfig -> Int
minAddrs :: !Int,
    CacheConfig -> Integer
maxKeys :: !Integer,
    CacheConfig -> Chain
chain :: !Chain,
    CacheConfig -> Maybe CacheMetrics
metrics :: !(Maybe CacheMetrics)
  }

data CacheMetrics = CacheMetrics
  { CacheMetrics -> Counter
cacheHits :: !Metrics.Counter,
    CacheMetrics -> Counter
cacheMisses :: !Metrics.Counter,
    CacheMetrics -> Counter
lockAcquired :: !Metrics.Counter,
    CacheMetrics -> Counter
lockReleased :: !Metrics.Counter,
    CacheMetrics -> Counter
lockFailed :: !Metrics.Counter,
    CacheMetrics -> Counter
xPubBals :: !Metrics.Counter,
    CacheMetrics -> Counter
xPubUnspents :: !Metrics.Counter,
    CacheMetrics -> Counter
xPubTx :: !Metrics.Counter,
    CacheMetrics -> Counter
xPubTxCount :: !Metrics.Counter,
    CacheMetrics -> StatDist
indexTime :: !StatDist
  }

newCacheMetrics :: (MonadIO m) => Metrics.Store -> m CacheMetrics
newCacheMetrics :: forall (m :: * -> *). MonadIO m => Store -> m CacheMetrics
newCacheMetrics Store
s = IO CacheMetrics -> m CacheMetrics
forall a. IO a -> m a
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 <- Text -> IO Counter
c Text
"cache.hits"
  Counter
cacheMisses <- Text -> IO Counter
c Text
"cache.misses"
  Counter
lockAcquired <- Text -> IO Counter
c Text
"cache.lock_acquired"
  Counter
lockReleased <- Text -> IO Counter
c Text
"cache.lock_released"
  Counter
lockFailed <- Text -> IO Counter
c Text
"cache.lock_failed"
  StatDist
indexTime <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"cache.index"
  Counter
xPubBals <- Text -> IO Counter
c Text
"cache.xpub_balances_cached"
  Counter
xPubUnspents <- Text -> IO Counter
c Text
"cache.xpub_unspents_cached"
  Counter
xPubTx <- Text -> IO Counter
c Text
"cache.xpub_txs_cached"
  Counter
xPubTxCount <- Text -> IO Counter
c Text
"cache.xpub_tx_count_cached"
  return CacheMetrics {Counter
StatDist
$sel:cacheHits:CacheMetrics :: Counter
$sel:cacheMisses:CacheMetrics :: Counter
$sel:lockAcquired:CacheMetrics :: Counter
$sel:lockReleased:CacheMetrics :: Counter
$sel:lockFailed:CacheMetrics :: Counter
$sel:xPubBals:CacheMetrics :: Counter
$sel:xPubUnspents:CacheMetrics :: Counter
$sel:xPubTx:CacheMetrics :: Counter
$sel:xPubTxCount:CacheMetrics :: Counter
$sel:indexTime:CacheMetrics :: StatDist
cacheHits :: Counter
cacheMisses :: Counter
lockAcquired :: Counter
lockReleased :: Counter
lockFailed :: Counter
indexTime :: StatDist
xPubBals :: Counter
xPubUnspents :: Counter
xPubTx :: Counter
xPubTxCount :: Counter
..}
  where
    c :: Text -> IO Counter
c Text
x = Text -> Store -> IO Counter
Metrics.createCounter Text
x Store
s
    d :: Text -> m StatDist
d Text
x = Text -> Store -> m StatDist
forall (m :: * -> *). MonadIO m => Text -> Store -> m StatDist
createStatDist Text
x Store
s

withMetrics ::
  (MonadUnliftIO m) =>
  (CacheMetrics -> StatDist) ->
  CacheX m a ->
  CacheX m a
withMetrics :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(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 (.metrics) ReaderT CacheConfig m (Maybe CacheMetrics)
-> (Maybe CacheMetrics -> CacheX m a) -> CacheX m a
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
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 a. IO a -> ReaderT CacheConfig m a
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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
      let diff :: Int64
diff = NominalDiffTime -> Int64
forall b. Integral b => NominalDiffTime -> b
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 :: forall (m :: * -> *).
MonadIO m =>
(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 (.metrics) ReaderT CacheConfig m (Maybe CacheMetrics)
-> (Maybe CacheMetrics -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just CacheMetrics
s -> IO () -> ReaderT CacheConfig m ()
forall a. IO a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT CacheConfig m ())
-> IO () -> ReaderT CacheConfig 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 -> () -> ReaderT CacheConfig m ()
forall a. a -> ReaderT CacheConfig m a
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
$cshowsPrec :: Int -> CacheError -> ShowS
showsPrec :: Int -> CacheError -> ShowS
$cshow :: CacheError -> String
show :: CacheError -> String
$cshowList :: [CacheError] -> ShowS
showList :: [CacheError] -> ShowS
Show, CacheError -> CacheError -> Bool
(CacheError -> CacheError -> Bool)
-> (CacheError -> CacheError -> Bool) -> Eq CacheError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheError -> CacheError -> Bool
== :: CacheError -> CacheError -> Bool
$c/= :: CacheError -> CacheError -> Bool
/= :: 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
$cfrom :: forall x. CacheError -> Rep CacheError x
from :: forall x. CacheError -> Rep CacheError x
$cto :: forall x. Rep CacheError x -> CacheError
to :: forall x. Rep CacheError x -> CacheError
Generic, CacheError -> ()
(CacheError -> ()) -> NFData CacheError
forall a. (a -> ()) -> NFData a
$crnf :: CacheError -> ()
rnf :: 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
$ctoException :: CacheError -> SomeException
toException :: CacheError -> SomeException
$cfromException :: SomeException -> Maybe CacheError
fromException :: SomeException -> Maybe CacheError
$cdisplayException :: CacheError -> String
displayException :: CacheError -> String
Exception)

connectRedis :: (MonadIO m) => String -> m Connection
connectRedis :: forall (m :: * -> *). MonadIO m => String -> m Connection
connectRedis String
redisurl = do
  ConnectInfo
conninfo <-
    if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
redisurl
      then ConnectInfo -> m ConnectInfo
forall a. a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectInfo
r
  IO Connection -> m Connection
forall a. IO a -> m a
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
  getCtx :: CacheT m Ctx
getCtx = m Ctx -> CacheT m Ctx
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
  getNetwork :: CacheT m Network
getNetwork = m Network -> CacheT m Network
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 [(Word64, TxHash)]
getMempool = m [(Word64, TxHash)] -> CacheT m [(Word64, TxHash)]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m BlockHeight
forall (m :: * -> *). StoreReadExtra m => m BlockHeight
getInitialGap
  getNumTxData :: Word64 -> CacheT m [TxData]
getNumTxData = m [TxData] -> CacheT m [TxData]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxData] -> CacheT m [TxData])
-> (Word64 -> m [TxData]) -> Word64 -> CacheT m [TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> m [TxData]
forall (m :: * -> *). StoreReadExtra m => Word64 -> 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 a b.
ReaderT (Maybe CacheConfig) m a
-> (a -> ReaderT (Maybe CacheConfig) m b)
-> ReaderT (Maybe CacheConfig) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m [XPubBal] -> CacheT m [XPubBal]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 a b.
ReaderT (Maybe CacheConfig) m a
-> (a -> ReaderT (Maybe CacheConfig) m b)
-> ReaderT (Maybe CacheConfig) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m [XPubUnspent] -> CacheT m [XPubUnspent]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 a b.
ReaderT (Maybe CacheConfig) m a
-> (a -> ReaderT (Maybe CacheConfig) m b)
-> ReaderT (Maybe CacheConfig) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m [TxRef] -> CacheT m [TxRef]
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 a b.
ReaderT (Maybe CacheConfig) m a
-> (a -> ReaderT (Maybe CacheConfig) m b)
-> ReaderT (Maybe CacheConfig) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        m BlockHeight -> CacheT m BlockHeight
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Maybe CacheConfig) m a
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 :: forall (m :: * -> *) a.
StoreReadBase m =>
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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> Limits -> CacheX m [TxRef]
getXPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits = Bool -> ReaderT CacheConfig 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 a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
c ->
        if Bool
c
          then 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 (.xPubTx) ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
            return [TxRef]
txs
          else do
            if Bool
m
              then m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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
              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 [TxRef]
go Bool
True

getXPubTxCount ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  CacheX m Word32
getXPubTxCount :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m BlockHeight
getXPubTxCount XPubSpec
xpub [XPubBal]
xbals =
  Bool -> ReaderT CacheConfig 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 a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
c ->
        if Bool
c
          then do
            (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.xPubTxCount) Int
1
            XPubSpec -> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m BlockHeight
cacheGetXPubTxCount XPubSpec
xpub
          else do
            if Bool
t
              then m BlockHeight -> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> Limits -> CacheX m [XPubUnspent]
getXPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits =
  Bool -> ReaderT CacheConfig m [XPubUnspent]
go Bool
False
  where
    xm :: HashMap Address XPubBal
xm =
      let f :: b -> (a, b)
f b
x = (b
x.balance.address, b
x)
          g :: XPubBal -> Bool
g = (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) (Word64 -> Bool) -> (XPubBal -> Word64) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.balance.utxo)
       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)
forall {b} {r} {a}.
(HasField "balance" b r, HasField "address" r a) =>
b -> (a, b)
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 -> ReaderT CacheConfig m [XPubUnspent]
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 [XPubUnspent])
-> ReaderT CacheConfig m [XPubUnspent]
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
c ->
        if Bool
c
          then do
            ReaderT CacheConfig m [XPubUnspent]
process
          else do
            if Bool
m
              then m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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
limits
              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 [XPubUnspent]
go Bool
True
    process :: ReaderT CacheConfig 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 (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent [OutPoint]
ops)
      Ctx
ctx <- m Ctx -> ReaderT CacheConfig m Ctx
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
      let f :: r -> Maybe (Address, r)
f r
u =
            (String -> Maybe (Address, r))
-> (Address -> Maybe (Address, r))
-> Either String Address
-> Maybe (Address, r)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (Maybe (Address, r) -> String -> Maybe (Address, r)
forall a b. a -> b -> a
const Maybe (Address, r)
forall a. Maybe a
Nothing)
              (\Address
a -> (Address, r) -> Maybe (Address, r)
forall a. a -> Maybe a
Just (Address
a, r
u))
              (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx r
u.script)
          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 -> r -> XPubUnspent
h Unspent
u r
x =
            XPubUnspent
              { $sel:unspent:XPubUnspent :: Unspent
unspent = Unspent
u,
                $sel:path:XPubUnspent :: [BlockHeight]
path = r
x.path
              }
          us :: [(Address, Unspent)]
us = (Unspent -> Maybe (Address, Unspent))
-> [Unspent] -> [(Address, Unspent)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Unspent -> Maybe (Address, Unspent)
forall {r}.
HasField "script" r ByteString =>
r -> Maybe (Address, r)
f [Unspent]
uns
          i :: Address -> Unspent -> Maybe XPubUnspent
i Address
a Unspent
u = Unspent -> XPubBal -> XPubUnspent
forall {r}.
HasField "path" r [BlockHeight] =>
Unspent -> r -> 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 (.xPubUnspents) ([(Address, Unspent)] -> Int
forall a. [a] -> 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
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 -> ReaderT CacheConfig m [XPubBal])
-> ReaderT CacheConfig m [XPubBal]
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
c ->
    if Bool
c
      then do
        [XPubBal]
xbals <- XPubSpec -> ReaderT CacheConfig 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 (.xPubBals) ([XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
        return [XPubBal]
xbals
      else do
        [XPubBal]
bals <- m [XPubBal] -> ReaderT CacheConfig m [XPubBal]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubBal] -> ReaderT CacheConfig m [XPubBal])
-> m [XPubBal] -> ReaderT CacheConfig 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 :: forall (m :: * -> *). MonadLoggerIO m => 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 -> ReaderT (Maybe CacheConfig) m Bool)
-> ReaderT (Maybe CacheConfig) m Bool
forall a b.
ReaderT (Maybe CacheConfig) m a
-> (a -> ReaderT (Maybe CacheConfig) m b)
-> ReaderT (Maybe CacheConfig) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe CacheConfig
Nothing -> Bool -> ReaderT (Maybe CacheConfig) m Bool
forall a. a -> ReaderT (Maybe CacheConfig) m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just CacheConfig
cfg -> ReaderT CacheConfig (ReaderT (Maybe CacheConfig) m) Bool
-> CacheConfig -> ReaderT (Maybe CacheConfig) 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 :: forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub =
  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) CacheX m Bool -> (Bool -> CacheX m Bool) -> CacheX m Bool
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
c -> do
    if Bool
c
      then (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.cacheHits) Int
1
      else (CacheMetrics -> Counter) -> Int -> CacheX m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.cacheMisses) Int
1
    return Bool
c

redisIsXPubCached :: (RedisCtx m f) => XPubSpec -> m (f Bool)
redisIsXPubCached :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
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 :: forall (m :: * -> *).
MonadLoggerIO m =>
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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
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 :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
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 :: forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs XPubSpec
xpub Limits
limits =
  case Limits
limits.start 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 (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just TxData {$sel:block:TxData :: TxData -> BlockRef
block = 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
limits.offset
            Limits
limits.limit
      [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 a. a -> ReaderT CacheConfig m a
forall (f :: * -> *) a. Applicative f => a -> f 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
limits.offset) [(TxHash, Double)]
xs'
    l :: [a] -> [a]
l =
      if Limits
limits.limit 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
limits.limit)
        else [a] -> [a]
forall a. a -> a
id
    f :: TxHash -> Double -> TxRef
f TxHash
t Double
s = TxRef {$sel:txid:TxRef :: TxHash
txid = TxHash
t, $sel:block:TxRef :: BlockRef
block = Double -> BlockRef
scoreBlockRef Double
s}

cacheGetXPubUnspents ::
  (StoreReadBase m, MonadLoggerIO m) =>
  XPubSpec ->
  Limits ->
  CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents :: forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents XPubSpec
xpub Limits
limits =
  case Limits
limits.start of
    Maybe Start
Nothing ->
      Maybe Double -> CacheX m [(BlockRef, OutPoint)]
forall {m :: * -> *} {a}.
(MonadLoggerIO m, Serialize a) =>
Maybe Double -> ReaderT CacheConfig m [(BlockRef, a)]
go1 Maybe Double
forall a. Maybe a
Nothing
    Just (AtTx TxHash
th) ->
      m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just TxData {$sel:block:TxData :: TxData -> BlockRef
block = b :: BlockRef
b@BlockRef {}} ->
          Maybe Double -> CacheX m [(BlockRef, OutPoint)]
forall {m :: * -> *} {a}.
(MonadLoggerIO m, Serialize a) =>
Maybe Double -> ReaderT CacheConfig m [(BlockRef, a)]
go1 (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore BlockRef
b))
        Maybe TxData
_ ->
          TxHash -> CacheX m [(BlockRef, OutPoint)]
forall {m :: * -> *} {a} {p}.
(Serialize a, MonadLoggerIO m, Eq p, HasField "hash" a p) =>
p -> ReaderT CacheConfig m [(BlockRef, a)]
go2 TxHash
th
    Just (AtBlock BlockHeight
h) ->
      Maybe Double -> CacheX m [(BlockRef, OutPoint)]
forall {m :: * -> *} {a}.
(MonadLoggerIO m, Serialize a) =>
Maybe Double -> ReaderT CacheConfig m [(BlockRef, a)]
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, a)]
go1 Maybe Double
score = do
      [(a, Double)]
xs <-
        Redis (Either Reply [(a, Double)]) -> CacheX m [(a, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(a, Double)]) -> CacheX m [(a, Double)])
-> Redis (Either Reply [(a, Double)]) -> CacheX m [(a, Double)]
forall a b. (a -> b) -> a -> b
$
          ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(a, 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
limits.offset
            Limits
limits.limit
      [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
      return $ ((a, Double) -> (BlockRef, a)) -> [(a, Double)] -> [(BlockRef, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Double -> (BlockRef, a)) -> (a, Double) -> (BlockRef, a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Double -> (BlockRef, a)
forall {b}. b -> Double -> (BlockRef, b)
f) [(a, Double)]
xs
    go2 :: p -> ReaderT CacheConfig m [(BlockRef, a)]
go2 p
hash = do
      [(a, Double)]
xs <-
        Redis (Either Reply [(a, Double)]) -> CacheX m [(a, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(a, Double)]) -> CacheX m [(a, Double)])
-> Redis (Either Reply [(a, Double)]) -> CacheX m [(a, Double)]
forall a b. (a -> b) -> a -> b
$
          ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(a, 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' :: [(a, Double)]
xs' =
            if ((a, Double) -> Bool) -> [(a, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
hash) (p -> Bool) -> ((a, Double) -> p) -> (a, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.hash) (a -> p) -> ((a, Double) -> a) -> (a, Double) -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Double) -> a
forall a b. (a, b) -> a
fst) [(a, Double)]
xs
              then ((a, Double) -> Bool) -> [(a, Double)] -> [(a, Double)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((p -> p -> Bool
forall a. Eq a => a -> a -> Bool
/= p
hash) (p -> Bool) -> ((a, Double) -> p) -> (a, Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.hash) (a -> p) -> ((a, Double) -> a) -> (a, Double) -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Double) -> a
forall a b. (a, b) -> a
fst) [(a, Double)]
xs
              else []
      [(BlockRef, a)] -> ReaderT CacheConfig m [(BlockRef, a)]
forall a. a -> ReaderT CacheConfig m a
forall (f :: * -> *) a. Applicative f => a -> f a
return ([(BlockRef, a)] -> ReaderT CacheConfig m [(BlockRef, a)])
-> [(BlockRef, a)] -> ReaderT CacheConfig m [(BlockRef, a)]
forall a b. (a -> b) -> a -> b
$
        ((a, Double) -> (BlockRef, a)) -> [(a, Double)] -> [(BlockRef, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Double -> (BlockRef, a)) -> (a, Double) -> (BlockRef, a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Double -> (BlockRef, a)
forall {b}. b -> Double -> (BlockRef, b)
f) ([(a, Double)] -> [(BlockRef, a)])
-> [(a, Double)] -> [(BlockRef, a)]
forall a b. (a -> b) -> a -> b
$
          [(a, Double)] -> [(a, Double)]
forall {a}. [a] -> [a]
l ([(a, Double)] -> [(a, Double)]) -> [(a, Double)] -> [(a, Double)]
forall a b. (a -> b) -> a -> b
$
            Int -> [(a, Double)] -> [(a, Double)]
forall a. Int -> [a] -> [a]
drop (BlockHeight -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Limits
limits.offset) [(a, Double)]
xs'
    l :: [a] -> [a]
l =
      if Limits
limits.limit 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
limits.limit)
        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 :: forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub =
  ([([BlockHeight], Balance)] -> [XPubBal])
-> f [([BlockHeight], Balance)] -> f [XPubBal]
forall a b. (a -> b) -> f a -> f b
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 {$sel:path:XPubBal :: [BlockHeight]
path = [BlockHeight]
p, $sel:balance:XPubBal :: Balance
balance = Balance
b}

blockRefScore :: BlockRef -> Double
blockRefScore :: BlockRef -> Double
blockRefScore BlockRef {$sel:height:BlockRef :: BlockRef -> BlockHeight
height = BlockHeight
h, $sel:position:BlockRef :: BlockRef -> BlockHeight
position = BlockHeight
p} =
  Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
0x001fffffffffffff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Word64
h' Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
p'))
  where
    h' :: Word64
h' = (BlockHeight -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
h Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x07ffffff) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` Int
26 :: Word64
    p' :: Word64
p' = (BlockHeight -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHeight
p Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x03ffffff) :: Word64
blockRefScore MemRef {$sel:timestamp:BlockRef :: BlockRef -> Word64
timestamp = Word64
t} = Double -> Double
forall a. Num a => a -> a
negate Double
t'
  where
    t' :: Double
t' = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
t Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
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 {$sel:timestamp:BlockRef :: Word64
timestamp = Word64
n}
  | Bool
otherwise = BlockRef {$sel:height:BlockRef :: BlockHeight
height = BlockHeight
h, $sel:position:BlockRef :: BlockHeight
position = BlockHeight
p}
  where
    n :: Word64
n = Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Num a => a -> a
abs Double
s) :: Word64
    m :: Word64
m = Word64
0x001fffffffffffff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n
    h :: BlockHeight
h = Word64 -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
m Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` (-Int
26))
    p :: BlockHeight
p = Word64 -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x03ffffff)

getFromSortedSet ::
  (Applicative f, RedisCtx m f, Serialize a) =>
  ByteString ->
  Maybe Double ->
  Word32 ->
  Word32 ->
  m (f [(a, Double)])
getFromSortedSet :: forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
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 :: forall (f :: * -> *) (m :: * -> *) k v.
(Functor f, RedisCtx m f, Serialize k, Serialize v) =>
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
  | CacheSyncMempool !(Listen ())

type CacheWriterInbox = Inbox CacheWriterMessage

type CacheWriter = Mailbox CacheWriterMessage

data AddressXPub = AddressXPub
  { AddressXPub -> XPubSpec
spec :: !XPubSpec,
    AddressXPub -> [BlockHeight]
path :: ![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
$cshowsPrec :: Int -> AddressXPub -> ShowS
showsPrec :: Int -> AddressXPub -> ShowS
$cshow :: AddressXPub -> String
show :: AddressXPub -> String
$cshowList :: [AddressXPub] -> ShowS
showList :: [AddressXPub] -> ShowS
Show, AddressXPub -> AddressXPub -> Bool
(AddressXPub -> AddressXPub -> Bool)
-> (AddressXPub -> AddressXPub -> Bool) -> Eq AddressXPub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressXPub -> AddressXPub -> Bool
== :: AddressXPub -> AddressXPub -> Bool
$c/= :: AddressXPub -> AddressXPub -> Bool
/= :: 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
$cfrom :: forall x. AddressXPub -> Rep AddressXPub x
from :: forall x. AddressXPub -> Rep AddressXPub x
$cto :: forall x. Rep AddressXPub x -> AddressXPub
to :: forall x. Rep AddressXPub x -> AddressXPub
Generic, AddressXPub -> ()
(AddressXPub -> ()) -> NFData AddressXPub
forall a. (a -> ()) -> NFData a
$crnf :: AddressXPub -> ()
rnf :: AddressXPub -> ()
NFData, Get AddressXPub
Putter AddressXPub
Putter AddressXPub -> Get AddressXPub -> Serialize AddressXPub
forall t. Putter t -> Get t -> Serialize t
$cput :: Putter AddressXPub
put :: Putter AddressXPub
$cget :: Get AddressXPub
get :: Get 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 :: Ctx -> DeriveType -> XPubKey -> Address
xPubAddrFunction :: Ctx -> DeriveType -> XPubKey -> Address
xPubAddrFunction Ctx
ctx DeriveType
DeriveNormal = Ctx -> XPubKey -> Address
xPubAddr Ctx
ctx
xPubAddrFunction Ctx
ctx DeriveType
DeriveP2SH = Ctx -> XPubKey -> Address
xPubCompatWitnessAddr Ctx
ctx
xPubAddrFunction Ctx
ctx DeriveType
DeriveP2WPKH = Ctx -> XPubKey -> Address
xPubWitnessAddr Ctx
ctx

cacheWriter ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheConfig ->
  CacheWriterInbox ->
  m ()
cacheWriter :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
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
        $(logDebugS) Text
"Cache" Text
"Awaiting event..."
        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 Bool
lockIt :: forall (m :: * -> *). MonadLoggerIO m => CacheX m Bool
lockIt = do
  ReaderT CacheConfig m (Either Reply Status)
go ReaderT CacheConfig m (Either Reply Status)
-> (Either Reply Status -> CacheX m Bool) -> CacheX m Bool
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Status
Redis.Ok -> do
      $(logDebugS) Text
"Cache" Text
"Acquired lock"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.lockAcquired) Int
1
      return Bool
True
    Right Status
Redis.Pong -> do
      $(logErrorS)
        Text
"Cache"
        Text
"Unexpected pong when acquiring lock"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.lockFailed) Int
1
      return Bool
False
    Right (Redis.Status ByteString
s) -> do
      $(logErrorS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
        Text
"Unexpected status acquiring lock: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
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 (.lockFailed) Int
1
      return Bool
False
    Left (Redis.Bulk Maybe ByteString
Nothing) -> do
      $(logDebugS) Text
"Cache" Text
"Lock already taken"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.lockFailed) Int
1
      return Bool
False
    Left Reply
e -> do
      $(logErrorS)
        Text
"Cache"
        Text
"Error when trying to acquire lock"
      (CacheMetrics -> Counter) -> Int -> ReaderT CacheConfig m ()
forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter (.lockFailed) Int
1
      CacheError -> CacheX m Bool
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Reply -> CacheError
RedisError Reply
e)
  where
    go :: ReaderT CacheConfig m (Either Reply Status)
go = do
      Connection
conn <- (CacheConfig -> Connection) -> ReaderT CacheConfig m Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.redis)
      IO (Either Reply Status)
-> ReaderT CacheConfig m (Either Reply Status)
forall a. IO a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Reply Status)
 -> ReaderT CacheConfig m (Either Reply Status))
-> (Redis (Either Reply Status) -> IO (Either Reply Status))
-> Redis (Either Reply Status)
-> ReaderT CacheConfig 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)
 -> ReaderT CacheConfig m (Either Reply Status))
-> Redis (Either Reply Status)
-> ReaderT CacheConfig m (Either Reply Status)
forall a b. (a -> b) -> a -> b
$ do
        let opts :: SetOpts
opts =
              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" ByteString
"locked" SetOpts
opts

refreshLock :: (MonadLoggerIO m) => CacheX m ()
refreshLock :: forall (m :: * -> *). MonadLoggerIO m => CacheX m ()
refreshLock = ReaderT CacheConfig m Status -> ReaderT CacheConfig m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m Status -> ReaderT CacheConfig m ())
-> (Redis (Either Reply Status) -> ReaderT CacheConfig m Status)
-> Redis (Either Reply Status)
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply Status) -> ReaderT CacheConfig m Status
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply Status) -> ReaderT CacheConfig m ())
-> Redis (Either Reply Status) -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ do
  let opts :: SetOpts
opts =
        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.Xx
          }
  ByteString -> ByteString -> SetOpts -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> SetOpts -> m (f Status)
Redis.setOpts ByteString
"lock" ByteString
"locked" SetOpts
opts

unlockIt :: (MonadLoggerIO m) => Bool -> CacheX m ()
unlockIt :: forall (m :: * -> *). MonadLoggerIO m => Bool -> CacheX m ()
unlockIt Bool
False = () -> ReaderT CacheConfig m ()
forall a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unlockIt Bool
True = ReaderT CacheConfig m Integer -> ReaderT CacheConfig m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m Integer -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m Integer -> ReaderT CacheConfig 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"])

withLock ::
  (MonadLoggerIO m, MonadUnliftIO m) =>
  CacheX m a ->
  CacheX m (Maybe a)
withLock :: forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock CacheX m a
f =
  ReaderT CacheConfig m Bool
-> (Bool -> ReaderT CacheConfig m ())
-> (Bool -> ReaderT CacheConfig m (Maybe a))
-> ReaderT CacheConfig m (Maybe a)
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ReaderT CacheConfig m Bool
forall (m :: * -> *). MonadLoggerIO m => CacheX m Bool
lockIt Bool -> ReaderT CacheConfig m ()
forall (m :: * -> *). MonadLoggerIO m => Bool -> CacheX m ()
unlockIt ((Bool -> ReaderT CacheConfig m (Maybe a))
 -> ReaderT CacheConfig m (Maybe a))
-> (Bool -> ReaderT CacheConfig m (Maybe a))
-> ReaderT CacheConfig m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
    Bool
True -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> CacheX m a -> ReaderT CacheConfig m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheX m a
go
    Bool
False -> Maybe a -> ReaderT CacheConfig m (Maybe a)
forall a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  where
    go :: CacheX m a
go = ReaderT CacheConfig m Any
-> (Async Any -> CacheX m a) -> CacheX m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync ReaderT CacheConfig m Any
forall {b}. ReaderT CacheConfig m b
refresh ((Async Any -> CacheX m a) -> CacheX m a)
-> (Async Any -> CacheX m a) -> CacheX m a
forall a b. (a -> b) -> a -> b
$ CacheX m a -> Async Any -> CacheX m a
forall a b. a -> b -> a
const CacheX m a
f
    refresh :: ReaderT CacheConfig m b
refresh = ReaderT CacheConfig m () -> ReaderT CacheConfig m b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ReaderT CacheConfig m () -> ReaderT CacheConfig m b)
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m b
forall a b. (a -> b) -> a -> b
$ do
      Int -> ReaderT CacheConfig m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
150 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
      ReaderT CacheConfig m ()
forall (m :: * -> *). MonadLoggerIO m => CacheX m ()
refreshLock

isFull ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  CacheX m Bool
isFull :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
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 (.maxKeys)
  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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Integer
pruneDB = do
  Integer
x <- (CacheConfig -> Integer) -> CacheX m Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (((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)
-> (CacheConfig -> Integer) -> CacheConfig -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.maxKeys))
  -- 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 a. a -> ReaderT CacheConfig m a
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 a. a -> ReaderT CacheConfig m a
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 a b.
(a -> b) -> ReaderT CacheConfig m a -> ReaderT CacheConfig m b
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)
          $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            Text
"Pruning " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
ks)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 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 :: forall (m :: * -> *). MonadLoggerIO m => [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 a. IO a -> ReaderT CacheConfig m a
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 :: forall (f :: * -> *) (m :: * -> *) a.
(Monad f, RedisCtx m f, Real a) =>
a -> [XPubSpec] -> m (f ())
redisTouchKeys a
_ [] = f () -> m (f ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f () -> m (f ())) -> f () -> m (f ())
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall a. a -> f a
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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheWriterMessage -> CacheX m ()
cacheWriterReact CacheWriterMessage
CacheNewBlock = do
  $(logDebugS) Text
"Cache" Text
"Received new block event"
  CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
  CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC
cacheWriterReact (CacheNewTx TxHash
txid) = do
  $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    Text
"Received new transaction event: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
txid
  [TxHash] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
[TxHash] -> CacheX m ()
syncNewTxC [TxHash
txid]
cacheWriterReact (CacheSyncMempool Listen ()
l) = do
  $(logDebugS) Text
"Cache" Text
"Received sync mempool event"
  CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
  CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC
  STM () -> CacheX m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> CacheX m ()) -> STM () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Listen ()
l ()

lenNotNull :: [XPubBal] -> Int
lenNotNull :: [XPubBal] -> Int
lenNotNull = [XPubBal] -> Int
forall a. [a] -> 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
. (.balance))

newXPubC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  CacheX m ()
newXPubC :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals =
  ReaderT CacheConfig m Bool
should_index ReaderT CacheConfig m Bool
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
i -> Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
i (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
    ReaderT CacheConfig m Bool
-> (Bool -> ReaderT CacheConfig m ())
-> (Bool -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig 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 -> ReaderT CacheConfig m ()
forall (m :: * -> *). MonadLoggerIO m => Bool -> CacheX m ()
unset_index ((Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ())
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ \Bool
j -> Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
j (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
      (CacheMetrics -> StatDist)
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(CacheMetrics -> StatDist) -> CacheX m a -> CacheX m a
withMetrics (.indexTime) (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ do
        Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
        $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
          Text
"Caching "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" addresses / "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
lenNotNull [XPubBal]
xbals))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" used"
        [XPubUnspent]
utxo <- m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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
        $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
          Text
"Caching "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubUnspent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
utxo))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" utxos"
        [TxRef]
xtxs <- m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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
        $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
          Text
"Caching "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
xtxs))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 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 a. IO a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
        Redis (Either Reply ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> ReaderT CacheConfig m ())
-> Redis (Either Reply ()) -> ReaderT CacheConfig 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 a b. Either Reply a -> Either Reply b -> Either Reply b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
c Either Reply () -> Either Reply Integer -> Either Reply Integer
forall a b. Either Reply a -> Either Reply b -> Either Reply b
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 a b. Either Reply a -> Either Reply b -> Either Reply b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
e Either Reply Integer -> Either Reply () -> Either Reply ()
forall a b. Either Reply a -> Either Reply b -> Either Reply b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either Reply ()
forall a. a -> Either Reply a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ Text
"Cached " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
  where
    op :: XPubUnspent -> (OutPoint, BlockRef)
op XPubUnspent {$sel:unspent:XPubUnspent :: XPubUnspent -> Unspent
unspent = Unspent
u} = (Unspent
u.outpoint, Unspent
u.block)
    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 (.minAddrs) ReaderT CacheConfig m Int
-> (Int -> ReaderT CacheConfig m Bool)
-> ReaderT CacheConfig m Bool
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
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 a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
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 a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else Bool -> ReaderT CacheConfig m Bool
forall a. a -> ReaderT CacheConfig m a
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 =
      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 = do
      Connection
conn <- (CacheConfig -> Connection) -> ReaderT CacheConfig m Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.redis)
      IO (Either Reply Status)
-> ReaderT CacheConfig m (Either Reply Status)
forall a. IO a -> ReaderT CacheConfig m a
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 -> Bool) -> ReaderT CacheConfig m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Either Reply Status -> Bool
forall a b. Either a b -> Bool
isRight

inSync ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m Bool
inSync :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync =
  m (Maybe BlockHash) -> ReaderT CacheConfig m (Maybe BlockHash)
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 -> ReaderT CacheConfig m Bool)
-> ReaderT CacheConfig m Bool
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockHash
Nothing -> Bool -> ReaderT CacheConfig m Bool
forall a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just BlockHash
bb -> do
      Chain
ch <- (CacheConfig -> Chain) -> ReaderT CacheConfig m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.chain)
      BlockNode
cb <- Chain -> ReaderT CacheConfig m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
      return $ BlockNode
cb.height BlockHeight -> BlockHeight -> Bool
forall a. Ord a => a -> a -> Bool
> BlockHeight
0 Bool -> Bool -> Bool
&& BlockHeader -> BlockHash
headerHash BlockNode
cb.header BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bb

newBlockC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m ()
newBlockC :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC =
  CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s -> Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m (Maybe ()) -> ReaderT CacheConfig m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m (Maybe ()) -> ReaderT CacheConfig m ())
-> (ReaderT CacheConfig m () -> ReaderT CacheConfig m (Maybe ()))
-> ReaderT CacheConfig m ()
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ do
    ReaderT CacheConfig m (Maybe BlockNode)
get_best_block_node ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe BlockNode
Nothing -> $(logErrorS) Text
"Cache" Text
"No best block available"
      Just BlockNode
best_block_node ->
        CacheX m (Maybe BlockHash)
forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead CacheX m (Maybe BlockHash)
-> (Maybe BlockHash -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe BlockHash
Nothing -> do
            $(logInfoS) Text
"Cache" Text
"Initializing best cache block"
            BlockHash -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
importBlockC (BlockHash -> ReaderT CacheConfig m ())
-> BlockHash -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash BlockNode
best_block_node.header
          Just BlockHash
cache_head_hash ->
            BlockHash -> ReaderT CacheConfig m (Maybe BlockNode)
forall {m :: * -> *} {r}.
(MonadReader r m, HasField "chain" r Chain, MonadIO m) =>
BlockHash -> m (Maybe BlockNode)
get_block_node BlockHash
cache_head_hash ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe BlockNode
Nothing -> do
                $(logErrorS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                  Text
"Could not get best cache block: "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
cache_head_hash
              Just BlockNode
cache_head_node -> do
                [BlockHash]
blocks <- BlockNode -> BlockNode -> ReaderT CacheConfig m [BlockHash]
forall {m :: * -> *} {r}.
(MonadReader r m, HasField "chain" r Chain, MonadIO m) =>
BlockNode -> BlockNode -> m [BlockHash]
get_blocks BlockNode
cache_head_node BlockNode
best_block_node
                (BlockHash -> ReaderT CacheConfig m ())
-> [BlockHash] -> ReaderT CacheConfig m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BlockHash -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
importBlockC [BlockHash]
blocks
  where
    get_best_block_node :: ReaderT CacheConfig m (Maybe BlockNode)
get_best_block_node =
      m (Maybe BlockHash) -> CacheX m (Maybe BlockHash)
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 CacheX m (Maybe BlockHash)
-> (Maybe BlockHash -> ReaderT CacheConfig m (Maybe BlockNode))
-> ReaderT CacheConfig m (Maybe BlockNode)
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> Maybe BlockNode -> ReaderT CacheConfig m (Maybe BlockNode)
forall a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BlockNode
forall a. Maybe a
Nothing
        Just BlockHash
best_block_hash -> BlockHash -> ReaderT CacheConfig m (Maybe BlockNode)
forall {m :: * -> *} {r}.
(MonadReader r m, HasField "chain" r Chain, MonadIO m) =>
BlockHash -> m (Maybe BlockNode)
get_block_node BlockHash
best_block_hash
    get_block_node :: BlockHash -> m (Maybe BlockNode)
get_block_node BlockHash
block_hash = do
      Chain
ch <- (r -> Chain) -> m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.chain)
      BlockHash -> Chain -> m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
BlockHash -> Chain -> m (Maybe BlockNode)
chainGetBlock BlockHash
block_hash Chain
ch
    get_blocks :: BlockNode -> BlockNode -> m [BlockHash]
get_blocks BlockNode
left_node BlockNode
right_node = do
      Chain
ch <- (r -> Chain) -> m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.chain)
      BlockNode
split_node <- BlockNode -> BlockNode -> Chain -> m BlockNode
forall (m :: * -> *).
MonadIO m =>
BlockNode -> BlockNode -> Chain -> m BlockNode
chainGetSplitBlock BlockNode
left_node BlockNode
right_node Chain
ch
      let split_node_hash :: BlockHash
split_node_hash = BlockHeader -> BlockHash
headerHash BlockNode
split_node.header
          right_node_hash :: BlockHash
right_node_hash = BlockHeader -> BlockHash
headerHash BlockNode
right_node.header
      if BlockHash
split_node_hash BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
right_node_hash
        then [BlockHash] -> m [BlockHash]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
          let fork_height :: BlockHeight
fork_height = BlockNode
split_node.height BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ BlockHeight
1
          [BlockNode]
left_parents <- BlockHeight -> BlockNode -> Chain -> m [BlockNode]
forall (m :: * -> *).
MonadIO m =>
BlockHeight -> BlockNode -> Chain -> m [BlockNode]
chainGetParents BlockHeight
fork_height BlockNode
left_node Chain
ch
          [BlockNode]
right_parents <- BlockHeight -> BlockNode -> Chain -> m [BlockNode]
forall (m :: * -> *).
MonadIO m =>
BlockHeight -> BlockNode -> Chain -> m [BlockNode]
chainGetParents BlockHeight
fork_height BlockNode
right_node Chain
ch
          let blocks :: [BlockNode]
blocks = [BlockNode] -> [BlockNode]
forall {a}. [a] -> [a]
reverse [BlockNode]
left_parents [BlockNode] -> [BlockNode] -> [BlockNode]
forall a. Semigroup a => a -> a -> a
<> [BlockNode]
right_parents [BlockNode] -> [BlockNode] -> [BlockNode]
forall a. Semigroup a => a -> a -> a
<> BlockNode -> [BlockNode]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockNode
right_node
          [BlockHash] -> m [BlockHash]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
return ([BlockHash] -> m [BlockHash]) -> [BlockHash] -> m [BlockHash]
forall a b. (a -> b) -> a -> b
$ (BlockNode -> BlockHash) -> [BlockNode] -> [BlockHash]
forall a b. (a -> b) -> [a] -> [b]
map (BlockHeader -> BlockHash
headerHash (BlockHeader -> BlockHash)
-> (BlockNode -> BlockHeader) -> BlockNode -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.header)) [BlockNode]
blocks

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

importMultiTxC ::
  (MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
  [TxData] ->
  CacheX m ()
importMultiTxC :: forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC [TxData]
txs = do
  Ctx
ctx <- m Ctx -> ReaderT CacheConfig m Ctx
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
  $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Text
"Processing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
txs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" txs"
  $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    Text
"Getting address information for "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show (HashSet Address -> Int
forall a. HashSet a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ctx -> HashSet Address
alladdrs Ctx
ctx)))
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" addresses"
  HashMap Address AddressXPub
addrmap <- Ctx -> ReaderT CacheConfig m (HashMap Address AddressXPub)
forall {m :: * -> *}.
MonadLoggerIO m =>
Ctx -> ReaderT CacheConfig m (HashMap Address AddressXPub)
getaddrmap Ctx
ctx
  let addrs :: [Address]
addrs = HashMap Address AddressXPub -> [Address]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Address AddressXPub
addrmap
  $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    Text
"Getting balances for "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
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))
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 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
  $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    Text
"Getting unspent data for "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([OutPoint] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ctx -> [OutPoint]
allops Ctx
ctx)))
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" outputs"
  HashMap OutPoint Unspent
unspentmap <- Ctx -> ReaderT CacheConfig m (HashMap OutPoint Unspent)
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, StoreReadBase m, Functor (t m)) =>
Ctx -> t m (HashMap OutPoint Unspent)
getunspents Ctx
ctx
  BlockHeight
gap <- m BlockHeight -> ReaderT CacheConfig m BlockHeight
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 a. IO a -> ReaderT CacheConfig m a
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
    Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
    $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
      Text
"Affected xpub "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show Int
i)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
xpubs))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
  [(Address, AddressXPub)]
addrs' <- do
    $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
      Text
"Getting xpub balances for "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
xpubs))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 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 :: * -> *} {a} {r} {k}.
(Foldable t, Eq a, HasField "spec" r a) =>
t a -> HashMap k r -> HashMap k r
faddrmap (HashMap XPubSpec [XPubBal] -> HashSet XPubSpec
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap XPubSpec [XPubBal]
xmap) HashMap Address AddressXPub
addrmap
    $(logDebugS) Text
"Cache" Text
"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 <- Ctx
-> HashMap Address AddressXPub
-> HashMap OutPoint Unspent
-> [TxData]
-> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
Ctx
-> HashMap Address AddressXPub
-> HashMap OutPoint Unspent
-> [TxData]
-> m (f ())
redisImportMultiTx Ctx
ctx 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 a b. Either Reply a -> Either Reply b -> Either Reply b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
y Either Reply () -> Either Reply () -> Either Reply ()
forall a b. Either Reply a -> Either Reply b -> Either Reply b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
z Either Reply () -> Either Reply () -> Either Reply ()
forall a b. Either Reply a -> Either Reply b -> Either Reply b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either Reply ()
forall a. a -> Either Reply a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    $(logDebugS) Text
"Cache" Text
"Completed Redis pipeline"
    return $ Ctx
-> BlockHeight
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
-> [(Address, AddressXPub)]
getNewAddrs Ctx
ctx 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 :: Ctx -> [Address]
alladdrsls Ctx
ctx = HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList (Ctx -> HashSet Address
alladdrs Ctx
ctx)
    faddrmap :: t a -> HashMap k r -> HashMap k r
faddrmap t a
xmap = (r -> Bool) -> HashMap k r -> HashMap k r
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (\r
a -> r
a.spec a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
xmap)
    getaddrmap :: Ctx -> ReaderT CacheConfig m (HashMap Address AddressXPub)
getaddrmap Ctx
ctx =
      [(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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address
a,)) (Ctx -> [Address]
alladdrsls Ctx
ctx)
        ([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 (Ctx -> [Address]
alladdrsls Ctx
ctx)
    getunspents :: Ctx -> t m (HashMap OutPoint Unspent)
getunspents Ctx
ctx =
      [(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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutPoint
p,)) (Ctx -> [OutPoint]
allops Ctx
ctx)
        ([Maybe Unspent] -> HashMap OutPoint Unspent)
-> t m [Maybe Unspent] -> t m (HashMap OutPoint Unspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Maybe Unspent] -> t m [Maybe Unspent]
forall (m :: * -> *) a. Monad m => m a -> t m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent (Ctx -> [OutPoint]
allops Ctx
ctx))
    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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (m Balance -> t m Balance
forall (m :: * -> *) a. Monad m => m a -> t m a
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 a b. (a -> b) -> Redis a -> Redis b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 a. [a] -> 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 :: Ctx -> [OutPoint]
allops Ctx
ctx =
      ((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 (Ctx -> TxData -> [(Address, OutPoint)]
txInputs Ctx
ctx) [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 (Ctx -> TxData -> [(Address, OutPoint)]
txOutputs Ctx
ctx) [TxData]
txs
    alladdrs :: Ctx -> HashSet Address
alladdrs Ctx
ctx =
      [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address) -> [Address] -> HashSet Address
forall a b. (a -> b) -> a -> b
$
        ((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)] -> [Address])
-> [(Address, OutPoint)] -> [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 (Ctx -> TxData -> [(Address, OutPoint)]
txInputs Ctx
ctx) [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 (Ctx -> TxData -> [(Address, OutPoint)]
txOutputs Ctx
ctx) [TxData]
txs
    allxpubsls :: HashMap k AddressXPub -> [XPubSpec]
allxpubsls = HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList (HashSet XPubSpec -> [XPubSpec])
-> (HashMap k AddressXPub -> HashSet XPubSpec)
-> HashMap k AddressXPub
-> [XPubSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k AddressXPub -> HashSet XPubSpec
forall {k}. HashMap k AddressXPub -> HashSet XPubSpec
allxpubs
    allxpubs :: HashMap k AddressXPub -> HashSet XPubSpec
allxpubs =
      [XPubSpec] -> HashSet XPubSpec
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([XPubSpec] -> HashSet XPubSpec)
-> (HashMap k AddressXPub -> [XPubSpec])
-> HashMap k 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 (.spec) ([AddressXPub] -> [XPubSpec])
-> (HashMap k AddressXPub -> [AddressXPub])
-> HashMap k AddressXPub
-> [XPubSpec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k AddressXPub -> [AddressXPub]
forall k v. HashMap k v -> [v]
HashMap.elems

redisImportMultiTx ::
  (Monad f, RedisCtx m f) =>
  Ctx ->
  HashMap Address AddressXPub ->
  HashMap OutPoint Unspent ->
  [TxData] ->
  m (f ())
redisImportMultiTx :: forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
Ctx
-> HashMap Address AddressXPub
-> HashMap OutPoint Unspent
-> [TxData]
-> m (f ())
redisImportMultiTx Ctx
ctx HashMap Address AddressXPub
addrmap HashMap OutPoint Unspent
unspentmap [TxData]
tds = 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxData -> m (f ())
forall {f :: * -> *} {m :: * -> *}.
(RedisCtx f m, Monad m) =>
TxData -> f (m ())
importtxentries [TxData]
tds
  return $ [f ()] -> f ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f ()]
xs
  where
    uns :: OutPoint -> r -> m (f Integer)
uns OutPoint
p r
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 r
i.spec [(OutPoint
p, Unspent
u.block)]
        Maybe Unspent
Nothing -> XPubSpec -> [OutPoint] -> m (f Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [OutPoint] -> m (f Integer)
redisRemXPubUnspents r
i.spec [OutPoint
p]
    addtx :: p -> Address -> OutPoint -> f (m ())
addtx p
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
                  { $sel:txid:TxRef :: TxHash
txid = Tx -> TxHash
txHash p
tx.tx,
                    $sel:block:TxRef :: BlockRef
block = p
tx.block
                  }
          m Integer
x <- XPubSpec -> [TxRef] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs AddressXPub
i.spec [TxRef
tr]
          m Integer
y <- OutPoint -> AddressXPub -> f (m Integer)
forall {m :: * -> *} {f :: * -> *} {r}.
(RedisCtx m f, HasField "spec" r XPubSpec, Applicative f) =>
OutPoint -> r -> m (f Integer)
uns OutPoint
p AddressXPub
i
          return $ m Integer
x m Integer -> m Integer -> m Integer
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer
y m Integer -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe AddressXPub
Nothing -> m () -> f (m ())
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    remtx :: r -> Address -> OutPoint -> f (m ())
remtx r
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
i.spec [Tx -> TxHash
txHash r
tx.tx]
          m Integer
y <- OutPoint -> AddressXPub -> f (m Integer)
forall {m :: * -> *} {f :: * -> *} {r}.
(RedisCtx m f, HasField "spec" r XPubSpec, Applicative f) =>
OutPoint -> r -> m (f Integer)
uns OutPoint
p AddressXPub
i
          return $ m Integer
x m Integer -> m Integer -> m Integer
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer
y m Integer -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe AddressXPub
Nothing -> m () -> f (m ())
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    importtxentries :: TxData -> f (m ())
importtxentries TxData
td =
      if TxData
td.deleted
        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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: * -> *} {r}.
(RedisCtx f m, HasField "tx" r Tx, Monad m) =>
r -> Address -> OutPoint -> f (m ())
remtx TxData
td))
              (TxData -> [(Address, OutPoint)]
txaddrops TxData
td)
          m Integer
y <- [TxHash] -> f (m Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
[TxHash] -> m (f Integer)
redisRemFromMempool [Tx -> TxHash
txHash TxData
td.tx]
          return $ [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
x m () -> m () -> m ()
forall a b. m a -> m b -> m b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: * -> *} {p}.
(RedisCtx f m, Monad m, HasField "block" p BlockRef,
 HasField "tx" p Tx) =>
p -> Address -> OutPoint -> f (m ())
addtx TxData
td))
                (TxData -> [(Address, OutPoint)]
txaddrops TxData
td)
          m Integer
b <-
            case TxData
td.block of
              b :: BlockRef
b@MemRef {} ->
                let tr :: TxRef
tr =
                      TxRef
                        { $sel:txid:TxRef :: TxHash
txid = Tx -> TxHash
txHash TxData
td.tx,
                          $sel:block:TxRef :: BlockRef
block = 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
td.tx]
          return $ m [()]
a m [()] -> m Integer -> m Integer
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Integer
b m Integer -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    txaddrops :: TxData -> [(Address, OutPoint)]
txaddrops TxData
td = Ctx -> TxData -> [(Address, OutPoint)]
txInputs Ctx
ctx TxData
td [(Address, OutPoint)]
-> [(Address, OutPoint)] -> [(Address, OutPoint)]
forall a. Semigroup a => a -> a -> a
<> Ctx -> TxData -> [(Address, OutPoint)]
txOutputs Ctx
ctx TxData
td

redisUpdateBalances ::
  (Monad f, RedisCtx m f) =>
  HashMap Address AddressXPub ->
  HashMap Address Balance ->
  m (f ())
redisUpdateBalances :: 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 =
  ([f ()] -> f ()) -> m [f ()] -> m (f ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([()] -> ()) -> f [()] -> f ()
forall a b. (a -> b) -> f a -> f b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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
ainfo.spec [AddressXPub -> Balance -> XPubBal
forall {r}.
HasField "path" r [BlockHeight] =>
r -> Balance -> XPubBal
xpubbal AddressXPub
ainfo Balance
bal]
      (Maybe AddressXPub, Maybe Balance)
_ -> f () -> m (f ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  where
    xpubbal :: r -> Balance -> XPubBal
xpubbal r
ainfo Balance
bal =
      XPubBal {$sel:path:XPubBal :: [BlockHeight]
path = r
ainfo.path, $sel:balance:XPubBal :: Balance
balance = Balance
bal}

cacheAddAddresses ::
  (StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
  [(Address, AddressXPub)] ->
  CacheX m ()
cacheAddAddresses :: forall (m :: * -> *).
(StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
[(Address, AddressXPub)] -> CacheX m ()
cacheAddAddresses [] = $(logDebugS) Text
"Cache" Text
"No further addresses to add"
cacheAddAddresses [(Address, AddressXPub)]
addrs = do
  Ctx
ctx <- m Ctx -> ReaderT CacheConfig m Ctx
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
  $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
    Text
"Adding " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([(Address, AddressXPub)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Address, AddressXPub)]
addrs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" new generated addresses"
  $(logDebugS) Text
"Cache" Text
"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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: * -> *} {p} {a}.
(MonadTrans t, StoreReadBase m, Functor (t m),
 HasField "path" p [BlockHeight], HasField "spec" p a) =>
Address -> p -> t m (a, [XPubBal])
getbal) [(Address, AddressXPub)]
addrs
  $(logDebugS) Text
"Cache" Text
"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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: * -> *} {p} {a}.
(MonadTrans t, StoreReadExtra m, Functor (t m),
 HasField "spec" p a) =>
Address -> p -> t m (a, [(OutPoint, BlockRef)])
getutxo) [(Address, AddressXPub)]
addrs
  $(logDebugS) Text
"Cache" Text
"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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 :: * -> *} {p} {a}.
(MonadTrans t, StoreReadExtra m, Functor (t m),
 HasField "spec" p a) =>
Address -> p -> t m (a, [TxRef])
gettxmap) [(Address, AddressXPub)]
addrs
  $(logDebugS) Text
"Cache" Text
"Running Redis pipeline"
  Redis (Either Reply ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> ReaderT CacheConfig m ())
-> Redis (Either Reply ()) -> ReaderT CacheConfig 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 a b. Either Reply a -> Either Reply b -> Either Reply b
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 a b. Either Reply a -> Either Reply b -> Either Reply b
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
  $(logDebugS) Text
"Cache" Text
"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 (.spec)
          ([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
  $(logDebugS) Text
"Cache" Text
"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 (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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' = Ctx
-> BlockHeight
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
-> [(Address, AddressXPub)]
getNewAddrs Ctx
ctx BlockHeight
gap HashMap XPubSpec [XPubBal]
xmap [AddressXPub]
notnulls
  [(Address, AddressXPub)] -> ReaderT CacheConfig 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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 a. [a] -> 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 -> [r] -> [AddressXPub]
f XPubSpec
xpub =
            (r -> AddressXPub) -> [r] -> [AddressXPub]
forall a b. (a -> b) -> [a] -> [b]
map ((r -> AddressXPub) -> [r] -> [AddressXPub])
-> (r -> AddressXPub) -> [r] -> [AddressXPub]
forall a b. (a -> b) -> a -> b
$ \r
bal ->
              AddressXPub
                { $sel:spec:AddressXPub :: XPubSpec
spec = XPubSpec
xpub,
                  $sel:path:AddressXPub :: [BlockHeight]
path = r
bal.path
                }
          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
. (.balance))
       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]
forall {r}.
HasField "path" r [BlockHeight] =>
XPubSpec -> [r] -> [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 -> p -> t m (a, [XPubBal])
getbal Address
a p
i =
      let f :: Balance -> (a, [XPubBal])
f Balance
b =
            ( p
i.spec,
              [XPubBal {$sel:balance:XPubBal :: Balance
balance = Balance
b, $sel:path:XPubBal :: [BlockHeight]
path = p
i.path}]
            )
       in Balance -> (a, [XPubBal])
f (Balance -> (a, [XPubBal])) -> t m Balance -> t m (a, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Balance -> t m Balance
forall (m :: * -> *) a. Monad m => m a -> t m a
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 -> p -> t m (a, [(OutPoint, BlockRef)])
getutxo Address
a p
i =
      let f :: [r] -> (a, [(a, b)])
f [r]
us =
            ( p
i.spec,
              (r -> (a, b)) -> [r] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\r
u -> (r
u.outpoint, r
u.block)) [r]
us
            )
       in [Unspent] -> (a, [(OutPoint, BlockRef)])
forall {r} {b} {a}.
(HasField "block" r b, HasField "outpoint" r a) =>
[r] -> (a, [(a, b)])
f ([Unspent] -> (a, [(OutPoint, BlockRef)]))
-> t m [Unspent] -> t m (a, [(OutPoint, BlockRef)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Unspent] -> t m [Unspent]
forall (m :: * -> *) a. Monad m => m a -> t m a
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 -> p -> t m (a, [TxRef])
gettxmap Address
a p
i =
      let f :: b -> (a, b)
f b
ts = (p
i.spec, b
ts)
       in [TxRef] -> (a, [TxRef])
forall {b}. b -> (a, b)
f ([TxRef] -> (a, [TxRef])) -> t m [TxRef] -> t m (a, [TxRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [TxRef] -> t m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> t m a
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 ::
  Ctx ->
  KeyIndex ->
  HashMap XPubSpec [XPubBal] ->
  [AddressXPub] ->
  [(Address, AddressXPub)]
getNewAddrs :: Ctx
-> BlockHeight
-> HashMap XPubSpec [XPubBal]
-> [AddressXPub]
-> [(Address, AddressXPub)]
getNewAddrs Ctx
ctx 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
a.spec HashMap XPubSpec [XPubBal]
xpubs of
      Maybe [XPubBal]
Nothing -> []
      Just [XPubBal]
bals -> Ctx
-> BlockHeight
-> [XPubBal]
-> AddressXPub
-> [(Address, AddressXPub)]
addrsToAdd Ctx
ctx BlockHeight
gap [XPubBal]
bals AddressXPub
a

syncNewTxC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  [TxHash] ->
  CacheX m ()
syncNewTxC :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
[TxHash] -> CacheX m ()
syncNewTxC [TxHash]
ths =
  CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s -> Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m (Maybe ()) -> ReaderT CacheConfig m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m (Maybe ()) -> ReaderT CacheConfig m ())
-> (ReaderT CacheConfig m () -> ReaderT CacheConfig m (Maybe ()))
-> ReaderT CacheConfig m ()
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ do
    [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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
    Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TxData] -> Bool
forall a. [a] -> 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
      [TxData]
-> (TxData -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TxData]
txs ((TxData -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ())
-> (TxData -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ \TxData
tx ->
        $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
          Text
"Synchronizing transaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash TxData
tx.tx)
      [TxData] -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC [TxData]
txs

syncMempoolC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m ()
syncMempoolC :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC =
  CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall a b.
ReaderT CacheConfig m a
-> (a -> ReaderT CacheConfig m b) -> ReaderT CacheConfig m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s -> Bool -> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m (Maybe ()) -> ReaderT CacheConfig m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m (Maybe ()) -> ReaderT CacheConfig m ())
-> (ReaderT CacheConfig m () -> ReaderT CacheConfig m (Maybe ()))
-> ReaderT CacheConfig m ()
-> ReaderT CacheConfig m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT CacheConfig m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (ReaderT CacheConfig m () -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m () -> ReaderT CacheConfig 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)
-> ([(Word64, TxHash)] -> [TxHash])
-> [(Word64, TxHash)]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, TxHash) -> TxHash) -> [(Word64, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(Word64, TxHash)] -> HashSet TxHash)
-> ReaderT CacheConfig m [(Word64, TxHash)]
-> ReaderT CacheConfig m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [(Word64, TxHash)] -> ReaderT CacheConfig m [(Word64, TxHash)]
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
    HashSet TxHash
cachepool <- [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> ([(Word64, TxHash)] -> [TxHash])
-> [(Word64, TxHash)]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, TxHash) -> TxHash) -> [(Word64, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(Word64, TxHash)] -> HashSet TxHash)
-> ReaderT CacheConfig m [(Word64, TxHash)]
-> ReaderT CacheConfig m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT CacheConfig m [(Word64, TxHash)]
forall (m :: * -> *).
MonadLoggerIO m =>
CacheX m [(Word64, TxHash)]
cacheGetMempool
    let diff1 :: HashSet TxHash
diff1 = 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
    let diff2 :: HashSet TxHash
diff2 = 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
    let diffset :: HashSet TxHash
diffset = HashSet TxHash
diff1 HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. Semigroup a => a -> a -> a
<> HashSet TxHash
diff2
    let tids :: [TxHash]
tids = HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
diffset
    [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 a. [a] -> 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
      $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
        Text
"Synchronizing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
txs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" mempool transactions"
      [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 :: forall (m :: * -> *).
MonadLoggerIO m =>
CacheX m [(Word64, TxHash)]
cacheGetMempool = Redis (Either Reply [(Word64, TxHash)])
-> CacheX m [(Word64, TxHash)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis Redis (Either Reply [(Word64, TxHash)])
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
m (f [(Word64, TxHash)])
redisGetMempool

cacheIsInMempool :: (MonadLoggerIO m) => TxHash -> CacheX m Bool
cacheIsInMempool :: forall (m :: * -> *). MonadLoggerIO m => 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 :: forall (m :: * -> *). MonadLoggerIO m => 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 :: forall (m :: * -> *).
(MonadLoggerIO m, StoreReadBase m) =>
BlockHash -> CacheX m ()
cacheSetHead BlockHash
bh = do
  $(logDebugS) Text
"Cache" (Text -> CacheX m ()) -> Text -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Text
"Cache head set to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
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 :: forall (m :: * -> *).
MonadLoggerIO m =>
[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 :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
[TxRef] -> m (f Integer)
redisAddToMempool [] = f Integer -> m (f Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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
btx.block, TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode TxRef
btx.txid))
      [TxRef]
btxs

redisIsInMempool :: (Applicative f, RedisCtx m f) => TxHash -> m (f Bool)
redisIsInMempool :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
TxHash -> m (f Bool)
redisIsInMempool TxHash
txid =
  (Maybe Integer -> Bool) -> f (Maybe Integer) -> f Bool
forall a b. (a -> b) -> f a -> f b
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 :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
[TxHash] -> m (f Integer)
redisRemFromMempool [] = f Integer -> m (f Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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 :: forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheT m Integer
cacheDelXPubs [XPubSpec]
xpubs = (Maybe CacheConfig -> m Integer)
-> ReaderT (Maybe CacheConfig) m Integer
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Maybe CacheConfig -> m Integer)
 -> ReaderT (Maybe CacheConfig) m Integer)
-> (Maybe CacheConfig -> m Integer)
-> ReaderT (Maybe CacheConfig) 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0

delXPubKeys ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  [XPubSpec] ->
  CacheX m Integer
delXPubKeys :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheX m Integer
delXPubKeys [] = Integer -> ReaderT CacheConfig m Integer
forall a. a -> ReaderT CacheConfig m a
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
    Text
xtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
x
    $(logDebugS) Text
"Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ Text
"Deleting xpub: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
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 a b. (a -> b) -> Redis a -> Redis b
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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) -> ReaderT CacheConfig m Integer
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer)
-> Redis (Either Reply Integer) -> ReaderT CacheConfig m Integer
forall a b. (a -> b) -> a -> b
$ ([Integer] -> Integer)
-> Either Reply [Integer] -> Either Reply Integer
forall a b. (a -> b) -> Either Reply a -> Either Reply b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Integer] -> Integer
forall a. Num a => [a] -> a
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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 :: forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
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 ([Address] -> m (f Integer)) -> [Address] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.address) [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 a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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 :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs XPubSpec
_ [] = f Integer -> m (f Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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
t.block, TxHash -> ByteString
forall a. Serialize a => a -> ByteString
encode TxRef
t.txid)) [TxRef]
btxs

redisRemXPubTxs ::
  (Applicative f, RedisCtx m f) => XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs XPubSpec
_ [] = f Integer -> m (f Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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 :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents XPubSpec
_ [] =
  f Integer -> m (f Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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 :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [OutPoint] -> m (f Integer)
redisRemXPubUnspents XPubSpec
_ [] =
  f Integer -> m (f Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> f Integer
forall a. a -> f a
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 :: forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances XPubSpec
_ [] = f () -> m (f ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> f ()
forall a. a -> f a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
      XPubBal
b.balance.address
      AddressXPub
        { $sel:spec:AddressXPub :: XPubSpec
spec = XPubSpec
xpub,
          $sel:path:AddressXPub :: [BlockHeight]
path = XPubBal
b.path
        }
  return $ [f Integer] -> f ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f Integer]
xs f () -> f () -> f ()
forall a b. f a -> f b -> f b
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
b.path, Balance -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubBal
b.balance)) [XPubBal]
bals

redisSetHead :: (RedisCtx m f) => BlockHash -> m (f Redis.Status)
redisSetHead :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
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 :: forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
[Address] -> m (f [Maybe AddressXPub])
redisGetAddrsInfo [] = f [Maybe AddressXPub] -> m (f [Maybe AddressXPub])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe AddressXPub] -> f [Maybe AddressXPub]
forall a. a -> f a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a. Monad m => [m a] -> m [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 ::
  Ctx ->
  KeyIndex ->
  [XPubBal] ->
  AddressXPub ->
  [(Address, AddressXPub)]
addrsToAdd :: Ctx
-> BlockHeight
-> [XPubBal]
-> AddressXPub
-> [(Address, AddressXPub)]
addrsToAdd Ctx
ctx BlockHeight
gap [XPubBal]
xbals AddressXPub
addrinfo
  | [XPubBal] -> Bool
forall a. [a] -> 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 (Ctx -> [Address]
addrs Ctx
ctx) [[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 (Ctx -> [Address]
changeaddrs Ctx
ctx) [[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 (Ctx -> [Address]
addrs Ctx
ctx) [[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. HasCallStack => [a] -> a
head ([BlockHeight] -> BlockHeight)
-> (XPubBal -> [BlockHeight]) -> XPubBal -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.path)) [XPubBal]
xbals
    f :: a -> [BlockHeight] -> (a, AddressXPub)
f a
a [BlockHeight]
p = (a
a, AddressXPub {$sel:spec:AddressXPub :: XPubSpec
spec = XPubSpec
xpub, $sel:path:AddressXPub :: [BlockHeight]
path = [BlockHeight]
p})
    dchain :: BlockHeight
dchain = [BlockHeight] -> BlockHeight
forall a. HasCallStack => [a] -> a
head AddressXPub
addrinfo.path
    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. HasCallStack => [a] -> a
head ([BlockHeight] -> BlockHeight)
-> (XPubBal -> [BlockHeight]) -> XPubBal -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.path)) [XPubBal]
xbals
    maxidx :: BlockHeight
maxidx = [BlockHeight] -> BlockHeight
forall a. Ord a => [a] -> a
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. HasCallStack => [a] -> a
head ([BlockHeight] -> BlockHeight)
-> (XPubBal -> [BlockHeight]) -> XPubBal -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeight] -> [BlockHeight]
forall a. HasCallStack => [a] -> [a]
tail ([BlockHeight] -> [BlockHeight])
-> (XPubBal -> [BlockHeight]) -> XPubBal -> [BlockHeight]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.path)) [XPubBal]
fbals)
    xpub :: XPubSpec
xpub = AddressXPub
addrinfo.spec
    aidx :: BlockHeight
aidx = ([BlockHeight] -> BlockHeight
forall a. HasCallStack => [a] -> a
head ([BlockHeight] -> BlockHeight)
-> ([BlockHeight] -> [BlockHeight]) -> [BlockHeight] -> BlockHeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockHeight] -> [BlockHeight]
forall a. HasCallStack => [a] -> [a]
tail) AddressXPub
addrinfo.path
    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 :: Ctx -> [DerivPathI SoftDeriv] -> [XPubKey]
keys Ctx
ctx = (DerivPathI SoftDeriv -> XPubKey)
-> [DerivPathI SoftDeriv] -> [XPubKey]
forall a b. (a -> b) -> [a] -> [b]
map (\DerivPathI SoftDeriv
p -> Ctx -> DerivPathI SoftDeriv -> XPubKey -> XPubKey
derivePubPath Ctx
ctx DerivPathI SoftDeriv
p XPubSpec
xpub.key)
    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 :: Ctx -> XPubKey -> Address
xpubf Ctx
ctx = Ctx -> DeriveType -> XPubKey -> Address
xPubAddrFunction Ctx
ctx XPubSpec
xpub.deriv
    addrs :: Ctx -> [Address]
addrs Ctx
ctx = (XPubKey -> Address) -> [XPubKey] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> XPubKey -> Address
xpubf Ctx
ctx) (Ctx -> [DerivPathI SoftDeriv] -> [XPubKey]
keys Ctx
ctx [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 :: Ctx -> [Address]
changeaddrs Ctx
ctx = (XPubKey -> Address) -> [XPubKey] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> XPubKey -> Address
xpubf Ctx
ctx) (Ctx -> [DerivPathI SoftDeriv] -> [XPubKey]
keys Ctx
ctx [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
d.tx, 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 (.tx) [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 :: Ctx -> TxData -> [(Address, OutPoint)]
txInputs :: Ctx -> TxData -> [(Address, OutPoint)]
txInputs Ctx
ctx TxData
td =
  let is :: [TxIn]
is = TxData
td.tx.inputs
      ps :: [(Int, Prev)]
ps = IntMap Prev -> [(Int, Prev)]
forall a. IntMap a -> [(Int, a)]
I.toAscList TxData
td.prevs
      as :: [Either String Address]
as = ((Int, Prev) -> Either String Address)
-> [(Int, Prev)] -> [Either String Address]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx (ByteString -> Either String Address)
-> ((Int, Prev) -> ByteString)
-> (Int, Prev)
-> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script) (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 -> r -> Maybe (a, b)
f (Right a
a) r
i = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, r
i.outpoint)
      f (Left a
_) r
_ = Maybe (a, b)
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 {r} {b} {a} {a}.
HasField "outpoint" r b =>
Either a a -> r -> Maybe (a, b)
f [Either String Address]
as [TxIn]
is)

txOutputs :: Ctx -> TxData -> [(Address, OutPoint)]
txOutputs :: Ctx -> TxData -> [(Address, OutPoint)]
txOutputs Ctx
ctx 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
                { $sel:hash:OutPoint :: TxHash
hash = Tx -> TxHash
txHash TxData
td.tx,
                  $sel:index:OutPoint :: BlockHeight
index = BlockHeight
i
                }
          )
          [BlockHeight
0 ..]
          TxData
td.tx.outputs
      as :: [Either String Address]
as = (TxOut -> Either String Address)
-> [TxOut] -> [Either String Address]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx (ByteString -> Either String Address)
-> (TxOut -> ByteString) -> TxOut -> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script)) TxData
td.tx.outputs
      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 :: forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
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 :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
m (f [(Word64, 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) -> (Word64, TxHash))
-> [(TxHash, Double)] -> [(Word64, TxHash)]
forall a b. (a -> b) -> [a] -> [b]
map ((TxHash -> Double -> (Word64, TxHash))
-> (TxHash, Double) -> (Word64, TxHash)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxHash -> Double -> (Word64, TxHash)
forall {b}. b -> Double -> (Word64, b)
f) ([(TxHash, Double)] -> [(Word64, TxHash)])
-> f [(TxHash, Double)] -> f [(Word64, TxHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(TxHash, Double)]
xs
  where
    f :: b -> Double -> (Word64, b)
f b
t Double
s = ((Double -> BlockRef
scoreBlockRef Double
s).timestamp, b
t)

xpubText ::
  ( MonadUnliftIO m,
    MonadLoggerIO m,
    StoreReadBase m
  ) =>
  XPubSpec ->
  CacheX m Text
xpubText :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub = do
  Network
net <- m Network -> ReaderT CacheConfig m Network
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
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 :: Text
suffix = case XPubSpec
xpub.deriv of
        DeriveType
DeriveNormal -> Text
""
        DeriveType
DeriveP2SH -> Text
"/p2sh"
        DeriveType
DeriveP2WPKH -> Text
"/p2wpkh"
  Ctx
ctx <- m Ctx -> ReaderT CacheConfig m Ctx
forall (m :: * -> *) a. Monad m => m a -> ReaderT CacheConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
  Text -> CacheX m Text
forall a. a -> ReaderT CacheConfig m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> CacheX m Text) -> (Text -> Text) -> Text -> CacheX m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> CacheX m Text) -> Text -> CacheX m Text
forall a b. (a -> b) -> a -> b
$ Text
suffix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Network -> Ctx -> XPubKey -> Text
xPubExport Network
net Ctx
ctx XPubSpec
xpub.key

cacheNewBlock :: (MonadIO m) => CacheWriter -> m ()
cacheNewBlock :: forall (m :: * -> *). MonadIO m => 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 :: forall (m :: * -> *). MonadIO m => 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

cacheSyncMempool :: (MonadIO m) => CacheWriter -> m ()
cacheSyncMempool :: forall (m :: * -> *). MonadIO m => CacheWriter -> m ()
cacheSyncMempool = (Listen () -> CacheWriterMessage) -> CacheWriter -> m ()
forall (m :: * -> *) (mbox :: * -> *) response request.
(MonadIO m, OutChan mbox) =>
(Listen response -> request) -> mbox request -> m response
query Listen () -> CacheWriterMessage
CacheSyncMempool