{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}
module Haskoin.Store.Cache
    ( CacheConfig(..)
    , CacheT
    , CacheError(..)
    , withCache
    , connectRedis
    , blockRefScore
    , scoreBlockRef
    , CacheWriter
    , CacheWriterInbox
    , cacheNewBlock
    , cachePing
    , cacheWriter
    , isInCache
    , evictFromCache
    ) where

import           Control.DeepSeq           (NFData)
import           Control.Monad             (forM, forM_, forever, unless, void,
                                            when)
import           Control.Monad.Logger      (MonadLoggerIO, logDebugS, logErrorS,
                                            logWarnS)
import           Control.Monad.Reader      (ReaderT (..), ask, asks)
import           Control.Monad.Trans       (lift)
import           Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import           Data.Bits                 (shift, (.&.), (.|.))
import           Data.ByteString           (ByteString)
import qualified Data.ByteString.Short     as BSS
import           Data.Default              (def)
import           Data.Either               (rights)
import           Data.HashMap.Strict       (HashMap)
import qualified Data.HashMap.Strict       as HashMap
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, mapMaybe)
import           Data.Serialize            (Serialize, decode, encode)
import           Data.String.Conversions   (cs)
import           Data.Text                 (Text)
import           Data.Time.Clock.System    (getSystemTime, systemSeconds)
import           Data.Word                 (Word32, Word64)
import           Database.Redis            (Connection, Redis, RedisCtx, Reply,
                                            checkedConnect, defaultConnectInfo,
                                            hgetall, parseConnectInfo, zadd,
                                            zrangeWithscores,
                                            zrangebyscoreWithscoresLimit, zrem)
import qualified Database.Redis            as Redis
import           GHC.Generics              (Generic)
import           Haskoin                   (Address, BlockHash,
                                            BlockHeader (..), BlockNode (..),
                                            DerivPathI (..), KeyIndex,
                                            OutPoint (..), Tx (..), TxHash,
                                            TxIn (..), TxOut (..), XPubKey,
                                            blockHashToHex, derivePubPath,
                                            eitherToMaybe, headerHash,
                                            pathToList, scriptToAddressBS,
                                            txHash, xPubAddr,
                                            xPubCompatWitnessAddr, xPubExport,
                                            xPubWitnessAddr)
import           Haskoin.Node              (Chain, chainBlockMain,
                                            chainGetAncestor, chainGetBest,
                                            chainGetBlock)
import           Haskoin.Store.Common
import           Haskoin.Store.Data
import           NQE                       (Inbox, Mailbox, receive, send)
import           System.Random             (randomIO)
import           UnliftIO                  (Exception, MonadIO, MonadUnliftIO,
                                            bracket, liftIO, throwIO)

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

data CacheConfig = CacheConfig
    { CacheConfig -> Connection
cacheConn    :: !Connection
    , CacheConfig -> Int
cacheMin     :: !Int
    , CacheConfig -> Integer
cacheMax     :: !Integer
    , CacheConfig -> Chain
cacheChain   :: !Chain
    , CacheConfig -> Int
cacheRefresh :: !Int
    }

type CacheT = ReaderT (Maybe CacheConfig)
type CacheX = ReaderT CacheConfig

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

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

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

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

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

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

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

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

