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

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

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

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

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

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

newCacheMetrics :: MonadIO m => Metrics.Store -> m CacheMetrics
newCacheMetrics :: forall (m :: * -> *). MonadIO m => Store -> m CacheMetrics
newCacheMetrics Store
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
cacheLockAcquired <- Text -> IO Counter
c Text
"cache.lock_acquired"
  Counter
cacheLockReleased <- Text -> IO Counter
c Text
"cache.lock_released"
  Counter
cacheLockFailed <- Text -> IO Counter
c Text
"cache.lock_failed"
  StatDist
cacheIndexTime <- forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"cache.index"
  Counter
cacheXPubBals <- Text -> IO Counter
c Text
"cache.xpub_balances_cached"
  Counter
cacheXPubUnspents <- Text -> IO Counter
c Text
"cache.xpub_unspents_cached"
  Counter
cacheXPubTxs <- Text -> IO Counter
c Text
"cache.xpub_txs_cached"
  Counter
cacheXPubTxCount <- Text -> IO Counter
c Text
"cache.xpub_tx_count_cached"
  return CacheMetrics {Counter
StatDist
cacheXPubTxCount :: Counter
cacheXPubTxs :: Counter
cacheXPubUnspents :: Counter
cacheXPubBals :: Counter
cacheIndexTime :: StatDist
cacheLockFailed :: Counter
cacheLockReleased :: Counter
cacheLockAcquired :: Counter
cacheMisses :: Counter
cacheHits :: Counter
cacheIndexTime :: StatDist
cacheXPubTxCount :: Counter
cacheXPubTxs :: Counter
cacheXPubUnspents :: Counter
cacheXPubBals :: Counter
cacheLockFailed :: Counter
cacheLockReleased :: Counter
cacheLockAcquired :: Counter
cacheMisses :: Counter
cacheHits :: Counter
..}
  where
    c :: Text -> IO Counter
c Text
x = Text -> Store -> IO Counter
Metrics.createCounter Text
x Store
s
    d :: Text -> m StatDist
d Text
x = 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 =
  forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Maybe CacheMetrics
cacheMetrics forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe CacheMetrics
Nothing -> CacheX m a
go
    Just CacheMetrics
m ->
      forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (SystemTime -> UTCTime
systemToUTCTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime)
        (forall {m :: * -> *}. MonadIO m => CacheMetrics -> UTCTime -> m ()
end CacheMetrics
m)
        (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
      let diff :: Int64
diff = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t2 UTCTime
t1 forall a. Num a => a -> a -> a
* NominalDiffTime
1000
      CacheMetrics -> StatDist
df CacheMetrics
metrics forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
`addStatTime` Int64
diff
      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 =
  forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Maybe CacheMetrics
cacheMetrics forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just CacheMetrics
s -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Counter -> Int64 -> IO ()
Metrics.Counter.add (CacheMetrics -> Counter
f CacheMetrics
s) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
    Maybe CacheMetrics
Nothing -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheError] -> ShowS
$cshowList :: [CacheError] -> ShowS
show :: CacheError -> String
$cshow :: CacheError -> String
showsPrec :: Int -> CacheError -> ShowS
$cshowsPrec :: Int -> CacheError -> ShowS
Show, CacheError -> CacheError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheError -> CacheError -> Bool
$c/= :: CacheError -> CacheError -> Bool
== :: CacheError -> CacheError -> Bool
$c== :: CacheError -> CacheError -> Bool
Eq, forall x. Rep CacheError x -> CacheError
forall x. CacheError -> Rep CacheError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CacheError x -> CacheError
$cfrom :: forall x. CacheError -> Rep CacheError x
Generic, CacheError -> ()
forall a. (a -> ()) -> NFData a
rnf :: CacheError -> ()
$crnf :: CacheError -> ()
NFData, Show CacheError
Typeable CacheError
SomeException -> Maybe CacheError
CacheError -> String
CacheError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: CacheError -> String
$cdisplayException :: CacheError -> String
fromException :: SomeException -> Maybe CacheError
$cfromException :: SomeException -> Maybe CacheError
toException :: CacheError -> SomeException
$ctoException :: CacheError -> SomeException
Exception)

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

instance
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  StoreReadBase (CacheT m)
  where
  getNetwork :: CacheT m Network
getNetwork = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  getBestBlock :: CacheT m (Maybe BlockHash)
getBestBlock = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
  getBlocksAtHeight :: KeyIndex -> CacheT m [BlockHash]
getBlocksAtHeight = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). StoreReadBase m => KeyIndex -> m [BlockHash]
getBlocksAtHeight
  getBlock :: BlockHash -> CacheT m (Maybe BlockData)