getXPubTxs ::
       (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
    => XPubSpec -> Limits -> CacheX m [TxRef]
getXPubTxs :: XPubSpec -> Limits -> CacheX m [TxRef]
getXPubTxs xpub :: XPubSpec
xpub limits :: Limits
limits = do
    Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Getting xpub txs for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
    XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool -> (Bool -> CacheX m [TxRef]) -> CacheX m [TxRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        True -> do
            [TxRef]
txs <- XPubSpec -> Limits -> CacheX m [TxRef]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs XPubSpec
xpub Limits
limits
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                "Returning " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                " transactions for cached xpub: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
xpubtxt
            return [TxRef]
txs
        False -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Caching new xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            XPubSpec -> CacheX m (Bool, [XPubBal])
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m (Bool, [XPubBal])
newXPubC XPubSpec
xpub CacheX m (Bool, [XPubBal])
-> ((Bool, [XPubBal]) -> CacheX m [TxRef]) -> CacheX m [TxRef]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(t :: Bool
t, bals :: [XPubBal]
bals) ->
                if Bool
t
                    then do
                        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                            "Successfully cached xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
                        XPubSpec -> Limits -> CacheX m [TxRef]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs XPubSpec
xpub Limits
limits
                    else do
                        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                            "Using DB to return txs for xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
                        m [TxRef] -> CacheX m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> CacheX m [TxRef]) -> m [TxRef] -> CacheX m [TxRef]
forall a b. (a -> b) -> a -> b
$ [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[XPubBal] -> Limits -> m [TxRef]
xPubBalsTxs [XPubBal]
bals Limits
limits

getXPubUnspents ::
       (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
    => XPubSpec -> Limits -> CacheX m [XPubUnspent]
getXPubUnspents :: XPubSpec -> Limits -> CacheX m [XPubUnspent]
getXPubUnspents xpub :: XPubSpec
xpub limits :: Limits
limits = do
    Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Getting utxo for xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
    XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool
-> (Bool -> CacheX m [XPubUnspent]) -> CacheX m [XPubUnspent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        True -> do
            [XPubBal]
bals <- XPubSpec -> CacheX m [XPubBal]
forall (m :: * -> *).
MonadLoggerIO m =>
XPubSpec -> CacheX m [XPubBal]
cacheGetXPubBalances XPubSpec
xpub
            [XPubBal] -> CacheX m [XPubUnspent]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m, MonadUnliftIO m) =>
[XPubBal] -> ReaderT CacheConfig m [XPubUnspent]
process [XPubBal]
bals
        False ->
            XPubSpec -> CacheX m (Bool, [XPubBal])
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m (Bool, [XPubBal])
newXPubC XPubSpec
xpub CacheX m (Bool, [XPubBal])
-> ((Bool, [XPubBal]) -> CacheX m [XPubUnspent])
-> CacheX m [XPubUnspent]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(t :: Bool
t, bals :: [XPubBal]
bals) ->
                if Bool
t
                    then do
                        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                            "Successfully cached xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
                        [XPubBal] -> CacheX m [XPubUnspent]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m, MonadUnliftIO m) =>
[XPubBal] -> ReaderT CacheConfig m [XPubUnspent]
process [XPubBal]
bals
                    else do
                        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                            "Using DB to return utxo for xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
                        m [XPubUnspent] -> CacheX m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubUnspent] -> CacheX m [XPubUnspent])
-> m [XPubUnspent] -> CacheX m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ [XPubBal] -> Limits -> m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
[XPubBal] -> Limits -> m [XPubUnspent]
xPubBalsUnspents [XPubBal]
bals Limits
limits
  where
    process :: [XPubBal] -> ReaderT CacheConfig m [XPubUnspent]
process bals :: [XPubBal]
bals = do
        [OutPoint]
ops <- ((BlockRef, OutPoint) -> OutPoint)
-> [(BlockRef, OutPoint)] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map (BlockRef, OutPoint) -> OutPoint
forall a b. (a, b) -> b
snd ([(BlockRef, OutPoint)] -> [OutPoint])
-> ReaderT CacheConfig m [(BlockRef, OutPoint)]
-> ReaderT CacheConfig m [OutPoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> Limits -> ReaderT CacheConfig m [(BlockRef, OutPoint)]
forall (m :: * -> *).
(StoreReadBase m, MonadLoggerIO m) =>
XPubSpec -> Limits -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents XPubSpec
xpub Limits
limits
        [Unspent]
uns <- [Maybe Unspent] -> [Unspent]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Unspent] -> [Unspent])
-> ReaderT CacheConfig m [Maybe Unspent]
-> ReaderT CacheConfig m [Unspent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Maybe Unspent] -> ReaderT CacheConfig m [Maybe Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((OutPoint -> m (Maybe Unspent)) -> [OutPoint] -> m [Maybe Unspent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent [OutPoint]
ops)
        let addrmap :: Map Address [BlockHeight]
addrmap =
                [(Address, [BlockHeight])] -> Map Address [BlockHeight]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Address, [BlockHeight])] -> Map Address [BlockHeight])
-> [(Address, [BlockHeight])] -> Map Address [BlockHeight]
forall a b. (a -> b) -> a -> b
$
                (XPubBal -> (Address, [BlockHeight]))
-> [XPubBal] -> [(Address, [BlockHeight])]
forall a b. (a -> b) -> [a] -> [b]
map (\b :: XPubBal
b -> (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
b), XPubBal -> [BlockHeight]
xPubBalPath XPubBal
b)) [XPubBal]
bals
            addrutxo :: [(Address, Unspent)]
addrutxo =
                (Unspent -> Maybe (Address, Unspent))
-> [Unspent] -> [(Address, Unspent)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                    (\u :: Unspent
u ->
                         (String -> Maybe (Address, Unspent))
-> (Address -> Maybe (Address, Unspent))
-> Either String Address
-> Maybe (Address, Unspent)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                             (Maybe (Address, Unspent) -> String -> Maybe (Address, Unspent)
forall a b. a -> b -> a
const Maybe (Address, Unspent)
forall a. Maybe a
Nothing)
                             (\a :: Address
a -> (Address, Unspent) -> Maybe (Address, Unspent)
forall a. a -> Maybe a
Just (Address
a, Unspent
u))
                             (ByteString -> Either String Address
scriptToAddressBS
                                  (ShortByteString -> ByteString
BSS.fromShort (Unspent -> ShortByteString
unspentScript Unspent
u))))
                    [Unspent]
uns
            xpubutxo :: [XPubUnspent]
xpubutxo =
                ((Address, Unspent) -> Maybe XPubUnspent)
-> [(Address, Unspent)] -> [XPubUnspent]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                    (\(a :: Address
a, u :: Unspent
u) -> ([BlockHeight] -> Unspent -> XPubUnspent
`XPubUnspent` Unspent
u) ([BlockHeight] -> XPubUnspent)
-> Maybe [BlockHeight] -> Maybe XPubUnspent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> Map Address [BlockHeight] -> Maybe [BlockHeight]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Address
a Map Address [BlockHeight]
addrmap)
                    [(Address, Unspent)]
addrutxo
        Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "Returning " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubUnspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
xpubutxo)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            " utxos for cached xpub: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
xpubtxt
        return [XPubUnspent]
xpubutxo

getXPubBalances ::
       (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
    => XPubSpec -> CacheX m [XPubBal]
getXPubBalances :: XPubSpec -> CacheX m [XPubBal]
getXPubBalances xpub :: XPubSpec
xpub = do
    Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Getting balances for xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
    XPubSpec -> CacheX m Bool
forall (m :: * -> *). MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached XPubSpec
xpub CacheX m Bool -> (Bool -> CacheX m [XPubBal]) -> CacheX m [XPubBal]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        True -> do
            [XPubBal]
bals <- XPubSpec -> CacheX m [XPubBal]
forall (m :: * -> *).
MonadLoggerIO m =>
XPubSpec -> CacheX m [XPubBal]
cacheGetXPubBalances XPubSpec
xpub
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                "Returning " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
bals)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " balances for xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
xpubtxt
            return [XPubBal]
bals
        False -> do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Caching balances for xpub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
            (Bool, [XPubBal]) -> [XPubBal]
forall a b. (a, b) -> b
snd ((Bool, [XPubBal]) -> [XPubBal])
-> ReaderT CacheConfig m (Bool, [XPubBal]) -> CacheX m [XPubBal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> ReaderT CacheConfig m (Bool, [XPubBal])
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
XPubSpec -> CacheX m (Bool, [XPubBal])
newXPubC XPubSpec
xpub

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

isXPubCached :: MonadLoggerIO m => XPubSpec -> CacheX m Bool
isXPubCached :: XPubSpec -> CacheX m Bool
isXPubCached = Redis (Either Reply Bool) -> CacheX m Bool
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply Bool) -> CacheX m Bool)
-> (XPubSpec -> Redis (Either Reply Bool))
-> XPubSpec
-> CacheX m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
XPubSpec -> m (f Bool)
redisIsXPubCached

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

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

cacheGetXPubTxs ::
       (StoreReadBase m, MonadLoggerIO m)
    => XPubSpec
    -> Limits
    -> CacheX m [TxRef]
cacheGetXPubTxs :: XPubSpec -> Limits -> CacheX m [TxRef]
cacheGetXPubTxs xpub :: XPubSpec
xpub limits :: Limits
limits = do
    Maybe Double
score <-
        case Limits -> Maybe Start
start Limits
limits of
            Nothing -> Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
            Just (AtTx th :: TxHash
th) ->
                m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th) ReaderT CacheConfig m (Maybe TxData)
-> (Maybe TxData -> ReaderT CacheConfig m (Maybe Double))
-> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just TxData {txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef {}} ->
                        Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore BlockRef
b))
                    _ -> Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
            Just (AtBlock h :: BlockHeight
h) ->
                Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore (BlockHeight -> BlockHeight -> BlockRef
BlockRef BlockHeight
h BlockHeight
forall a. Bounded a => a
maxBound)))
    [(TxHash, Double)]
xs <-
        Redis (Either Reply [(TxHash, Double)])
-> CacheX m [(TxHash, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(TxHash, Double)])
 -> CacheX m [(TxHash, Double)])