getBlock = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
  getTxData :: TxHash -> CacheT m (Maybe TxData)
getTxData = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData
  getSpender :: OutPoint -> CacheT m (Maybe Spender)
getSpender = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender
  getBalance :: Address -> CacheT m (Maybe Balance)
getBalance = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance
  getUnspent :: OutPoint -> CacheT m (Maybe Unspent)
getUnspent = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent
  getMempool :: CacheT m [(Word64, TxHash)]
getMempool = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances
  getAddressesTxs :: [Address] -> Limits -> CacheT m [TxRef]
getAddressesTxs [Address]
addrs = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs
  getAddressTxs :: Address -> Limits -> CacheT m [TxRef]
getAddressTxs Address
addr = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr
  getAddressUnspents :: Address -> Limits -> CacheT m [Unspent]
getAddressUnspents Address
addr = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
addr
  getAddressesUnspents :: [Address] -> Limits -> CacheT m [Unspent]
getAddressesUnspents [Address]
addrs = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
addrs
  getMaxGap :: CacheT m KeyIndex
getMaxGap = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadExtra m => m KeyIndex
getMaxGap
  getInitialGap :: CacheT m KeyIndex
getInitialGap = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadExtra m => m KeyIndex
getInitialGap
  getNumTxData :: Word64 -> CacheT m [TxData]
getNumTxData = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). StoreReadExtra m => Word64 -> m [TxData]
getNumTxData
  xPubBals :: XPubSpec -> CacheT m [XPubBal]
xPubBals XPubSpec
xpub =
    forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      Just CacheConfig
cfg ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 =
    forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits
      Just CacheConfig
cfg ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 =
    forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits
      Just CacheConfig
cfg ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 KeyIndex
xPubTxCount XPubSpec
xpub [XPubBal]
xbals =
    forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe CacheConfig
Nothing ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m KeyIndex
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
      Just CacheConfig
cfg ->
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m KeyIndex
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 = 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 = 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 =
      forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
          [TxRef]
txs <- forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs XPubSpec
xpub Limits
limits
          forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubTxs (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
          return [TxRef]
txs
        Bool
False ->
          if Bool
m
            then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals Limits
limits
            else do
              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 KeyIndex
getXPubTxCount XPubSpec
xpub [XPubBal]
xbals =
  forall {m :: * -> *}.
(MonadLoggerIO m, MonadUnliftIO m, StoreReadExtra m) =>
Bool -> ReaderT CacheConfig m KeyIndex
go Bool
False
  where
    go :: Bool -> ReaderT CacheConfig m KeyIndex
go Bool
t =
      forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
          forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubTxCount Int
1
          forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m KeyIndex
cacheGetXPubTxCount XPubSpec
xpub
        Bool
False ->
          if Bool
t
            then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m KeyIndex
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
            else do
              forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals
              Bool -> ReaderT CacheConfig m KeyIndex
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 :: XPubBal -> (Address, XPubBal)
f XPubBal
x = (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
x), XPubBal
x)
          g :: XPubBal -> Bool
g = (forall a. Ord a => a -> a -> Bool
> Word64
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Word64
balanceUnspentCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal
       in forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, XPubBal)
f forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
g [XPubBal]
xbals
    go :: Bool -> ReaderT CacheConfig m [XPubUnspent]
go Bool
m =
      forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> do
          ReaderT CacheConfig m [XPubUnspent]
process
        Bool
False ->
          if Bool
m
            then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals Limits
limits
            else do
              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 <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents XPubSpec
xpub Limits
limits
      [Unspent]
uns <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent [OutPoint]
ops)
      let f :: Unspent -> Maybe (Address, Unspent)
f Unspent
u =
            forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
              (\Address
a -> forall a. a -> Maybe a
Just (Address
a, Unspent
u))
              (ByteString -> Either String Address
scriptToAddressBS (Unspent -> ByteString
unspentScript Unspent
u))
          g :: Address -> Maybe XPubBal
g Address
a = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Address
a HashMap Address XPubBal
xm
          h :: Unspent -> XPubBal -> XPubUnspent
h Unspent
u XPubBal
x =
            XPubUnspent
              { xPubUnspent :: Unspent
xPubUnspent = Unspent
u,
                xPubUnspentPath :: [KeyIndex]
xPubUnspentPath = XPubBal -> [KeyIndex]
xPubBalPath XPubBal
x
              }
          us :: [(Address, Unspent)]
us = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Unspent -> Maybe (Address, Unspent)
f [Unspent]
uns
          i :: Address -> Unspent -> Maybe XPubUnspent
i Address
a Unspent
u = Unspent -> XPubBal -> XPubUnspent
h Unspent
u forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> Maybe XPubBal
g Address
a
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubUnspents (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Address, Unspent)]
us)
      return $ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 =
  forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      [XPubBal]
xbals <- forall (m :: * -> *).
MonadLoggerIO m =>
XPubSpec -> CacheX m [XPubBal]
cacheGetXPubBalances XPubSpec
xpub
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheXPubBals (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
      return [XPubBal]
xbals
    Bool
False -> do
      [XPubBal]
bals <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      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 =
  forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe CacheConfig
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just CacheConfig
cfg -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 = do
  Bool
cached <- forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
XPubSpec -> m (f Bool)
redisIsXPubCached XPubSpec
xpub)
  if Bool
cached
    then forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheHits Int
1
    else forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheMisses Int
1
  return Bool
cached

redisIsXPubCached :: RedisCtx m f => XPubSpec -> m (f Bool)
redisIsXPubCached :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
XPubSpec -> m (f Bool)
redisIsXPubCached XPubSpec
xpub = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Bool)
Redis.exists (ByteString
balancesPfx forall a. Semigroup a => a -> a -> a
<> 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 <- forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub
  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 KeyIndex
cacheGetXPubTxCount XPubSpec
xpub = do
  KeyIndex
count <- forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
XPubSpec -> m (f Integer)
redisGetXPubTxCount XPubSpec
xpub)
  forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
  return KeyIndex
count

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

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

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

scoreBlockRef :: Double -> BlockRef
scoreBlockRef :: Double -> BlockRef
scoreBlockRef Double
s
  | Double
s forall a. Ord a => a -> a -> Bool
< Double
0 = MemRef {memRefTime :: Word64
memRefTime = Word64
n}
  | Bool
otherwise = BlockRef {blockRefHeight :: KeyIndex
blockRefHeight = KeyIndex
h, blockRefPos :: KeyIndex
blockRefPos = KeyIndex
p}
  where
    n :: Word64
n = forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Num a => a -> a
abs Double
s) :: Word64
    m :: Word64
m = Word64
0x001fffffffffffff forall a. Num a => a -> a -> a
- Word64
n
    h :: KeyIndex
h = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
m forall a. Bits a => a -> Int -> a
`shift` (-Int
26))
    p :: KeyIndex
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
m 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 -> KeyIndex -> KeyIndex -> m (f [(a, Double)])
getFromSortedSet ByteString
key Maybe Double
Nothing KeyIndex
off KeyIndex
0 = do
  f [(ByteString, Double)]
xs <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores ByteString
key (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
off) (-Integer
1)
  return $ do
    [Either String (a, Double)]
ys <- forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return (forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)
getFromSortedSet ByteString
key Maybe Double
Nothing KeyIndex
off KeyIndex
count = do
  f [(ByteString, Double)]
xs <-
    forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores
      ByteString
key
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
off)
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
off forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
count forall a. Num a => a -> a -> a
- Integer
1)
  return $ do
    [Either String (a, Double)]
ys <- forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return (forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)
getFromSortedSet ByteString
key (Just Double
score) KeyIndex
off KeyIndex
0 = do
  f [(ByteString, Double)]
xs <-
    forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit
      ByteString
key
      Double
score
      (Double
1 forall a. Fractional a => a -> a -> a
/ Double
0)
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
off)
      (-Integer
1)
  return $ do
    [Either String (a, Double)]
ys <- forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return (forall a b. [Either a b] -> [b]
rights [Either String (a, Double)]
ys)
getFromSortedSet ByteString
key (Just Double
score) KeyIndex
off KeyIndex
count = do
  f [(ByteString, Double)]
xs <-
    forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit
      ByteString
key
      Double
score
      (Double
1 forall a. Fractional a => a -> a -> a
/ Double
0)
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
off)
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyIndex
count)
  return $ do
    [Either String (a, Double)]
ys <- forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
x, Double
s) -> (,Double
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => ByteString -> Either String a
decode ByteString
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(ByteString, Double)]
xs
    return (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 <- 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 = forall a. Serialize a => ByteString -> Either String a
decode ByteString
k',
          let Right v
v = forall a. Serialize a => ByteString -> Either String a
decode ByteString
v'
      ]

data CacheWriterMessage
  = CacheNewBlock
  | CacheNewTx TxHash

type CacheWriterInbox = Inbox CacheWriterMessage

type CacheWriter = Mailbox CacheWriterMessage

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

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

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

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

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

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