-> Redis (Either Reply [(TxHash, Double)])
-> CacheX m [(TxHash, Double)]
forall a b. (a -> b) -> a -> b
$
        ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(TxHash, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet
            (ByteString
txSetPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
            Maybe Double
score
            (Limits -> BlockHeight
offset Limits
limits)
            (Limits -> BlockHeight
limit Limits
limits)
    [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
    return $ ((TxHash, Double) -> TxRef) -> [(TxHash, Double)] -> [TxRef]
forall a b. (a -> b) -> [a] -> [b]
map ((TxHash -> Double -> TxRef) -> (TxHash, Double) -> TxRef
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxHash -> Double -> TxRef
f) [(TxHash, Double)]
xs
  where
    f :: TxHash -> Double -> TxRef
f t :: TxHash
t s :: Double
s = $WTxRef :: BlockRef -> TxHash -> TxRef
TxRef {txRefHash :: TxHash
txRefHash = TxHash
t, txRefBlock :: BlockRef
txRefBlock = Double -> BlockRef
scoreBlockRef Double
s}

cacheGetXPubUnspents ::
       (StoreReadBase m, MonadLoggerIO m)
    => XPubSpec
    -> Limits
    -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents :: XPubSpec -> Limits -> CacheX m [(BlockRef, OutPoint)]
cacheGetXPubUnspents xpub :: XPubSpec
xpub limits :: Limits
limits = do
    Maybe Double
score <-
        case Limits -> Maybe Start
start Limits
limits of
            Nothing -> Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
            Just (AtTx th :: TxHash
th) ->
                m (Maybe TxData) -> ReaderT CacheConfig m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th) ReaderT CacheConfig m (Maybe TxData)
-> (Maybe TxData -> ReaderT CacheConfig m (Maybe Double))
-> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just TxData {txDataBlock :: TxData -> BlockRef
txDataBlock = b :: BlockRef
b@BlockRef {}} ->
                        Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore BlockRef
b))
                    _ -> Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
            Just (AtBlock h :: BlockHeight
h) ->
                Maybe Double -> ReaderT CacheConfig m (Maybe Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Maybe Double
forall a. a -> Maybe a
Just (BlockRef -> Double
blockRefScore (BlockHeight -> BlockHeight -> BlockRef
BlockRef BlockHeight
h BlockHeight
forall a. Bounded a => a
maxBound)))
    [(OutPoint, Double)]
xs <-
        Redis (Either Reply [(OutPoint, Double)])
-> CacheX m [(OutPoint, Double)]
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply [(OutPoint, Double)])
 -> CacheX m [(OutPoint, Double)])
-> Redis (Either Reply [(OutPoint, Double)])
-> CacheX m [(OutPoint, Double)]
forall a b. (a -> b) -> a -> b
$
        ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> Redis (Either Reply [(OutPoint, Double)])
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, RedisCtx m f, Serialize a) =>
ByteString
-> Maybe Double
-> BlockHeight
-> BlockHeight
-> m (f [(a, Double)])
getFromSortedSet
            (ByteString
utxoPfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPubSpec -> ByteString
forall a. Serialize a => a -> ByteString
encode XPubSpec
xpub)
            Maybe Double
score
            (Limits -> BlockHeight
offset Limits
limits)
            (Limits -> BlockHeight
limit Limits
limits)
    [XPubSpec] -> CacheX m ()
forall (m :: * -> *). MonadLoggerIO m => [XPubSpec] -> CacheX m ()
touchKeys [XPubSpec
xpub]
    return $ ((OutPoint, Double) -> (BlockRef, OutPoint))
-> [(OutPoint, Double)] -> [(BlockRef, OutPoint)]
forall a b. (a -> b) -> [a] -> [b]
map ((OutPoint -> Double -> (BlockRef, OutPoint))
-> (OutPoint, Double) -> (BlockRef, OutPoint)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OutPoint -> Double -> (BlockRef, OutPoint)
forall b. b -> Double -> (BlockRef, b)
f) [(OutPoint, Double)]
xs
  where
    f :: b -> Double -> (BlockRef, b)
f o :: b
o s :: Double
s = (Double -> BlockRef
scoreBlockRef Double
s, b
o)

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

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

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

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

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

data CacheWriterMessage
    = CacheNewBlock
    | CachePing

type CacheWriterInbox = Inbox CacheWriterMessage
type CacheWriter = Mailbox CacheWriterMessage

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

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

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

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

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

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

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

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


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

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

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

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

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

cacheWriterReact ::
       (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
    => CacheWriterMessage -> CacheX m ()
cacheWriterReact :: CacheWriterMessage -> CacheX m ()
cacheWriterReact CacheNewBlock =
    CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: Bool
s ->
    Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
    CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
    CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC
cacheWriterReact CachePing =
    CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: Bool
s ->
    Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
s (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
    CacheX m Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
CacheX m Integer
pruneDB
    CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
newBlockC
    CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m ()
syncMempoolC

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

newXPubC ::
       (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
    => XPubSpec -> CacheX m (Bool, [XPubBal])
newXPubC :: XPubSpec -> CacheX m (Bool, [XPubBal])
newXPubC xpub :: XPubSpec
xpub = do
    [XPubBal]
bals <- m [XPubBal] -> ReaderT CacheConfig m [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubBal] -> ReaderT CacheConfig m [XPubBal])
-> m [XPubBal] -> ReaderT CacheConfig m [XPubBal]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
    Int
x <- (CacheConfig -> Int) -> ReaderT CacheConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Int
cacheMin
    Text
t <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
    let n :: Int
n = [XPubBal] -> Int
lenNotNull [XPubBal]
bals
    if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
        then CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
CacheX m Bool
inSync CacheX m Bool
-> (Bool -> CacheX m (Bool, [XPubBal]))
-> CacheX m (Bool, [XPubBal])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s :: Bool
s -> if Bool
s then [XPubBal] -> CacheX m (Bool, [XPubBal])
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>
[XPubBal] -> ReaderT CacheConfig m (Bool, [XPubBal])
go [XPubBal]
bals else (Bool, [XPubBal]) -> CacheX m (Bool, [XPubBal])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [XPubBal]
bals)
        else do
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Not caching xpub: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
            return (Bool
False, [XPubBal]
bals)
  where
    op :: XPubUnspent -> (OutPoint, BlockRef)
op XPubUnspent {xPubUnspent :: XPubUnspent -> Unspent
xPubUnspent = Unspent
u} = (Unspent -> OutPoint
unspentPoint Unspent
u, Unspent -> BlockRef
unspentBlock Unspent
u)
    go :: [XPubBal] -> ReaderT CacheConfig m (Bool, [XPubBal])
go bals :: [XPubBal]
bals = do
        Text
xpubtxt <- XPubSpec -> CacheX m Text
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
XPubSpec -> CacheX m Text
xpubText XPubSpec
xpub
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "Caching xpub with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
bals)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            " addresses (used: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubBal] -> Int
lenNotNull [XPubBal]
bals)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            "): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
xpubtxt
        [XPubUnspent]
utxo <- m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent])
-> m [XPubUnspent] -> ReaderT CacheConfig m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> Limits -> m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub Limits
forall a. Default a => a
def
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "Caching xpub with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([XPubUnspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
utxo)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " utxos: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
xpubtxt
        [TxRef]
xtxs <- m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [TxRef] -> ReaderT CacheConfig m [TxRef])
-> m [TxRef] -> ReaderT CacheConfig m [TxRef]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub Limits
forall a. Default a => a
def
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "Caching xpub with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
xtxs)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " txs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
xpubtxt
        Int64
now <- SystemTime -> Int64
systemSeconds (SystemTime -> Int64)
-> ReaderT CacheConfig m SystemTime -> ReaderT CacheConfig m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> ReaderT CacheConfig m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "Running Redis pipeline to cache xpub: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ""
        Redis (Either Reply ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (Redis (Either Reply ()) -> ReaderT CacheConfig m ())
-> Redis (Either Reply ()) -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ do
            Either Reply ()
b <- Int64 -> [XPubSpec] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *) a.
(Monad f, RedisCtx m f, Real a) =>
a -> [XPubSpec] -> m (f ())
redisTouchKeys Int64
now [XPubSpec
xpub]
            Either Reply ()
c <- XPubSpec -> [XPubBal] -> Redis (Either Reply ())
forall (f :: * -> *) (m :: * -> *).
(Monad f, RedisCtx m f) =>
XPubSpec -> [XPubBal] -> m (f ())
redisAddXPubBalances XPubSpec
xpub [XPubBal]
bals
            Either Reply Integer
d <- XPubSpec -> [(OutPoint, BlockRef)] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer)
redisAddXPubUnspents XPubSpec
xpub ((XPubUnspent -> (OutPoint, BlockRef))
-> [XPubUnspent] -> [(OutPoint, BlockRef)]
forall a b. (a -> b) -> [a] -> [b]
map XPubUnspent -> (OutPoint, BlockRef)
op [XPubUnspent]
utxo)
            Either Reply Integer
e <- XPubSpec -> [TxRef] -> Redis (Either Reply Integer)
forall (f :: * -> *) (m :: * -> *).
(Applicative f, RedisCtx m f) =>
XPubSpec -> [TxRef] -> m (f Integer)
redisAddXPubTxs XPubSpec
xpub [TxRef]
xtxs
            return $ Either Reply ()
b Either Reply () -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply ()
c Either Reply () -> Either Reply Integer -> Either Reply Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
d Either Reply Integer
-> Either Reply Integer -> Either Reply Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either Reply Integer
e Either Reply Integer -> Either Reply () -> Either Reply ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Either Reply ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$ "Done caching xpub: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xpubtxt
        return (Bool
True, [XPubBal]
bals)

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

newBlockC :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
          => CacheX m ()