cacheWriter ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheConfig ->
  CacheWriterInbox ->
  m ()
cacheWriter :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheConfig -> CacheWriterInbox -> m ()
cacheWriter CacheConfig
cfg CacheWriterInbox
inbox =
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall {a}. ReaderT CacheConfig m a
go CacheConfig
cfg
  where
    go :: ReaderT CacheConfig m a
go = do
      forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
      forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC
      forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
        CacheWriterMessage
x <- forall (mbox :: * -> *) (m :: * -> *) msg.
(InChan mbox, MonadIO m) =>
mbox msg -> m msg
receive CacheWriterInbox
inbox
        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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right Status
Redis.Ok -> do
      $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
        Text
"Acquired lock"
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockAcquired Int
1
      return Bool
True
    Right Status
Redis.Pong -> do
      $(logErrorS)
        Text
"Cache"
        Text
"Unexpected pong when acquiring lock"
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      return Bool
False
    Right (Redis.Status ByteString
s) -> do
      $(logErrorS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
        Text
"Unexpected status acquiring lock: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs ByteString
s
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      return Bool
False
    Left (Redis.Bulk Maybe ByteString
Nothing) -> do
      $(logDebugS) Text
"Cache" Text
"Lock already taken"
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      return Bool
False
    Left Reply
e -> do
      $(logErrorS)
        Text
"Cache"
        Text
"Error when trying to acquire lock"
      forall (m :: * -> *).
MonadIO m =>
(CacheMetrics -> Counter) -> Int -> CacheX m ()
incrementCounter CacheMetrics -> Counter
cacheLockFailed Int
1
      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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Connection
cacheConn
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Connection -> Redis a -> IO a
Redis.runRedis Connection
conn forall a b. (a -> b) -> a -> b
$ do
        let opts :: SetOpts
opts =
              Redis.SetOpts
                { setSeconds :: Maybe Integer
Redis.setSeconds = forall a. a -> Maybe a
Just Integer
300,
                  setMilliseconds :: Maybe Integer
Redis.setMilliseconds = forall a. Maybe a
Nothing,
                  setCondition :: Maybe Condition
Redis.setCondition = forall a. a -> Maybe a
Just Condition
Redis.Nx
                }
        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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$ do
  let opts :: SetOpts
opts =
        Redis.SetOpts
          { setSeconds :: Maybe Integer
Redis.setSeconds = forall a. a -> Maybe a
Just Integer
300,
            setMilliseconds :: Maybe Integer
Redis.setMilliseconds = forall a. Maybe a
Nothing,
            setCondition :: Maybe Condition
Redis.setCondition = forall a. a -> Maybe a
Just Condition
Redis.Xx
          }
  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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
unlockIt Bool
True = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (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 =
  forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket forall (m :: * -> *). MonadLoggerIO m => CacheX m Bool
lockIt forall (m :: * -> *). MonadLoggerIO m => Bool -> CacheX m ()
unlockIt forall a b. (a -> b) -> a -> b
$ \case
    Bool
True -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheX m a
f
    Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Integer
cacheMax
  Integer
s <- forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Integer)
Redis.dbsize
  return $ Integer
s 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (((forall a. Integral a => a -> a -> a
`div` Integer
10) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* Integer
8)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheConfig -> Integer
cacheMax) -- Prune to 80% of max
  Integer
s <- forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Integer)
Redis.dbsize
  if Integer
s forall a. Ord a => a -> a -> Bool
> Integer
x then forall {a} {m :: * -> *}.
(Integral a, MonadLoggerIO m, MonadUnliftIO m, StoreReadBase m) =>
a -> ReaderT CacheConfig m Integer
flush (Integer
s forall a. Num a => a -> a -> a
- Integer
x) else forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
  where
    flush :: a -> ReaderT CacheConfig m Integer
flush a
n =
      case a
n forall a. Integral a => a -> a -> a
`div` a
64 of
        a
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
        a
x -> do
          [XPubSpec]
ks <-
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$
              forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double -> KeyIndex -> KeyIndex -> m (f [(a, Double)])
getFromSortedSet ByteString
maxKey forall a. Maybe a
Nothing KeyIndex
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
          $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
            Text
"Pruning " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubSpec]
ks)) forall a. Semigroup a => a -> a -> a
<> Text
" old xpubs"
          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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
  forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$ 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