newBlockC :: CacheX m ()
newBlockC =
    m (Maybe BlockHash) -> ReaderT CacheConfig m (Maybe BlockHash)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ReaderT CacheConfig m (Maybe BlockHash)
-> (Maybe BlockHash -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \m :: Maybe BlockHash
m ->
    Maybe BlockHash -> (BlockHash -> CacheX m ()) -> CacheX m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BlockHash
m ((BlockHash -> CacheX m ()) -> CacheX m ())
-> (BlockHash -> CacheX m ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ \bb :: BlockHash
bb -> ReaderT CacheConfig m (Maybe ()) -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m (Maybe ()) -> CacheX m ())
-> ReaderT CacheConfig m (Maybe ()) -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ CacheX m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (CacheX m () -> ReaderT CacheConfig m (Maybe ()))
-> CacheX m () -> ReaderT CacheConfig m (Maybe ())
forall a b. (a -> b) -> a -> b
$ BlockHash -> CacheX m ()
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m, StoreReadExtra m) =>
BlockHash -> ReaderT CacheConfig m ()
f BlockHash
bb
  where
    f :: BlockHash -> ReaderT CacheConfig m ()
f bb :: BlockHash
bb = CacheX m (Maybe BlockHash)
forall (m :: * -> *). MonadLoggerIO m => CacheX m (Maybe BlockHash)
cacheGetHead CacheX m (Maybe BlockHash)
-> (Maybe BlockHash -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BlockHash -> Maybe BlockHash -> ReaderT CacheConfig m ()
go BlockHash
bb
    go :: BlockHash -> Maybe BlockHash -> ReaderT CacheConfig m ()
go bb :: BlockHash
bb Nothing =
        BlockHash -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
importBlockC BlockHash
bb
    go bb :: BlockHash
bb (Just cb :: BlockHash
cb)
        | BlockHash
cb BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bb =
              $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" "Cache in sync"
        | Bool
otherwise =
              BlockHash -> BlockHash -> ReaderT CacheConfig m ()
sync BlockHash
bb BlockHash
cb
    sync :: BlockHash -> BlockHash -> ReaderT CacheConfig m ()
sync bb :: BlockHash
bb cb :: BlockHash
cb =
        (CacheConfig -> Chain) -> ReaderT CacheConfig m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain ReaderT CacheConfig m Chain
-> (Chain -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ch :: Chain
ch ->
        BlockHash -> Chain -> ReaderT CacheConfig m Bool
forall (m :: * -> *). MonadIO m => BlockHash -> Chain -> m Bool
chainBlockMain BlockHash
bb Chain
ch ReaderT CacheConfig m Bool
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        False ->
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "New head not in main chain: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bb
        True ->
            BlockHash -> Chain -> ReaderT CacheConfig m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
BlockHash -> Chain -> m (Maybe BlockNode)
chainGetBlock BlockHash
cb Chain
ch ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Nothing ->
                $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                "Cache head block node not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                BlockHash -> Text
blockHashToHex BlockHash
cb
            Just cn :: BlockNode
cn ->
                BlockHash -> Chain -> ReaderT CacheConfig m Bool
forall (m :: * -> *). MonadIO m => BlockHash -> Chain -> m Bool
chainBlockMain BlockHash
cb Chain
ch ReaderT CacheConfig m Bool
-> (Bool -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                False -> do
                    $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                        "Reverting cache head not in main chain: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                        BlockHash -> Text
blockHashToHex BlockHash
cb
                    ReaderT CacheConfig m ()
forall (m :: * -> *).
(StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) =>
CacheX m ()
removeHeadC ReaderT CacheConfig m ()
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockHash -> ReaderT CacheConfig m ()
f BlockHash
bb
                True ->
                    BlockHash -> Chain -> ReaderT CacheConfig m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
BlockHash -> Chain -> m (Maybe BlockNode)
chainGetBlock BlockHash
bb Chain
ch ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Just nn :: BlockNode
nn -> BlockHash -> BlockNode -> BlockNode -> ReaderT CacheConfig m ()
next BlockHash
bb BlockNode
nn BlockNode
cn
                    Nothing -> do
                        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                            "Cache head node not found: "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bb
                        CacheError -> ReaderT CacheConfig m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CacheError -> ReaderT CacheConfig m ())
-> CacheError -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
                            String -> CacheError
LogicError (String -> CacheError) -> String -> CacheError
forall a b. (a -> b) -> a -> b
$
                            "Cache head node not found: "
                            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHash -> Text
blockHashToHex BlockHash
bb)
    next :: BlockHash -> BlockNode -> BlockNode -> ReaderT CacheConfig m ()
next bb :: BlockHash
bb nn :: BlockNode
nn cn :: BlockNode
cn =
        (CacheConfig -> Chain) -> ReaderT CacheConfig m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain ReaderT CacheConfig m Chain
-> (Chain -> ReaderT CacheConfig m ()) -> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ch :: Chain
ch ->
        BlockHeight
-> BlockNode -> Chain -> ReaderT CacheConfig m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
BlockHeight -> BlockNode -> Chain -> m (Maybe BlockNode)
chainGetAncestor (BlockNode -> BlockHeight
nodeHeight BlockNode
cn BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ 1) BlockNode
nn Chain
ch ReaderT CacheConfig m (Maybe BlockNode)
-> (Maybe BlockNode -> ReaderT CacheConfig m ())
-> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing ->
            $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> ReaderT CacheConfig m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logWarnS) "Cache" (Text -> ReaderT CacheConfig m ())
-> Text -> ReaderT CacheConfig m ()
forall a b. (a -> b) -> a -> b
$
            "Ancestor not found at height "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (BlockHeight -> String
forall a. Show a => a -> String
show (BlockNode -> BlockHeight
nodeHeight BlockNode
cn BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
+ 1))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " for block: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
nn))
        Just cn' :: BlockNode
cn' ->
            BlockHash -> ReaderT CacheConfig m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
BlockHash -> CacheX m ()
importBlockC (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
cn')) ReaderT CacheConfig m ()
-> ReaderT CacheConfig m () -> ReaderT CacheConfig m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockHash -> ReaderT CacheConfig m ()
f BlockHash
bb

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

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

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

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

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

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


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

cacheCoolKey :: ByteString
cacheCoolKey :: ByteString
cacheCoolKey = "cooldown"

isCool :: (MonadUnliftIO m, MonadLoggerIO m) => CacheX m Bool
isCool :: CacheX m Bool
isCool =
    Redis (Either Reply (Maybe ByteString))
-> CacheX m (Maybe ByteString)
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Redis.get ByteString
cacheCoolKey) CacheX m (Maybe ByteString)
-> (Maybe ByteString -> CacheX m Bool) -> CacheX m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nothing -> Bool -> CacheX m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just bs :: ByteString
bs -> do
        let t :: Integer
t = String -> Integer
forall a. Read a => String -> a
read (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
bs)
        Integer
cooldown <- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Int -> Int) -> Int -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* 500) (Int -> Integer)
-> ReaderT CacheConfig m Int -> ReaderT CacheConfig m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CacheConfig -> Int) -> ReaderT CacheConfig m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Int
cacheRefresh
        Integer
now <- ReaderT CacheConfig m Integer
forall (m :: * -> *). MonadIO m => m Integer
microseconds
        return (Integer
cooldown Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
now Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
t)

startCooldown :: (MonadUnliftIO m, MonadLoggerIO m) => CacheX m ()
startCooldown :: CacheX m ()
startCooldown = do
    Integer
now <- ReaderT CacheConfig m Integer
forall (m :: * -> *). MonadIO m => m Integer
microseconds
    ReaderT CacheConfig m Status -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m Status -> CacheX m ())
-> ReaderT CacheConfig m Status -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ Redis (Either Reply Status) -> ReaderT CacheConfig m Status
forall (m :: * -> *) a.
MonadLoggerIO m =>
Redis (Either Reply a) -> CacheX m a
runRedis (ByteString -> ByteString -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Redis.set ByteString
cacheCoolKey (String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Integer -> String
forall a. Show a => a -> String
show Integer
now)))

syncMempoolC :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
             => CacheX m ()
syncMempoolC :: CacheX m ()
syncMempoolC =
    ReaderT CacheConfig m (Maybe ()) -> CacheX m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig m (Maybe ()) -> CacheX m ())