redisTouchKeys a
now [XPubSpec]
xpubs =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
Redis.zadd ByteString
maxKey (forall a b. (a -> b) -> [a] -> [b]
map ((forall a b. (Real a, Fractional b) => a -> b
realToFrac a
now,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
doSync
cacheWriterReact (CacheNewTx TxHash
txid) =
  forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
doSync

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

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

newXPubC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  XPubSpec ->
  [XPubBal] ->
  CacheX m ()
newXPubC :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> [XPubBal] -> CacheX m ()
newXPubC XPubSpec
xpub [XPubBal]
xbals =
  ReaderT CacheConfig m Bool
should_index forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
i -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
i forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ReaderT CacheConfig m Bool
set_index forall (m :: * -> *). MonadLoggerIO m => Bool -> CacheX m ()
unset_index forall a b. (a -> b) -> a -> b
$ \Bool
j -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
j forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a.
MonadUnliftIO m =>
(CacheMetrics -> StatDist) -> CacheX m a -> CacheX m a
withMetrics CacheMetrics -> StatDist
cacheIndexTime forall a b. (a -> b) -> a -> b
$ do
        Text
xpubtxt <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
        $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
          Text
"Caching "
            forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            forall a. Semigroup a => a -> a -> a
<> Text
": "
            forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals))
            forall a. Semigroup a => a -> a -> a
<> Text
" addresses / "
            forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show ([XPubBal] -> Int
lenNotNull [XPubBal]
xbals))
            forall a. Semigroup a => a -> a -> a
<> Text
" used"
        [XPubUnspent]
utxo <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals forall a. Default a => a
def
        $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
          Text
"Caching "
            forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            forall a. Semigroup a => a -> a -> a
<> Text
": "
            forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
utxo))
            forall a. Semigroup a => a -> a -> a
<> Text
" utxos"
        [TxRef]
xtxs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals forall a. Default a => a
def
        $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
          Text
"Caching "
            forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            forall a. Semigroup a => a -> a -> a
<> Text
": "
            forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
xtxs))
            forall a. Semigroup a => a -> a -> a
<> Text
" txs"
        Int64
now <- SystemTime -> Int64
systemSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
        forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$ do
          Either Reply ()
b <- forall (f :: * -> *) (m :: * -> *) a.
(Monad f, RedisCtx m f, Real a) =>
a -> [XPubSpec] -> m (f ())
redisTouchKeys Int64
now [XPubSpec
xpub]
          Either Reply ()
c <- forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances XPubSpec
xpub [XPubBal]
xbals
          Either Reply Integer
d <- forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents XPubSpec
xpub (forall a b. (a -> b) -> [a] -> [b]
map XPubUnspent -> (OutPoint, BlockRef)
op [XPubUnspent]
utxo)
          Either Reply Integer
e <- forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs XPubSpec
xpub [TxRef]
xtxs
          return $ Either Reply ()
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$ Text
"Cached " forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
  where
    op :: XPubUnspent -> (OutPoint, BlockRef)
op XPubUnspent {xPubUnspent :: XPubUnspent -> Unspent
xPubUnspent = Unspent
u} = (Unspent -> OutPoint
unspentPoint Unspent
u, Unspent -> BlockRef
unspentBlock Unspent
u)
    should_index :: ReaderT CacheConfig m Bool
should_index =
      forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Int
cacheMin forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
x ->
        if Int
x forall a. Ord a => a -> a -> Bool
<= [XPubBal] -> Int
lenNotNull [XPubBal]
xbals
          then
            forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s ->
              if Bool
s
                then Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Bool
isFull
                else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    key :: ByteString
key = ByteString
idxPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub
    opts :: SetOpts
opts =
      Redis.SetOpts
        { setSeconds :: Maybe Integer
Redis.setSeconds = forall a. a -> Maybe a
Just Integer
600,
          setMilliseconds :: Maybe Integer
Redis.setMilliseconds = forall a. Maybe a
Nothing,
          setCondition :: Maybe Condition
Redis.setCondition = forall a. a -> Maybe a
Just Condition
Redis.Nx
        }
    red :: Redis (Either Reply Status)
red = 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
key]
    set_index :: ReaderT CacheConfig m Bool
set_index =
      forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Connection
cacheConn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Connection
conn ->
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Connection -> Redis a -> IO a
Redis.runRedis Connection
conn Redis (Either Reply Status)
red) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> 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 =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockHash
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just BlockHash
bb -> do
      Chain
ch <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain
      BlockNode
cb <- forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
      return $ BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
cb) 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 =
  forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
s ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock forall a b. (a -> b) -> a -> b
$ do
      Chain
ch <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain
      BlockNode
bn <- forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
      Maybe BlockHash
cn <- forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead
      case Maybe BlockHash
cn of
        Maybe BlockHash