-> (CacheX m () -> ReaderT CacheConfig m (Maybe ()))
-> CacheX m ()
-> CacheX m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheX m () -> ReaderT CacheConfig m (Maybe ())
forall (m :: * -> *) a.
(MonadLoggerIO m, MonadUnliftIO m) =>
CacheX m a -> CacheX m (Maybe a)
withLock (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$
    CacheX m Bool
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
CacheX m Bool
isCool CacheX m Bool -> (Bool -> CacheX m ()) -> CacheX m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cool :: Bool
cool ->
    Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cool (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
    HashSet TxHash
nodepool <- [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> ([(UnixTime, TxHash)] -> [TxHash])
-> [(UnixTime, TxHash)]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnixTime, TxHash) -> TxHash) -> [(UnixTime, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (UnixTime, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(UnixTime, TxHash)] -> HashSet TxHash)
-> ReaderT CacheConfig m [(UnixTime, TxHash)]
-> ReaderT CacheConfig m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [(UnixTime, TxHash)]
-> ReaderT CacheConfig m [(UnixTime, TxHash)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m [(UnixTime, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)]
getMempool
    HashSet TxHash
cachepool <- [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> ([(UnixTime, TxHash)] -> [TxHash])
-> [(UnixTime, TxHash)]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnixTime, TxHash) -> TxHash) -> [(UnixTime, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (UnixTime, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(UnixTime, TxHash)] -> HashSet TxHash)
-> ReaderT CacheConfig m [(UnixTime, TxHash)]
-> ReaderT CacheConfig m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT CacheConfig m [(UnixTime, TxHash)]
forall (m :: * -> *).
MonadLoggerIO m =>
CacheX m [(UnixTime, TxHash)]
cacheGetMempool
    [Either TxHash TxData]
txs <- (TxHash -> ReaderT CacheConfig m (Either TxHash TxData))
-> [TxHash] -> ReaderT CacheConfig m [Either TxHash TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ReaderT CacheConfig m (Either TxHash TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, Monad (t m), StoreReadBase m) =>
TxHash -> t m (Either TxHash TxData)
getit ([TxHash] -> ReaderT CacheConfig m [Either TxHash TxData])
-> (HashSet TxHash -> [TxHash])
-> HashSet TxHash
-> ReaderT CacheConfig m [Either TxHash TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList (HashSet TxHash -> ReaderT CacheConfig m [Either TxHash TxData])
-> HashSet TxHash -> ReaderT CacheConfig m [Either TxHash TxData]
forall a b. (a -> b) -> a -> b
$
           HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. Monoid a => a -> a -> a
mappend
                (HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
nodepool HashSet TxHash
cachepool)
                (HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
cachepool HashSet TxHash
nodepool)
    Bool -> CacheX m () -> CacheX m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Either TxHash TxData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Either TxHash TxData]
txs) (CacheX m () -> CacheX m ()) -> CacheX m () -> CacheX m ()
forall a b. (a -> b) -> a -> b
$ do
        $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> CacheX m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "Cache" "Importing mempool transactions"
        [TxData] -> CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m) =>
[TxData] -> CacheX m ()
importMultiTxC ([Either TxHash TxData] -> [TxData]
forall a b. [Either a b] -> [b]
rights [Either TxHash TxData]
txs)
    CacheX m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
CacheX m ()
startCooldown
  where
    in_sync :: BlockHash -> m Bool
in_sync bb :: BlockHash
bb =
        (CacheConfig -> Chain) -> m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheConfig -> Chain
cacheChain m Chain -> (Chain -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ch :: Chain
ch ->
        Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch m BlockNode -> (BlockNode -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \cb :: BlockNode
cb ->
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
cb) BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bb
    getit :: TxHash -> t m (Either TxHash TxData)
getit th :: TxHash
th =
        m (Maybe TxData) -> t m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th) t m (Maybe TxData)
-> (Maybe TxData -> t m (Either TxHash TxData))
-> t m (Either TxHash TxData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> Either TxHash TxData -> t m (Either TxHash TxData)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxHash -> Either TxHash TxData
forall a b. a -> Either a b
Left TxHash
th)
        Just tx :: TxData
tx -> Either TxHash TxData -> t m (Either TxHash TxData)
forall (m :: * -> *) a. Monad m => a -> m a
return (TxData -> Either TxHash TxData
forall a b. b -> Either a b
Right TxData
tx)

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

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

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

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

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

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

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

evictFromCache ::
       (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m)
    => [XPubSpec]
    -> CacheT m ()
evictFromCache :: [XPubSpec] -> CacheT m ()
evictFromCache xpubs :: [XPubSpec]
xpubs = ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Maybe CacheConfig) m (Maybe CacheConfig)
-> (Maybe CacheConfig -> CacheT m ()) -> CacheT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nothing -> () -> CacheT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just cfg :: CacheConfig
cfg -> ReaderT (Maybe CacheConfig) m Integer -> CacheT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT CacheConfig (ReaderT (Maybe CacheConfig) m) Integer
-> CacheConfig -> ReaderT (Maybe CacheConfig) m Integer
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([XPubSpec]
-> ReaderT CacheConfig (ReaderT (Maybe CacheConfig) m) Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheX m Integer
delXPubKeys [XPubSpec]
xpubs) CacheConfig
cfg)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

xpubText :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m)
         => XPubSpec -> CacheX m Text
xpubText :: XPubSpec -> CacheX m Text
xpubText xpub :: XPubSpec
xpub = do
    Network
net <- m Network -> ReaderT CacheConfig m Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
    Text -> CacheX m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> CacheX m Text) -> (Text -> Text) -> Text -> CacheX m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> CacheX m Text) -> Text -> CacheX m Text
forall a b. (a -> b) -> a -> b
$ Network -> XPubKey -> Text
xPubExport Network
net (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub)

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

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