Nothing -> do
          $(logInfoS) Text
"Cache" Text
"Initializing best cache block"
          forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockNode -> ReaderT CacheConfig m ()
do_import BlockNode
bn
        Just BlockHash
hb ->
          if BlockHash
hb forall a. Eq a => a -> a -> Bool
== BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
bn)
            then $(logDebugS) Text
"Cache" Text
"Cache in sync"
            else do
              forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
Chain -> BlockHash -> BlockNode -> ReaderT CacheConfig m ()
sync Chain
ch BlockHash
hb BlockNode
bn
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Integer
pruneDB
  where
    sync :: Chain -> BlockHash -> BlockNode -> ReaderT CacheConfig m ()
sync Chain
ch BlockHash
hb BlockNode
bn =
      forall (m :: * -> *).
MonadIO m =>
BlockHash -> Chain -> m (Maybe BlockNode)
chainGetBlock BlockHash
hb Chain
ch forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockNode
Nothing -> do
          $(logErrorS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
            Text
"Cache head block node not found: "
              forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
hb
        Just BlockNode
hn ->
          forall (m :: * -> *). MonadIO m => BlockHash -> Chain -> m Bool
chainBlockMain BlockHash
hb Chain
ch forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
m ->
            if Bool
m
              then forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
Chain -> BlockNode -> BlockNode -> ReaderT CacheConfig m ()
next Chain
ch BlockNode
bn BlockNode
hn
              else do
                $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
                  Text
"Reverting cache head not in main chain: "
                    forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
hb
                forall (m :: * -> *).
(StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
removeHeadC BlockHash
hb
                forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Maybe BlockHash
Nothing -> forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockNode -> ReaderT CacheConfig m ()
do_import BlockNode
bn
                  Just BlockHash
hb' -> Chain -> BlockHash -> BlockNode -> ReaderT CacheConfig m ()
sync Chain
ch BlockHash
hb' BlockNode
bn
    next :: Chain -> BlockNode -> BlockNode -> ReaderT CacheConfig m ()
next Chain
ch BlockNode
bn BlockNode
hn =
      if
          | BlockHeader -> BlockHash
prevBlock (BlockNode -> BlockHeader
nodeHeader BlockNode
bn) forall a. Eq a => a -> a -> Bool
== BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
hn) ->
              forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockNode -> ReaderT CacheConfig m ()
do_import BlockNode
bn
          | BlockNode -> KeyIndex
nodeHeight BlockNode
bn forall a. Ord a => a -> a -> Bool
> BlockNode -> KeyIndex
nodeHeight BlockNode
hn ->
              forall (m :: * -> *).
MonadIO m =>
KeyIndex -> BlockNode -> Chain -> m (Maybe BlockNode)
chainGetAncestor (BlockNode -> KeyIndex
nodeHeight BlockNode
hn forall a. Num a => a -> a -> a
+ KeyIndex
1) BlockNode
bn Chain
ch forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe BlockNode
Nothing -> do
                  $(logErrorS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
                    Text
"Ancestor not found at height "
                      forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show (BlockNode -> KeyIndex
nodeHeight BlockNode
hn forall a. Num a => a -> a -> a
+ KeyIndex
1))
                      forall a. Semigroup a => a -> a -> a
<> Text
" for block: "
                      forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
bn))
                  forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$
                    String -> CacheError
LogicError forall a b. (a -> b) -> a -> b
$
                      String
"Ancestor not found at height "
                        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (BlockNode -> KeyIndex
nodeHeight BlockNode
hn forall a. Num a => a -> a -> a
+ KeyIndex
1)
                        forall a. Semigroup a => a -> a -> a
<> String
" for block: "
                        forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
bn)))
                Just BlockNode
hn' -> do
                  forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockNode -> ReaderT CacheConfig m ()
do_import BlockNode
hn'
                  Chain -> BlockNode -> BlockNode -> ReaderT CacheConfig m ()
next Chain
ch BlockNode
bn BlockNode
hn'
          | Bool
otherwise ->
              $(logInfoS) Text
"Cache" Text
"Cache best block higher than this node's"
    do_import :: BlockNode -> ReaderT CacheConfig m ()
do_import BlockNode
bn = do
      forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
importBlockC forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> BlockHash
headerHash forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
bn
      forall (m :: * -> *). MonadLoggerIO m => CacheX m ()
refreshLock

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

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

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

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

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

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

syncMempoolC ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
  CacheX m ()
syncMempoolC :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock forall a b. (a -> b) -> a -> b
$ do
  HashSet TxHash
nodepool <- forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
  HashSet TxHash
cachepool <- forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadLoggerIO m =>
CacheX m [(Word64, TxHash)]
cacheGetMempool
  forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
HashSet TxHash -> ReaderT CacheConfig m ()
getem (forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
nodepool HashSet TxHash
cachepool)
  forall (m :: * -> *). MonadLoggerIO m => CacheX m ()
refreshLock
  forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
HashSet TxHash -> ReaderT CacheConfig m ()
getem (forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
cachepool HashSet TxHash
nodepool)
  forall (m :: * -> *). MonadLoggerIO m => CacheX m ()
refreshLock
  where
    getem :: HashSet TxHash -> ReaderT CacheConfig m ()
getem HashSet TxHash
tset = do
      let tids :: [TxHash]
tids = forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
tset
      [TxData]
txs <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData) [TxHash]
tids
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxData]
txs) forall a b. (a -> b) -> a -> b
$ do
        $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$
          Text
"Importing mempool transactions: " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
txs))
        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 = forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis 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 = forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis 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" forall a b. (a -> b) -> a -> b
$ Text
"Cache head set to: " forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bh
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (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 = forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisAddToMempool [TxRef]
btxs =
  forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd ByteString
mempoolSetKey forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map
      (\TxRef
btx -> (BlockRef -> Double
blockRefScore (TxRef -> BlockRef
txRefBlock TxRef
btx), forall a. Serialize a => a -> ByteString
encode (TxRef -> TxHash
txRefHash TxRef
btx)))
      [TxRef]
btxs

redisIsInMempool :: (Applicative f, RedisCtx m f) => TxHash -> m (f Bool)
redisIsInMempool :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
TxHash -> m (f Bool)
redisIsInMempool TxHash
txid =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Redis.zrank ByteString
mempoolSetKey (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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisRemFromMempool [TxHash]
xs = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
zrem ByteString
mempoolSetKey forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set (ByteString
addrPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode Address
a) (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 = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \case
  Just CacheConfig
cache -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheX m Integer
delXPubKeys [XPubSpec]
xpubs) CacheConfig
cache
  Maybe CacheConfig
Nothing -> 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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
delXPubKeys [XPubSpec]
xpubs = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [XPubSpec]
xpubs forall a b. (a -> b) -> a -> b
$ \XPubSpec
x -> do
    Text
xtxt <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
x
    $(logDebugS) Text
"Cache" forall a b. (a -> b) -> a -> b
$ Text
"Deleting xpub: " forall a. Semigroup a => a -> a -> a
<> Text
xtxt
  [(XPubSpec, [XPubBal])]
xbals <-
    forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [XPubSpec]
xpubs forall a b. (a -> b) -> a -> b
$ \XPubSpec
xpub -> do
      Either Reply [XPubBal]
bs <- forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
XPubSpec -> m (f [XPubBal])
redisGetXPubBalances XPubSpec
xpub
      return $ (XPubSpec
xpub,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Reply [XPubBal]
bs
  forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(XPubSpec, [XPubBal])]
xbals (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry 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 = forall {f :: * -> *} {f :: * -> *} {a}.
(Applicative f, RedisCtx f f, Serialize a) =>
[a] -> f (f Integer)
go (forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Address
balanceAddress forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
bals)
  where
    go :: [a] -> f (f Integer)
go [a]
addrs = do
      f Integer
addrcount <-
        case [a]
addrs of
          [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
          [a]
_ -> forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del (forall a b. (a -> b) -> [a] -> [b]
map ((ByteString
addrPfx forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => a -> ByteString
encode) [a]
addrs)
      f Integer
txsetcount <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
txSetPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      f Integer
utxocount <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
utxoPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      f Integer
balcount <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Redis.del [ByteString
balancesPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub]
      f Integer
x <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Redis.zrem ByteString
maxKey [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' forall a. Num a => a -> a -> a
+ Integer
txset' forall a. Num a => a -> a -> a
+ Integer
utxo' 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisAddXPubTxs XPubSpec
xpub [TxRef]
btxs =
  forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd (ByteString
txSetPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (\TxRef
t -> (BlockRef -> Double
blockRefScore (TxRef -> BlockRef
txRefBlock TxRef
t), forall a. Serialize a => a -> ByteString
encode (TxRef -> TxHash
txRefHash TxRef
t))) [TxRef]
btxs

redisRemXPubTxs ::
  (Applicative f, RedisCtx m f) => XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs :: forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxHash] -> m (f Integer)
redisRemXPubTxs XPubSpec
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisRemXPubTxs XPubSpec
xpub [TxHash]
txhs = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
zrem (ByteString
txSetPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) (forall a b. (a -> b) -> [a] -> [b]
map 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
_ [] =
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisAddXPubUnspents XPubSpec
xpub [(OutPoint, BlockRef)]
utxo =
  forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd (ByteString
utxoPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (\(OutPoint
p, BlockRef
r) -> (BlockRef -> Double
blockRefScore BlockRef
r, 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
_ [] =
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
redisRemXPubUnspents XPubSpec
xpub [OutPoint]
ops =
  forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
zrem (ByteString
utxoPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub) (forall a b. (a -> b) -> [a] -> [b]
map 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
redisAddXPubBalances XPubSpec
xpub [XPubBal]
bals = do
  [f Integer]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
Redis.hset (ByteString
balancesPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub))) [(ByteString, ByteString)]
entries
  [f ()]
ys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [XPubBal]
bals forall a b. (a -> b) -> a -> b
$ \XPubBal
b ->
    forall (f :: * -> *) (m :: * -> *).
(Functor f, RedisCtx m f) =>
Address -> AddressXPub -> m (f ())
redisSetAddrInfo
      (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
b))
      AddressXPub
        { addressXPubSpec :: XPubSpec
addressXPubSpec = XPubSpec
xpub,
          addressXPubPath :: [KeyIndex]
addressXPubPath = XPubBal -> [KeyIndex]
xPubBalPath XPubBal
b
        }
  return $ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f Integer]
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [f ()]
ys
  where
    entries :: [(ByteString, ByteString)]
entries = forall a b. (a -> b) -> [a] -> [b]
map (\XPubBal
b -> (forall a. Serialize a => a -> ByteString
encode (XPubBal -> [KeyIndex]
xPubBalPath XPubBal
b), forall a. Serialize a => a -> ByteString
encode (XPubBal -> Balance
xPubBal XPubBal
b))) [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 = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set ByteString
bestBlockKey (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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
redisGetAddrsInfo [Address]
as = do
  [f (Maybe ByteString)]
is <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Address
a -> forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get (ByteString
addrPfx forall a. Semigroup a => a -> a -> a
<> forall a. Serialize a => a -> ByteString
encode Address
a)) [Address]
as
  return $ do
    [Maybe ByteString]
is' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [f (Maybe ByteString)]
is
    return $ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
decode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) [Maybe ByteString]
is'

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

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

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

txOutputs :: TxData -> [(Address, OutPoint)]
txOutputs :: TxData -> [(Address, OutPoint)]
txOutputs TxData
td =
  let ps :: [OutPoint]
ps =
        forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
          ( \KeyIndex
i TxOut
_ ->
              OutPoint
                { outPointHash :: TxHash
outPointHash = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
td),
                  outPointIndex :: KeyIndex
outPointIndex = KeyIndex
i
                }
          )
          [KeyIndex
0 ..]
          (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
td))
      as :: [Either String Address]
as = forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Either String Address
scriptToAddressBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput) (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
td))
      f :: Either a a -> b -> Maybe (a, b)
f (Right a
a) b
p = forall a. a -> Maybe a
Just (a
a, b
p)
      f (Left a
_) b
_ = forall a. Maybe a
Nothing
   in forall a. [Maybe a] -> [a]
catMaybes (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 <- forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get ByteString
bestBlockKey
  return $ (forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
decode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) 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 <- forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double -> KeyIndex -> KeyIndex -> m (f [(a, Double)])
getFromSortedSet ByteString
mempoolSetKey forall a. Maybe a
Nothing KeyIndex
0 KeyIndex
0
  return $ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {b}. b -> Double -> (Word64, b)
f) 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 = (BlockRef -> Word64
memRefTime (Double -> BlockRef
scoreBlockRef Double
s), 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  let suffix :: Text
suffix = case XPubSpec -> DeriveType
xPubDeriveType XPubSpec
xpub of
        DeriveType
DeriveNormal -> Text
""
        DeriveType
DeriveP2SH -> Text
"/p2sh"
        DeriveType
DeriveP2WPKH -> Text
"/p2wpkh"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ Text
suffix forall a. Semigroup a => a -> a -> a
<> Network -> XPubKey -> Text
xPubExport Network
net (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub)

cacheNewBlock :: MonadIO m => CacheWriter -> m ()
cacheNewBlock :: forall (m :: * -> *). MonadIO m => CacheWriter -> m ()
cacheNewBlock = 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 = forall (m :: * -> *) (mbox :: * -> *) msg.
(MonadIO m, OutChan mbox) =>
msg -> mbox msg -> m ()
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> CacheWriterMessage
CacheNewTx