{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- 'Store' implementations that can store various wallet types
-- in an SQLite database using `persistent`.
--
-- FIXME LATER during ADP-1043:
--
-- * Inline the contents of this module into its new name
--   "Cardano.Wallet.DB.Sqlite.Stores"

module Cardano.Wallet.DB.Store.Checkpoints
    ( mkStoreWallets
    , PersistAddressBook (..)
    , blockHeaderFromEntity

    -- * Testing
    , mkStoreWallet
    )
    where

import Prelude

import Cardano.Address.Derivation
    ( XPub )
import Cardano.Address.Script
    ( Cosigner (..), ScriptTemplate (..) )
import Cardano.DB.Sqlite
    ( dbChunked )
import Cardano.Wallet.Address.Book
    ( AddressBookIso (..)
    , Discoveries (..)
    , Prologue (..)
    , SeqAddressMap (..)
    , SharedAddressMap (..)
    )
import Cardano.Wallet.Checkpoints
    ( DeltaCheckpoints (..), DeltasCheckpoints, loadCheckpoints )
import Cardano.Wallet.DB
    ( ErrBadFormat (..) )
import Cardano.Wallet.DB.Sqlite.Schema
    ( Checkpoint (..)
    , CosignerKey (..)
    , EntityField (..)
    , Key (..)
    , RndState (..)
    , RndStateAddress (..)
    , RndStatePendingAddress (..)
    , SeqState (..)
    , SeqStateAddress (..)
    , SeqStatePendingIx (..)
    , SharedState (..)
    , SharedStatePendingIx (..)
    , UTxO (..)
    , UTxOToken (..)
    , Wallet (..)
    )
import Cardano.Wallet.DB.Sqlite.Types
    ( BlockId (..)
    , HDPassphrase (..)
    , TxId (..)
    , fromMaybeHash
    , hashOfNoParent
    , toMaybeHash
    )
import Cardano.Wallet.DB.WalletState
    ( DeltaMap (..)
    , DeltaWalletState
    , DeltaWalletState1 (..)
    , WalletCheckpoint (..)
    , WalletState (..)
    , getSlot
    )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , MkKeyFingerprint (..)
    , PaymentAddress (..)
    , PersistPublicKey (..)
    , Role (..)
    , SoftDerivation (..)
    , WalletKey (..)
    , roleVal
    )
import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
    ( SharedKey (..) )
import Cardano.Wallet.Primitive.AddressDiscovery
    ( PendingIxs, pendingIxsFromList, pendingIxsToList )
import Cardano.Wallet.Primitive.AddressDiscovery.Shared
    ( CredentialType (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId (..) )
import Control.Monad
    ( forM, forM_, unless, void, when )
import Control.Monad.Trans.Class
    ( lift )
import Control.Monad.Trans.Except
    ( ExceptT (..), runExceptT )
import Control.Monad.Trans.Maybe
    ( MaybeT (..) )
import Data.Bifunctor
    ( bimap, second )
import Data.DBVar
    ( Store (..) )
import Data.Functor
    ( (<&>) )
import Data.Generics.Internal.VL.Lens
    ( view, (^.) )
import Data.Kind
    ( Type )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( fromJust, isJust, isNothing )
import Data.Proxy
    ( Proxy (..) )
import Data.Quantity
    ( Quantity (..) )
import Data.Type.Equality
    ( type (==) )
import Data.Typeable
    ( Typeable )
import Database.Persist.Sql
    ( Entity (..)
    , SelectOpt (..)
    , deleteWhere
    , insertMany_
    , insert_
    , repsert
    , selectFirst
    , selectList
    , (!=.)
    , (/<-.)
    , (==.)
    , (>.)
    )
import Database.Persist.Sqlite
    ( SqlPersistT )
import UnliftIO.Exception
    ( toException )

import qualified Cardano.Wallet.Primitive.AddressDerivation as W
import qualified Cardano.Wallet.Primitive.AddressDiscovery.Random as Rnd
import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
import qualified Cardano.Wallet.Primitive.AddressDiscovery.Shared as Shared
import qualified Cardano.Wallet.Primitive.Types as W
import qualified Cardano.Wallet.Primitive.Types.Address as W
import qualified Cardano.Wallet.Primitive.Types.Coin as W
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.Tx as W
import qualified Cardano.Wallet.Primitive.Types.UTxO as W
import qualified Data.Map.Merge.Strict as Map
import qualified Data.Map.Strict as Map

{-------------------------------------------------------------------------------
    WalletState Store
-------------------------------------------------------------------------------}
-- | Store for 'WalletState' of multiple different wallets.
mkStoreWallets
    :: forall s key. (PersistAddressBook s, key ~ W.WalletId)
    => Store (SqlPersistT IO)
        (DeltaMap key (DeltaWalletState s))
mkStoreWallets :: Store (SqlPersistT IO) (DeltaMap key (DeltaWalletState s))
mkStoreWallets = Store :: forall (m :: * -> *) da.
m (Either SomeException (Base da))
-> (Base da -> m ()) -> (Base da -> da -> m ()) -> Store m da
Store{loadS :: SqlPersistT
  IO
  (Either SomeException (Base (DeltaMap key (DeltaWalletState s))))
loadS=ReaderT
  SqlBackend IO (Either SomeException (Map WalletId (WalletState s)))
SqlPersistT
  IO
  (Either SomeException (Base (DeltaMap key (DeltaWalletState s))))
load,writeS :: Base (DeltaMap key (DeltaWalletState s)) -> SqlPersistT IO ()
writeS=Base (DeltaMap key (DeltaWalletState s)) -> SqlPersistT IO ()
forall a. a
write,updateS :: Base (DeltaMap key (DeltaWalletState s))
-> DeltaMap key (DeltaWalletState s) -> SqlPersistT IO ()
updateS=Base (DeltaMap key (DeltaWalletState s))
-> DeltaMap key (DeltaWalletState s) -> SqlPersistT IO ()
forall s p.
PersistAddressBook s =>
p -> DeltaMap WalletId (DeltaWalletState s) -> SqlPersistT IO ()
update}
  where
    write :: a
write = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"mkStoreWalletsCheckpoints: not implemented"

    update :: p -> DeltaMap WalletId (DeltaWalletState s) -> SqlPersistT IO ()
update p
_ (Insert WalletId
wid Base (DeltaWalletState s)
a) =
        Store (SqlPersistT IO) (DeltaWalletState s)
-> Base (DeltaWalletState s) -> SqlPersistT IO ()
forall (m :: * -> *) da. Store m da -> Base da -> m ()
writeS (WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
forall s.
PersistAddressBook s =>
WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
mkStoreWallet WalletId
wid) Base (DeltaWalletState s)
a
    update p
_ (Delete WalletId
wid) = do
        -- FIXME LATER during ADP-1043:
        --  Deleting an entry in the Checkpoint table
        --  will trigger a delete cascade. We want this cascade
        --  to be explicit in our code.
        [Filter Checkpoint] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
    update p
_ (Adjust WalletId
wid DeltaWalletState s
da) =
        Store (SqlPersistT IO) (DeltaWalletState s)
-> Base (DeltaWalletState s)
-> DeltaWalletState s
-> SqlPersistT IO ()
forall (m :: * -> *) da. Store m da -> Base da -> da -> m ()
updateS (WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
forall s.
PersistAddressBook s =>
WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
mkStoreWallet WalletId
wid) Base (DeltaWalletState s)
forall a. HasCallStack => a
undefined DeltaWalletState s
da
        -- FIXME LATER during ADP-1043:
        --   Remove 'undefined'.
        --   Probably needs a change to 'Data.DBVar.updateS'
        --   to take a 'Maybe a' as parameter instead of an 'a'.

    load :: ReaderT
  SqlBackend IO (Either SomeException (Map WalletId (WalletState s)))
load = do
        [WalletId]
wids <- (Entity Wallet -> WalletId) -> [Entity Wallet] -> [WalletId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((WalletId -> Const WalletId WalletId)
 -> Wallet -> Const WalletId Wallet)
-> Wallet -> WalletId
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "walId"
  ((WalletId -> Const WalletId WalletId)
   -> Wallet -> Const WalletId Wallet)
(WalletId -> Const WalletId WalletId)
-> Wallet -> Const WalletId Wallet
#walId (Wallet -> WalletId)
-> (Entity Wallet -> Wallet) -> Entity Wallet -> WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity Wallet -> Wallet
forall record. Entity record -> record
entityVal) ([Entity Wallet] -> [WalletId])
-> ReaderT SqlBackend IO [Entity Wallet]
-> ReaderT SqlBackend IO [WalletId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SqlBackend IO [Entity Wallet]
selectAll
        ExceptT
  SomeException (SqlPersistT IO) (Map WalletId (WalletState s))
-> ReaderT
     SqlBackend IO (Either SomeException (Map WalletId (WalletState s)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   SomeException (SqlPersistT IO) (Map WalletId (WalletState s))
 -> ReaderT
      SqlBackend
      IO
      (Either SomeException (Map WalletId (WalletState s))))
-> ExceptT
     SomeException (SqlPersistT IO) (Map WalletId (WalletState s))
-> ReaderT
     SqlBackend IO (Either SomeException (Map WalletId (WalletState s)))
forall a b. (a -> b) -> a -> b
$ do
            [WalletState s]
xs <- [WalletId]
-> (WalletId
    -> ExceptT SomeException (SqlPersistT IO) (WalletState s))
-> ExceptT SomeException (SqlPersistT IO) [WalletState s]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WalletId]
wids ((WalletId
  -> ExceptT SomeException (SqlPersistT IO) (WalletState s))
 -> ExceptT SomeException (SqlPersistT IO) [WalletState s])
-> (WalletId
    -> ExceptT SomeException (SqlPersistT IO) (WalletState s))
-> ExceptT SomeException (SqlPersistT IO) [WalletState s]
forall a b. (a -> b) -> a -> b
$ ReaderT SqlBackend IO (Either SomeException (WalletState s))
-> ExceptT SomeException (SqlPersistT IO) (WalletState s)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (ReaderT SqlBackend IO (Either SomeException (WalletState s))
 -> ExceptT SomeException (SqlPersistT IO) (WalletState s))
-> (WalletId
    -> ReaderT SqlBackend IO (Either SomeException (WalletState s)))
-> WalletId
-> ExceptT SomeException (SqlPersistT IO) (WalletState s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store (SqlPersistT IO) (DeltaWalletState s)
-> ReaderT SqlBackend IO (Either SomeException (WalletState s))
forall (m :: * -> *) da.
Store m da -> m (Either SomeException (Base da))
loadS (Store (SqlPersistT IO) (DeltaWalletState s)
 -> ReaderT SqlBackend IO (Either SomeException (WalletState s)))
-> (WalletId -> Store (SqlPersistT IO) (DeltaWalletState s))
-> WalletId
-> ReaderT SqlBackend IO (Either SomeException (WalletState s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
forall s.
PersistAddressBook s =>
WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
mkStoreWallet
            Map WalletId (WalletState s)
-> ExceptT
     SomeException (SqlPersistT IO) (Map WalletId (WalletState s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map WalletId (WalletState s)
 -> ExceptT
      SomeException (SqlPersistT IO) (Map WalletId (WalletState s)))
-> Map WalletId (WalletState s)
-> ExceptT
     SomeException (SqlPersistT IO) (Map WalletId (WalletState s))
forall a b. (a -> b) -> a -> b
$ [(WalletId, WalletState s)] -> Map WalletId (WalletState s)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([WalletId] -> [WalletState s] -> [(WalletId, WalletState s)]
forall a b. [a] -> [b] -> [(a, b)]
zip [WalletId]
wids [WalletState s]
xs)
      where
        selectAll :: SqlPersistT IO [Entity Wallet]
        selectAll :: ReaderT SqlBackend IO [Entity Wallet]
selectAll = [Filter Wallet]
-> [SelectOpt Wallet] -> ReaderT SqlBackend IO [Entity Wallet]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []

-- | Store for 'WalletState' of a single wallet.
mkStoreWallet
    :: forall s. PersistAddressBook s
    => W.WalletId
    -> Store (SqlPersistT IO) (DeltaWalletState s)
mkStoreWallet :: WalletId -> Store (SqlPersistT IO) (DeltaWalletState s)
mkStoreWallet WalletId
wid =
    Store :: forall (m :: * -> *) da.
m (Either SomeException (Base da))
-> (Base da -> m ()) -> (Base da -> da -> m ()) -> Store m da
Store{ loadS :: SqlPersistT IO (Either SomeException (Base (DeltaWalletState s)))
loadS = SqlPersistT IO (Either SomeException (Base (DeltaWalletState s)))
ReaderT SqlBackend IO (Either SomeException (WalletState s))
load, writeS :: Base (DeltaWalletState s) -> SqlPersistT IO ()
writeS = Base (DeltaWalletState s) -> SqlPersistT IO ()
WalletState s -> SqlPersistT IO ()
write, updateS :: Base (DeltaWalletState s)
-> DeltaWalletState s -> SqlPersistT IO ()
updateS = \Base (DeltaWalletState s)
_ -> DeltaWalletState s -> SqlPersistT IO ()
update }
  where
    storeCheckpoints :: Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
storeCheckpoints = WalletId
-> Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
forall s.
PersistAddressBook s =>
WalletId
-> Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
mkStoreCheckpoints WalletId
wid

    load :: ReaderT SqlBackend IO (Either SomeException (WalletState s))
load = do
        Either SomeException (Prologue s)
eprologue <- Either SomeException (Prologue s)
-> (Prologue s -> Either SomeException (Prologue s))
-> Maybe (Prologue s)
-> Either SomeException (Prologue s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SomeException -> Either SomeException (Prologue s)
forall a b. a -> Either a b
Left (SomeException -> Either SomeException (Prologue s))
-> SomeException -> Either SomeException (Prologue s)
forall a b. (a -> b) -> a -> b
$ ErrBadFormat -> SomeException
forall e. Exception e => e -> SomeException
toException ErrBadFormat
ErrBadFormatAddressPrologue) Prologue s -> Either SomeException (Prologue s)
forall a b. b -> Either a b
Right
            (Maybe (Prologue s) -> Either SomeException (Prologue s))
-> ReaderT SqlBackend IO (Maybe (Prologue s))
-> ReaderT SqlBackend IO (Either SomeException (Prologue s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId -> ReaderT SqlBackend IO (Maybe (Prologue s))
forall s.
PersistAddressBook s =>
WalletId -> SqlPersistT IO (Maybe (Prologue s))
loadPrologue WalletId
wid
        Either SomeException (Checkpoints (WalletCheckpoint s))
echeckpoints <- Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
-> SqlPersistT
     IO
     (Either
        SomeException (Base (DeltasCheckpoints (WalletCheckpoint s))))
forall (m :: * -> *) da.
Store m da -> m (Either SomeException (Base da))
loadS Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
storeCheckpoints
        Either SomeException (WalletState s)
-> ReaderT SqlBackend IO (Either SomeException (WalletState s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (WalletState s)
 -> ReaderT SqlBackend IO (Either SomeException (WalletState s)))
-> Either SomeException (WalletState s)
-> ReaderT SqlBackend IO (Either SomeException (WalletState s))
forall a b. (a -> b) -> a -> b
$ Prologue s -> Checkpoints (WalletCheckpoint s) -> WalletState s
forall s.
Prologue s -> Checkpoints (WalletCheckpoint s) -> WalletState s
WalletState (Prologue s -> Checkpoints (WalletCheckpoint s) -> WalletState s)
-> Either SomeException (Prologue s)
-> Either
     SomeException (Checkpoints (WalletCheckpoint s) -> WalletState s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Prologue s)
eprologue Either
  SomeException (Checkpoints (WalletCheckpoint s) -> WalletState s)
-> Either SomeException (Checkpoints (WalletCheckpoint s))
-> Either SomeException (WalletState s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either SomeException (Checkpoints (WalletCheckpoint s))
echeckpoints

    write :: WalletState s -> SqlPersistT IO ()
write WalletState s
wallet = do
        WalletId -> Prologue s -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> Prologue s -> SqlPersistT IO ()
insertPrologue WalletId
wid (WalletState s
wallet WalletState s
-> ((Prologue s -> Const (Prologue s) (Prologue s))
    -> WalletState s -> Const (Prologue s) (WalletState s))
-> Prologue s
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "prologue"
  ((Prologue s -> Const (Prologue s) (Prologue s))
   -> WalletState s -> Const (Prologue s) (WalletState s))
(Prologue s -> Const (Prologue s) (Prologue s))
-> WalletState s -> Const (Prologue s) (WalletState s)
#prologue)
        Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
-> Base (DeltasCheckpoints (WalletCheckpoint s))
-> SqlPersistT IO ()
forall (m :: * -> *) da. Store m da -> Base da -> m ()
writeS Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
storeCheckpoints (WalletState s
wallet WalletState s
-> ((Checkpoints (WalletCheckpoint s)
     -> Const
          (Checkpoints (WalletCheckpoint s))
          (Checkpoints (WalletCheckpoint s)))
    -> WalletState s
    -> Const (Checkpoints (WalletCheckpoint s)) (WalletState s))
-> Checkpoints (WalletCheckpoint s)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "checkpoints"
  ((Checkpoints (WalletCheckpoint s)
    -> Const
         (Checkpoints (WalletCheckpoint s))
         (Checkpoints (WalletCheckpoint s)))
   -> WalletState s
   -> Const (Checkpoints (WalletCheckpoint s)) (WalletState s))
(Checkpoints (WalletCheckpoint s)
 -> Const
      (Checkpoints (WalletCheckpoint s))
      (Checkpoints (WalletCheckpoint s)))
-> WalletState s
-> Const (Checkpoints (WalletCheckpoint s)) (WalletState s)
#checkpoints)

    update :: DeltaWalletState s -> SqlPersistT IO ()
update =
         -- first update in list is last to be applied!
        (DeltaWalletState1 s -> SqlPersistT IO ())
-> DeltaWalletState s -> SqlPersistT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DeltaWalletState1 s -> SqlPersistT IO ()
update1 (DeltaWalletState s -> SqlPersistT IO ())
-> (DeltaWalletState s -> DeltaWalletState s)
-> DeltaWalletState s
-> SqlPersistT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaWalletState s -> DeltaWalletState s
forall a. [a] -> [a]
reverse
    update1 :: DeltaWalletState1 s -> SqlPersistT IO ()
update1 (ReplacePrologue Prologue s
prologue) =
        WalletId -> Prologue s -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> Prologue s -> SqlPersistT IO ()
insertPrologue WalletId
wid Prologue s
prologue
    update1 (UpdateCheckpoints DeltasCheckpoints (WalletCheckpoint s)
delta) =
        -- FIXME LATER during ADP-1043: remove 'undefined'
        Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
-> Base (DeltasCheckpoints (WalletCheckpoint s))
-> DeltasCheckpoints (WalletCheckpoint s)
-> SqlPersistT IO ()
forall (m :: * -> *) da. Store m da -> Base da -> da -> m ()
updateS Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
storeCheckpoints Base (DeltasCheckpoints (WalletCheckpoint s))
forall a. HasCallStack => a
undefined DeltasCheckpoints (WalletCheckpoint s)
delta

-- | Store for the 'Checkpoints' belonging to a 'WalletState'.
mkStoreCheckpoints
    :: forall s. PersistAddressBook s
    => W.WalletId
    -> Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
mkStoreCheckpoints :: WalletId
-> Store (SqlPersistT IO) (DeltasCheckpoints (WalletCheckpoint s))
mkStoreCheckpoints WalletId
wid =
    Store :: forall (m :: * -> *) da.
m (Either SomeException (Base da))
-> (Base da -> m ()) -> (Base da -> da -> m ()) -> Store m da
Store{ loadS :: SqlPersistT
  IO
  (Either
     SomeException (Base (DeltasCheckpoints (WalletCheckpoint s))))
loadS = SqlPersistT
  IO
  (Either
     SomeException (Base (DeltasCheckpoints (WalletCheckpoint s))))
ReaderT
  SqlBackend
  IO
  (Either SomeException (Checkpoints (WalletCheckpoint s)))
load, writeS :: Base (DeltasCheckpoints (WalletCheckpoint s)) -> SqlPersistT IO ()
writeS = Base (DeltasCheckpoints (WalletCheckpoint s)) -> SqlPersistT IO ()
Checkpoints (WalletCheckpoint s) -> SqlPersistT IO ()
write, updateS :: Base (DeltasCheckpoints (WalletCheckpoint s))
-> DeltasCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
updateS = \Base (DeltasCheckpoints (WalletCheckpoint s))
_ -> DeltasCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
update }
  where
    load :: ReaderT
  SqlBackend
  IO
  (Either SomeException (Checkpoints (WalletCheckpoint s)))
load = (ErrBadFormat -> SomeException)
-> ([(Slot, WalletCheckpoint s)]
    -> Checkpoints (WalletCheckpoint s))
-> Either ErrBadFormat [(Slot, WalletCheckpoint s)]
-> Either SomeException (Checkpoints (WalletCheckpoint s))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ErrBadFormat -> SomeException
forall e. Exception e => e -> SomeException
toException [(Slot, WalletCheckpoint s)] -> Checkpoints (WalletCheckpoint s)
forall a. [(Slot, a)] -> Checkpoints a
loadCheckpoints (Either ErrBadFormat [(Slot, WalletCheckpoint s)]
 -> Either SomeException (Checkpoints (WalletCheckpoint s)))
-> ReaderT
     SqlBackend IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)])
-> ReaderT
     SqlBackend
     IO
     (Either SomeException (Checkpoints (WalletCheckpoint s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId
-> ReaderT
     SqlBackend IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)])
forall s.
PersistAddressBook s =>
WalletId
-> SqlPersistT
     IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)])
selectAllCheckpoints WalletId
wid

    write :: Checkpoints (WalletCheckpoint s) -> SqlPersistT IO ()
write Checkpoints (WalletCheckpoint s)
cps = [(Slot, WalletCheckpoint s)]
-> ((Slot, WalletCheckpoint s) -> SqlPersistT IO ())
-> SqlPersistT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Slot (WalletCheckpoint s) -> [(Slot, WalletCheckpoint s)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Slot (WalletCheckpoint s) -> [(Slot, WalletCheckpoint s)])
-> Map Slot (WalletCheckpoint s) -> [(Slot, WalletCheckpoint s)]
forall a b. (a -> b) -> a -> b
$ Checkpoints (WalletCheckpoint s)
cps Checkpoints (WalletCheckpoint s)
-> ((Map Slot (WalletCheckpoint s)
     -> Const
          (Map Slot (WalletCheckpoint s)) (Map Slot (WalletCheckpoint s)))
    -> Checkpoints (WalletCheckpoint s)
    -> Const
         (Map Slot (WalletCheckpoint s)) (Checkpoints (WalletCheckpoint s)))
-> Map Slot (WalletCheckpoint s)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "checkpoints"
  ((Map Slot (WalletCheckpoint s)
    -> Const
         (Map Slot (WalletCheckpoint s)) (Map Slot (WalletCheckpoint s)))
   -> Checkpoints (WalletCheckpoint s)
   -> Const
        (Map Slot (WalletCheckpoint s)) (Checkpoints (WalletCheckpoint s)))
(Map Slot (WalletCheckpoint s)
 -> Const
      (Map Slot (WalletCheckpoint s)) (Map Slot (WalletCheckpoint s)))
-> Checkpoints (WalletCheckpoint s)
-> Const
     (Map Slot (WalletCheckpoint s)) (Checkpoints (WalletCheckpoint s))
#checkpoints) (((Slot, WalletCheckpoint s) -> SqlPersistT IO ())
 -> SqlPersistT IO ())
-> ((Slot, WalletCheckpoint s) -> SqlPersistT IO ())
-> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ \(Slot
pt,WalletCheckpoint s
cp) ->
            DeltaCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
update1 (Slot -> WalletCheckpoint s -> DeltaCheckpoints (WalletCheckpoint s)
forall a. Slot -> a -> DeltaCheckpoints a
PutCheckpoint Slot
pt WalletCheckpoint s
cp)

         -- first update in list is the last to be applied!
    update :: DeltasCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
update = (DeltaCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ())
-> DeltasCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DeltaCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
update1 (DeltasCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ())
-> (DeltasCheckpoints (WalletCheckpoint s)
    -> DeltasCheckpoints (WalletCheckpoint s))
-> DeltasCheckpoints (WalletCheckpoint s)
-> SqlPersistT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltasCheckpoints (WalletCheckpoint s)
-> DeltasCheckpoints (WalletCheckpoint s)
forall a. [a] -> [a]
reverse

    update1 :: DeltaCheckpoints (WalletCheckpoint s) -> SqlPersistT IO ()
update1 (PutCheckpoint Slot
_ WalletCheckpoint s
state) =
        WalletId -> WalletCheckpoint s -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> WalletCheckpoint s -> SqlPersistT IO ()
insertCheckpoint WalletId
wid WalletCheckpoint s
state
    update1 (RollbackTo (W.At SlotNo
slot)) =
        [Filter Checkpoint] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [ EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid, EntityField Checkpoint SlotNo
forall typ. (typ ~ SlotNo) => EntityField Checkpoint typ
CheckpointSlot EntityField Checkpoint SlotNo -> SlotNo -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>. SlotNo
slot ]
    update1 (RollbackTo Slot
W.Origin) =
        [Filter Checkpoint] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere
            [ EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
            , EntityField Checkpoint BlockId
forall typ. (typ ~ BlockId) => EntityField Checkpoint typ
CheckpointParentHash EntityField Checkpoint BlockId -> BlockId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. Hash "BlockHeader" -> BlockId
BlockId Hash "BlockHeader"
hashOfNoParent
            ]
    update1 (RestrictTo [Slot]
pts) = do
        let points :: [Slot]
points = Slot
forall t. WithOrigin t
W.Origin Slot -> [Slot] -> [Slot]
forall a. a -> [a] -> [a]
: [Slot]
pts
        let pseudoSlot :: Slot -> SlotNo
pseudoSlot Slot
W.Origin    = Word64 -> SlotNo
W.SlotNo Word64
0
            pseudoSlot (W.At SlotNo
slot) = SlotNo
slot
        let slots :: [SlotNo]
slots = (Slot -> SlotNo) -> [Slot] -> [SlotNo]
forall a b. (a -> b) -> [a] -> [b]
map Slot -> SlotNo
pseudoSlot [Slot]
points
        [Filter Checkpoint] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [ EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid, EntityField Checkpoint SlotNo
forall typ. (typ ~ SlotNo) => EntityField Checkpoint typ
CheckpointSlot EntityField Checkpoint SlotNo -> [SlotNo] -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
/<-. [SlotNo]
slots ]

        -- We may have to delete the checkpoint at SlotNo 0 that is not genesis.
        let slot0 :: Slot
slot0 = SlotNo -> Slot
forall t. t -> WithOrigin t
W.At (SlotNo -> Slot) -> SlotNo -> Slot
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
W.SlotNo Word64
0
        Bool -> SqlPersistT IO () -> SqlPersistT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Slot
slot0 Slot -> [Slot] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Slot]
points) (SqlPersistT IO () -> SqlPersistT IO ())
-> SqlPersistT IO () -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$
            [Filter Checkpoint] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere
                [ EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
                , EntityField Checkpoint SlotNo
forall typ. (typ ~ SlotNo) => EntityField Checkpoint typ
CheckpointSlot EntityField Checkpoint SlotNo -> SlotNo -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Word64 -> SlotNo
W.SlotNo Word64
0
                , EntityField Checkpoint BlockId
forall typ. (typ ~ BlockId) => EntityField Checkpoint typ
CheckpointParentHash EntityField Checkpoint BlockId -> BlockId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. Hash "BlockHeader" -> BlockId
BlockId Hash "BlockHeader"
hashOfNoParent
                ]

{-------------------------------------------------------------------------------
    Database operations
-------------------------------------------------------------------------------}
selectAllCheckpoints
    :: forall s. PersistAddressBook s
    => W.WalletId
    -> SqlPersistT IO (Either ErrBadFormat [(W.Slot, WalletCheckpoint s)])
selectAllCheckpoints :: WalletId
-> SqlPersistT
     IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)])
selectAllCheckpoints WalletId
wid = do
    [Checkpoint]
cpRefs <- (Entity Checkpoint -> Checkpoint)
-> [Entity Checkpoint] -> [Checkpoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity Checkpoint -> Checkpoint
forall record. Entity record -> record
entityVal ([Entity Checkpoint] -> [Checkpoint])
-> ReaderT SqlBackend IO [Entity Checkpoint]
-> ReaderT SqlBackend IO [Checkpoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter Checkpoint]
-> [SelectOpt Checkpoint]
-> ReaderT SqlBackend IO [Entity Checkpoint]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
        [ EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid ]
        [ EntityField Checkpoint SlotNo -> SelectOpt Checkpoint
forall record typ. EntityField record typ -> SelectOpt record
Desc EntityField Checkpoint SlotNo
forall typ. (typ ~ SlotNo) => EntityField Checkpoint typ
CheckpointSlot ]
    [(Slot, WalletCheckpoint s)]
cps <- [Checkpoint]
-> (Checkpoint -> ReaderT SqlBackend IO (Slot, WalletCheckpoint s))
-> ReaderT SqlBackend IO [(Slot, WalletCheckpoint s)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Checkpoint]
cpRefs ((Checkpoint -> ReaderT SqlBackend IO (Slot, WalletCheckpoint s))
 -> ReaderT SqlBackend IO [(Slot, WalletCheckpoint s)])
-> (Checkpoint -> ReaderT SqlBackend IO (Slot, WalletCheckpoint s))
-> ReaderT SqlBackend IO [(Slot, WalletCheckpoint s)]
forall a b. (a -> b) -> a -> b
$ \Checkpoint
cp -> do
        -- FIXME during APD-1043: Internal consistency of this table?
        ([UTxO], [UTxOToken])
utxo <- Checkpoint -> SqlPersistT IO ([UTxO], [UTxOToken])
selectUTxO Checkpoint
cp
        Discoveries s
discoveries <- WalletId -> SlotNo -> SqlPersistT IO (Discoveries s)
forall s.
PersistAddressBook s =>
WalletId -> SlotNo -> SqlPersistT IO (Discoveries s)
loadDiscoveries WalletId
wid (Checkpoint -> SlotNo
checkpointSlot Checkpoint
cp)
        let c :: WalletCheckpoint s
c = Checkpoint
-> ([UTxO], [UTxOToken]) -> Discoveries s -> WalletCheckpoint s
forall s.
Checkpoint
-> ([UTxO], [UTxOToken]) -> Discoveries s -> WalletCheckpoint s
checkpointFromEntity @s Checkpoint
cp ([UTxO], [UTxOToken])
utxo Discoveries s
discoveries
        (Slot, WalletCheckpoint s)
-> ReaderT SqlBackend IO (Slot, WalletCheckpoint s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletCheckpoint s -> Slot
forall s. WalletCheckpoint s -> Slot
getSlot WalletCheckpoint s
c, WalletCheckpoint s
c)
    Either ErrBadFormat [(Slot, WalletCheckpoint s)]
-> SqlPersistT
     IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ErrBadFormat [(Slot, WalletCheckpoint s)]
 -> SqlPersistT
      IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)]))
-> Either ErrBadFormat [(Slot, WalletCheckpoint s)]
-> SqlPersistT
     IO (Either ErrBadFormat [(Slot, WalletCheckpoint s)])
forall a b. (a -> b) -> a -> b
$ case [(Slot, WalletCheckpoint s)]
cps of
        [] -> ErrBadFormat -> Either ErrBadFormat [(Slot, WalletCheckpoint s)]
forall a b. a -> Either a b
Left ErrBadFormat
ErrBadFormatCheckpoints
        [(Slot, WalletCheckpoint s)]
_  -> [(Slot, WalletCheckpoint s)]
-> Either ErrBadFormat [(Slot, WalletCheckpoint s)]
forall a b. b -> Either a b
Right [(Slot, WalletCheckpoint s)]
cps


selectUTxO
    :: Checkpoint
    -> SqlPersistT IO ([UTxO], [UTxOToken])
selectUTxO :: Checkpoint -> SqlPersistT IO ([UTxO], [UTxOToken])
selectUTxO Checkpoint
cp = do
    [UTxO]
coins <- (Entity UTxO -> UTxO) -> [Entity UTxO] -> [UTxO]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity UTxO -> UTxO
forall record. Entity record -> record
entityVal ([Entity UTxO] -> [UTxO])
-> ReaderT SqlBackend IO [Entity UTxO]
-> ReaderT SqlBackend IO [UTxO]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Filter UTxO]
-> [SelectOpt UTxO] -> ReaderT SqlBackend IO [Entity UTxO]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
            [ EntityField UTxO WalletId
forall typ. (typ ~ WalletId) => EntityField UTxO typ
UtxoWalletId EntityField UTxO WalletId -> WalletId -> Filter UTxO
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Checkpoint -> WalletId
checkpointWalletId Checkpoint
cp
            , EntityField UTxO SlotNo
forall typ. (typ ~ SlotNo) => EntityField UTxO typ
UtxoSlot EntityField UTxO SlotNo -> SlotNo -> Filter UTxO
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Checkpoint -> SlotNo
checkpointSlot Checkpoint
cp
            ] []
    [UTxOToken]
tokens <- (Entity UTxOToken -> UTxOToken)
-> [Entity UTxOToken] -> [UTxOToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity UTxOToken -> UTxOToken
forall record. Entity record -> record
entityVal ([Entity UTxOToken] -> [UTxOToken])
-> ReaderT SqlBackend IO [Entity UTxOToken]
-> ReaderT SqlBackend IO [UTxOToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Filter UTxOToken]
-> [SelectOpt UTxOToken]
-> ReaderT SqlBackend IO [Entity UTxOToken]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
            [ EntityField UTxOToken WalletId
forall typ. (typ ~ WalletId) => EntityField UTxOToken typ
UtxoTokenWalletId EntityField UTxOToken WalletId -> WalletId -> Filter UTxOToken
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Checkpoint -> WalletId
checkpointWalletId Checkpoint
cp
            , EntityField UTxOToken SlotNo
forall typ. (typ ~ SlotNo) => EntityField UTxOToken typ
UtxoTokenSlot EntityField UTxOToken SlotNo -> SlotNo -> Filter UTxOToken
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Checkpoint -> SlotNo
checkpointSlot Checkpoint
cp
            ] []
    ([UTxO], [UTxOToken]) -> SqlPersistT IO ([UTxO], [UTxOToken])
forall (m :: * -> *) a. Monad m => a -> m a
return ([UTxO]
coins, [UTxOToken]
tokens)

insertCheckpoint
    :: forall s. (PersistAddressBook s)
    => W.WalletId
    -> WalletCheckpoint s
    -> SqlPersistT IO ()
insertCheckpoint :: WalletId -> WalletCheckpoint s -> SqlPersistT IO ()
insertCheckpoint WalletId
wid wallet :: WalletCheckpoint s
wallet@(WalletCheckpoint BlockHeader
currentTip UTxO
_ Discoveries s
discoveries) = do
    let (Checkpoint
cp, [UTxO]
utxo, [UTxOToken]
utxoTokens) = WalletId -> WalletCheckpoint s -> (Checkpoint, [UTxO], [UTxOToken])
forall s.
WalletId -> WalletCheckpoint s -> (Checkpoint, [UTxO], [UTxOToken])
mkCheckpointEntity WalletId
wid WalletCheckpoint s
wallet
    let sl :: SlotNo
sl = BlockHeader
currentTip BlockHeader
-> ((SlotNo -> Const SlotNo SlotNo)
    -> BlockHeader -> Const SlotNo BlockHeader)
-> SlotNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo)
   -> BlockHeader -> Const SlotNo BlockHeader)
(SlotNo -> Const SlotNo SlotNo)
-> BlockHeader -> Const SlotNo BlockHeader
#slotNo
    [Filter Checkpoint] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField Checkpoint WalletId
forall typ. (typ ~ WalletId) => EntityField Checkpoint typ
CheckpointWalletId EntityField Checkpoint WalletId -> WalletId -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid, EntityField Checkpoint SlotNo
forall typ. (typ ~ SlotNo) => EntityField Checkpoint typ
CheckpointSlot EntityField Checkpoint SlotNo -> SlotNo -> Filter Checkpoint
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SlotNo
sl]
    Checkpoint -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Checkpoint
cp
    ([UTxO] -> SqlPersistT IO ()) -> [UTxO] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [UTxO] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ [UTxO]
utxo
    ([UTxOToken] -> SqlPersistT IO ())
-> [UTxOToken] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [UTxOToken] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ [UTxOToken]
utxoTokens
    WalletId -> SlotNo -> Discoveries s -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> SlotNo -> Discoveries s -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl Discoveries s
discoveries

{-------------------------------------------------------------------------------
    Database type conversions
-------------------------------------------------------------------------------}
blockHeaderFromEntity :: Checkpoint -> W.BlockHeader
blockHeaderFromEntity :: Checkpoint -> BlockHeader
blockHeaderFromEntity Checkpoint
cp = BlockHeader :: SlotNo
-> Quantity "block" Word32
-> Hash "BlockHeader"
-> Maybe (Hash "BlockHeader")
-> BlockHeader
W.BlockHeader
    { $sel:slotNo:BlockHeader :: SlotNo
slotNo = Checkpoint -> SlotNo
checkpointSlot Checkpoint
cp
    , $sel:blockHeight:BlockHeader :: Quantity "block" Word32
blockHeight = Word32 -> Quantity "block" Word32
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Checkpoint -> Word32
checkpointBlockHeight Checkpoint
cp)
    , $sel:headerHash:BlockHeader :: Hash "BlockHeader"
headerHash = BlockId -> Hash "BlockHeader"
getBlockId (Checkpoint -> BlockId
checkpointHeaderHash Checkpoint
cp)
    , $sel:parentHeaderHash:BlockHeader :: Maybe (Hash "BlockHeader")
parentHeaderHash = BlockId -> Maybe (Hash "BlockHeader")
toMaybeHash (Checkpoint -> BlockId
checkpointParentHash Checkpoint
cp)
    }

mkCheckpointEntity
    :: W.WalletId
    -> WalletCheckpoint s
    -> (Checkpoint, [UTxO], [UTxOToken])
mkCheckpointEntity :: WalletId -> WalletCheckpoint s -> (Checkpoint, [UTxO], [UTxOToken])
mkCheckpointEntity WalletId
wid (WalletCheckpoint BlockHeader
header UTxO
wutxo Discoveries s
_) =
    (Checkpoint
cp, [UTxO]
utxo, [UTxOToken]
utxoTokens)
  where
    sl :: SlotNo
sl = BlockHeader
header BlockHeader
-> ((SlotNo -> Const SlotNo SlotNo)
    -> BlockHeader -> Const SlotNo BlockHeader)
-> SlotNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo)
   -> BlockHeader -> Const SlotNo BlockHeader)
(SlotNo -> Const SlotNo SlotNo)
-> BlockHeader -> Const SlotNo BlockHeader
#slotNo
    (Quantity Word32
bh) = BlockHeader
header BlockHeader
-> ((Quantity "block" Word32
     -> Const (Quantity "block" Word32) (Quantity "block" Word32))
    -> BlockHeader -> Const (Quantity "block" Word32) BlockHeader)
-> Quantity "block" Word32
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "blockHeight"
  ((Quantity "block" Word32
    -> Const (Quantity "block" Word32) (Quantity "block" Word32))
   -> BlockHeader -> Const (Quantity "block" Word32) BlockHeader)
(Quantity "block" Word32
 -> Const (Quantity "block" Word32) (Quantity "block" Word32))
-> BlockHeader -> Const (Quantity "block" Word32) BlockHeader
#blockHeight
    cp :: Checkpoint
cp = Checkpoint :: WalletId -> SlotNo -> BlockId -> BlockId -> Word32 -> Checkpoint
Checkpoint
        { checkpointWalletId :: WalletId
checkpointWalletId = WalletId
wid
        , checkpointSlot :: SlotNo
checkpointSlot = SlotNo
sl
        , checkpointParentHash :: BlockId
checkpointParentHash = Maybe (Hash "BlockHeader") -> BlockId
fromMaybeHash (BlockHeader
header BlockHeader
-> ((Maybe (Hash "BlockHeader")
     -> Const (Maybe (Hash "BlockHeader")) (Maybe (Hash "BlockHeader")))
    -> BlockHeader -> Const (Maybe (Hash "BlockHeader")) BlockHeader)
-> Maybe (Hash "BlockHeader")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "parentHeaderHash"
  ((Maybe (Hash "BlockHeader")
    -> Const (Maybe (Hash "BlockHeader")) (Maybe (Hash "BlockHeader")))
   -> BlockHeader -> Const (Maybe (Hash "BlockHeader")) BlockHeader)
(Maybe (Hash "BlockHeader")
 -> Const (Maybe (Hash "BlockHeader")) (Maybe (Hash "BlockHeader")))
-> BlockHeader -> Const (Maybe (Hash "BlockHeader")) BlockHeader
#parentHeaderHash)
        , checkpointHeaderHash :: BlockId
checkpointHeaderHash = Hash "BlockHeader" -> BlockId
BlockId (BlockHeader
header BlockHeader
-> ((Hash "BlockHeader"
     -> Const (Hash "BlockHeader") (Hash "BlockHeader"))
    -> BlockHeader -> Const (Hash "BlockHeader") BlockHeader)
-> Hash "BlockHeader"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "headerHash"
  ((Hash "BlockHeader"
    -> Const (Hash "BlockHeader") (Hash "BlockHeader"))
   -> BlockHeader -> Const (Hash "BlockHeader") BlockHeader)
(Hash "BlockHeader"
 -> Const (Hash "BlockHeader") (Hash "BlockHeader"))
-> BlockHeader -> Const (Hash "BlockHeader") BlockHeader
#headerHash)
        , checkpointBlockHeight :: Word32
checkpointBlockHeight = Word32
bh
        }
    utxo :: [UTxO]
utxo =
        [ WalletId -> SlotNo -> TxId -> Word32 -> Address -> Coin -> UTxO
UTxO WalletId
wid SlotNo
sl (Hash "Tx" -> TxId
TxId Hash "Tx"
input) Word32
ix Address
addr (TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
tokens)
        | (W.TxIn Hash "Tx"
input Word32
ix, W.TxOut Address
addr TokenBundle
tokens) <- [(TxIn, TxOut)]
utxoMap
        ]
    utxoTokens :: [UTxOToken]
utxoTokens =
        [ WalletId
-> SlotNo
-> TxId
-> Word32
-> TokenPolicyId
-> TokenName
-> TokenQuantity
-> UTxOToken
UTxOToken WalletId
wid SlotNo
sl (Hash "Tx" -> TxId
TxId Hash "Tx"
input) Word32
ix TokenPolicyId
policy TokenName
token TokenQuantity
quantity
        | (W.TxIn Hash "Tx"
input Word32
ix, W.TxOut {TokenBundle
$sel:tokens:TxOut :: TxOut -> TokenBundle
tokens :: TokenBundle
tokens}) <- [(TxIn, TxOut)]
utxoMap
        , let tokenList :: [(AssetId, TokenQuantity)]
tokenList = (Coin, [(AssetId, TokenQuantity)]) -> [(AssetId, TokenQuantity)]
forall a b. (a, b) -> b
snd (TokenBundle -> (Coin, [(AssetId, TokenQuantity)])
TokenBundle.toFlatList TokenBundle
tokens)
        , (AssetId TokenPolicyId
policy TokenName
token, TokenQuantity
quantity) <- [(AssetId, TokenQuantity)]
tokenList
        ]
    utxoMap :: [(TxIn, TxOut)]
utxoMap = Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.assocs (UTxO -> Map TxIn TxOut
W.unUTxO UTxO
wutxo)

-- note: TxIn records must already be sorted by order
-- and TxOut records must already by sorted by index.
checkpointFromEntity
    :: Checkpoint
    -> ([UTxO], [UTxOToken])
    -> Discoveries s
    -> WalletCheckpoint s
checkpointFromEntity :: Checkpoint
-> ([UTxO], [UTxOToken]) -> Discoveries s -> WalletCheckpoint s
checkpointFromEntity Checkpoint
cp ([UTxO]
coins, [UTxOToken]
tokens) =
    BlockHeader -> UTxO -> Discoveries s -> WalletCheckpoint s
forall s.
BlockHeader -> UTxO -> Discoveries s -> WalletCheckpoint s
WalletCheckpoint BlockHeader
header UTxO
utxo
  where
    header :: BlockHeader
header = Checkpoint -> BlockHeader
blockHeaderFromEntity Checkpoint
cp

    utxo :: UTxO
utxo = Map TxIn TxOut -> UTxO
W.UTxO (Map TxIn TxOut -> UTxO) -> Map TxIn TxOut -> UTxO
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing TxIn (Address, Coin) TxOut
-> SimpleWhenMissing TxIn TokenBundle TxOut
-> SimpleWhenMatched TxIn (Address, Coin) TokenBundle TxOut
-> Map TxIn (Address, Coin)
-> Map TxIn TokenBundle
-> Map TxIn TxOut
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge
        ((TxIn -> (Address, Coin) -> TxOut)
-> SimpleWhenMissing TxIn (Address, Coin) TxOut
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (((Address, Coin) -> TxOut) -> TxIn -> (Address, Coin) -> TxOut
forall a b. a -> b -> a
const (Address, Coin) -> TxOut
mkFromCoin)) -- No assets, only coins
        (SimpleWhenMissing TxIn TokenBundle TxOut
forall (f :: * -> *) k x y. Applicative f => WhenMissing f k x y
Map.dropMissing) -- Only assets, impossible.
        ((TxIn -> (Address, Coin) -> TokenBundle -> TxOut)
-> SimpleWhenMatched TxIn (Address, Coin) TokenBundle TxOut
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (((Address, Coin) -> TokenBundle -> TxOut)
-> TxIn -> (Address, Coin) -> TokenBundle -> TxOut
forall a b. a -> b -> a
const (Address, Coin) -> TokenBundle -> TxOut
mkFromBoth)) -- Both assets and coins
        ([(TxIn, (Address, Coin))] -> Map TxIn (Address, Coin)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Hash "Tx" -> Word32 -> TxIn
W.TxIn Hash "Tx"
input Word32
ix, (Address
addr, Coin
coin))
            | (UTxO WalletId
_ SlotNo
_ (TxId Hash "Tx"
input) Word32
ix Address
addr Coin
coin) <- [UTxO]
coins
            ])
        ((TokenBundle -> TokenBundle -> TokenBundle)
-> [(TxIn, TokenBundle)] -> Map TxIn TokenBundle
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.add
            [ (Hash "Tx" -> Word32 -> TxIn
W.TxIn Hash "Tx"
input Word32
ix, UTxOToken -> TokenBundle
mkTokenEntry UTxOToken
token)
            | (token :: UTxOToken
token@(UTxOToken WalletId
_ SlotNo
_ (TxId Hash "Tx"
input) Word32
ix TokenPolicyId
_ TokenName
_ TokenQuantity
_)) <- [UTxOToken]
tokens
            ])

    mkFromCoin :: (W.Address, W.Coin) -> W.TxOut
    mkFromCoin :: (Address, Coin) -> TxOut
mkFromCoin (Address
addr, Coin
coin) =
        Address -> TokenBundle -> TxOut
W.TxOut Address
addr (Coin -> TokenBundle
TokenBundle.fromCoin Coin
coin)

    mkFromBoth :: (W.Address, W.Coin) -> TokenBundle -> W.TxOut
    mkFromBoth :: (Address, Coin) -> TokenBundle -> TxOut
mkFromBoth (Address
addr, Coin
coin) TokenBundle
bundle =
        Address -> TokenBundle -> TxOut
W.TxOut Address
addr (TokenBundle -> TokenBundle -> TokenBundle
TokenBundle.add (Coin -> TokenBundle
TokenBundle.fromCoin Coin
coin) TokenBundle
bundle)

    mkTokenEntry :: UTxOToken -> TokenBundle
mkTokenEntry UTxOToken
token = Coin -> [(AssetId, TokenQuantity)] -> TokenBundle
TokenBundle.fromFlatList (Natural -> Coin
W.Coin Natural
0)
        [ ( TokenPolicyId -> TokenName -> AssetId
AssetId (UTxOToken -> TokenPolicyId
utxoTokenPolicyId UTxOToken
token) (UTxOToken -> TokenName
utxoTokenName UTxOToken
token)
          , UTxOToken -> TokenQuantity
utxoTokenQuantity UTxOToken
token
          )
        ]

{-------------------------------------------------------------------------------
    AddressBook storage
-------------------------------------------------------------------------------}
-- | Functions for saving / loading the wallet's address book to / from SQLite
class AddressBookIso s => PersistAddressBook s where
    insertPrologue
        :: W.WalletId -> Prologue s -> SqlPersistT IO ()
    insertDiscoveries
        :: W.WalletId -> W.SlotNo -> Discoveries s -> SqlPersistT IO ()

    loadPrologue
        :: W.WalletId -> SqlPersistT IO (Maybe (Prologue s))
    loadDiscoveries
        :: W.WalletId -> W.SlotNo -> SqlPersistT IO (Discoveries s)

{-------------------------------------------------------------------------------
    Sequential address book storage
-------------------------------------------------------------------------------}
-- piggy-back on SeqState existing instance, to simulate the same behavior.
instance
    ( Eq (Seq.SeqState n k)
    , (k == SharedKey) ~ 'False
    , PersistAddressBook (Seq.SeqState n k)
    )
    => PersistAddressBook (Seq.SeqAnyState n k p)
  where
    insertPrologue :: WalletId -> Prologue (SeqAnyState n k p) -> SqlPersistT IO ()
insertPrologue WalletId
wid (PS s) = WalletId -> Prologue (SeqState n k) -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> Prologue s -> SqlPersistT IO ()
insertPrologue WalletId
wid Prologue (SeqState n k)
s
    insertDiscoveries :: WalletId
-> SlotNo -> Discoveries (SeqAnyState n k p) -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl (DS s) = WalletId
-> SlotNo -> Discoveries (SeqState n k) -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> SlotNo -> Discoveries s -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl Discoveries (SeqState n k)
s
    loadPrologue :: WalletId -> SqlPersistT IO (Maybe (Prologue (SeqAnyState n k p)))
loadPrologue WalletId
wid = (Prologue (SeqState n k) -> Prologue (SeqAnyState n k p))
-> Maybe (Prologue (SeqState n k))
-> Maybe (Prologue (SeqAnyState n k p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prologue (SeqState n k) -> Prologue (SeqAnyState n k p)
forall (n :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat).
Prologue (SeqState n key) -> Prologue (SeqAnyState n key p)
PS (Maybe (Prologue (SeqState n k))
 -> Maybe (Prologue (SeqAnyState n k p)))
-> ReaderT SqlBackend IO (Maybe (Prologue (SeqState n k)))
-> SqlPersistT IO (Maybe (Prologue (SeqAnyState n k p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId -> ReaderT SqlBackend IO (Maybe (Prologue (SeqState n k)))
forall s.
PersistAddressBook s =>
WalletId -> SqlPersistT IO (Maybe (Prologue s))
loadPrologue WalletId
wid
    loadDiscoveries :: WalletId
-> SlotNo -> SqlPersistT IO (Discoveries (SeqAnyState n k p))
loadDiscoveries WalletId
wid SlotNo
sl = Discoveries (SeqState n k) -> Discoveries (SeqAnyState n k p)
forall (n :: NetworkDiscriminant) (key :: Depth -> * -> *)
       (p :: Nat).
Discoveries (SeqState n key) -> Discoveries (SeqAnyState n key p)
DS (Discoveries (SeqState n k) -> Discoveries (SeqAnyState n k p))
-> ReaderT SqlBackend IO (Discoveries (SeqState n k))
-> SqlPersistT IO (Discoveries (SeqAnyState n k p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId
-> SlotNo -> ReaderT SqlBackend IO (Discoveries (SeqState n k))
forall s.
PersistAddressBook s =>
WalletId -> SlotNo -> SqlPersistT IO (Discoveries s)
loadDiscoveries WalletId
wid SlotNo
sl

instance
    ( PersistPublicKey (key 'AccountK)
    , PersistPublicKey (key 'AddressK)
    , PersistPublicKey (key 'PolicyK)
    , MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
    , PaymentAddress n key
    , SoftDerivation key
    , Typeable n
    , (key == SharedKey) ~ 'False
    , Eq (Seq.SeqState n key)
    ) => PersistAddressBook (Seq.SeqState n key) where

    insertPrologue :: WalletId -> Prologue (SeqState n key) -> SqlPersistT IO ()
insertPrologue WalletId
wid (SeqPrologue st) = do
        Key SeqState -> SeqState -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
repsert (WalletId -> Key SeqState
SeqStateKey WalletId
wid) (SeqState -> SqlPersistT IO ()) -> SeqState -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ SeqState :: WalletId
-> AddressPoolGap
-> AddressPoolGap
-> ByteString
-> Maybe ByteString
-> ByteString
-> DerivationPrefix
-> SeqState
SeqState
            { seqStateWalletId :: WalletId
seqStateWalletId = WalletId
wid
            , seqStateExternalGap :: AddressPoolGap
seqStateExternalGap = SeqAddressPool 'UtxoExternal key -> AddressPoolGap
forall (c :: Role) (k :: Depth -> * -> *).
SeqAddressPool c k -> AddressPoolGap
Seq.getGap (SeqAddressPool 'UtxoExternal key -> AddressPoolGap)
-> SeqAddressPool 'UtxoExternal key -> AddressPoolGap
forall a b. (a -> b) -> a -> b
$ SeqState n key -> SeqAddressPool 'UtxoExternal key
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoExternal k
Seq.externalPool SeqState n key
st
            , seqStateInternalGap :: AddressPoolGap
seqStateInternalGap = SeqAddressPool 'UtxoInternal key -> AddressPoolGap
forall (c :: Role) (k :: Depth -> * -> *).
SeqAddressPool c k -> AddressPoolGap
Seq.getGap (SeqAddressPool 'UtxoInternal key -> AddressPoolGap)
-> SeqAddressPool 'UtxoInternal key -> AddressPoolGap
forall a b. (a -> b) -> a -> b
$ SeqState n key -> SeqAddressPool 'UtxoInternal key
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> SeqAddressPool 'UtxoInternal k
Seq.internalPool SeqState n key
st
            , seqStateAccountXPub :: ByteString
seqStateAccountXPub = key 'AccountK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub (key 'AccountK XPub -> ByteString)
-> key 'AccountK XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ SeqState n key -> key 'AccountK XPub
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AccountK XPub
Seq.accountXPub SeqState n key
st
            , seqStatePolicyXPub :: Maybe ByteString
seqStatePolicyXPub = key 'PolicyK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub (key 'PolicyK XPub -> ByteString)
-> Maybe (key 'PolicyK XPub) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SeqState n key -> Maybe (key 'PolicyK XPub)
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> Maybe (k 'PolicyK XPub)
Seq.policyXPub SeqState n key
st
            , seqStateRewardXPub :: ByteString
seqStateRewardXPub = key 'AddressK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub (key 'AddressK XPub -> ByteString)
-> key 'AddressK XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ SeqState n key -> key 'AddressK XPub
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> k 'AddressK XPub
Seq.rewardAccountKey SeqState n key
st
            , seqStateDerivationPrefix :: DerivationPrefix
seqStateDerivationPrefix = SeqState n key -> DerivationPrefix
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> DerivationPrefix
Seq.derivationPrefix SeqState n key
st
            }
        [Filter SeqStatePendingIx] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField SeqStatePendingIx WalletId
forall typ. (typ ~ WalletId) => EntityField SeqStatePendingIx typ
SeqStatePendingWalletId EntityField SeqStatePendingIx WalletId
-> WalletId -> Filter SeqStatePendingIx
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
        ([SeqStatePendingIx] -> SqlPersistT IO ())
-> [SeqStatePendingIx] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked
            [SeqStatePendingIx] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
            (WalletId -> PendingIxs 'AddressK -> [SeqStatePendingIx]
mkSeqStatePendingIxs WalletId
wid (PendingIxs 'AddressK -> [SeqStatePendingIx])
-> PendingIxs 'AddressK -> [SeqStatePendingIx]
forall a b. (a -> b) -> a -> b
$ SeqState n key -> PendingIxs 'AddressK
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqState n k -> PendingIxs 'AddressK
Seq.pendingChangeIxs SeqState n key
st)

    insertDiscoveries :: WalletId
-> SlotNo -> Discoveries (SeqState n key) -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl (SeqDiscoveries ints exts) = do
        WalletId
-> SlotNo -> SeqAddressMap 'UtxoInternal key -> SqlPersistT IO ()
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(PaymentAddress n key, Typeable c) =>
WalletId -> SlotNo -> SeqAddressMap c key -> SqlPersistT IO ()
insertSeqAddressMap @n WalletId
wid SlotNo
sl SeqAddressMap 'UtxoInternal key
ints
        WalletId
-> SlotNo -> SeqAddressMap 'UtxoExternal key -> SqlPersistT IO ()
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(PaymentAddress n key, Typeable c) =>
WalletId -> SlotNo -> SeqAddressMap c key -> SqlPersistT IO ()
insertSeqAddressMap @n WalletId
wid SlotNo
sl SeqAddressMap 'UtxoExternal key
exts

    loadPrologue :: WalletId -> SqlPersistT IO (Maybe (Prologue (SeqState n key)))
loadPrologue WalletId
wid = MaybeT (SqlPersistT IO) (Prologue (SeqState n key))
-> SqlPersistT IO (Maybe (Prologue (SeqState n key)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (SqlPersistT IO) (Prologue (SeqState n key))
 -> SqlPersistT IO (Maybe (Prologue (SeqState n key))))
-> MaybeT (SqlPersistT IO) (Prologue (SeqState n key))
-> SqlPersistT IO (Maybe (Prologue (SeqState n key)))
forall a b. (a -> b) -> a -> b
$ do
        Entity SeqState
st <- ReaderT SqlBackend IO (Maybe (Entity SeqState))
-> MaybeT (SqlPersistT IO) (Entity SeqState)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT SqlBackend IO (Maybe (Entity SeqState))
 -> MaybeT (SqlPersistT IO) (Entity SeqState))
-> ReaderT SqlBackend IO (Maybe (Entity SeqState))
-> MaybeT (SqlPersistT IO) (Entity SeqState)
forall a b. (a -> b) -> a -> b
$ [Filter SeqState]
-> [SelectOpt SeqState]
-> ReaderT SqlBackend IO (Maybe (Entity SeqState))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [EntityField SeqState WalletId
forall typ. (typ ~ WalletId) => EntityField SeqState typ
SeqStateWalletId EntityField SeqState WalletId -> WalletId -> Filter SeqState
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid] []
        let SeqState WalletId
_ AddressPoolGap
eGap AddressPoolGap
iGap ByteString
accountBytes Maybe ByteString
policyBytes ByteString
rewardBytes DerivationPrefix
prefix =
                Entity SeqState -> SeqState
forall record. Entity record -> record
entityVal Entity SeqState
st
        let accountXPub :: key 'AccountK XPub
accountXPub = ByteString -> key 'AccountK XPub
forall (key :: * -> *).
PersistPublicKey key =>
ByteString -> key XPub
unsafeDeserializeXPub ByteString
accountBytes
        let rewardXPub :: key 'AddressK XPub
rewardXPub = ByteString -> key 'AddressK XPub
forall (key :: * -> *).
PersistPublicKey key =>
ByteString -> key XPub
unsafeDeserializeXPub ByteString
rewardBytes
        let policyXPub :: Maybe (key 'PolicyK XPub)
policyXPub = ByteString -> key 'PolicyK XPub
forall (key :: * -> *).
PersistPublicKey key =>
ByteString -> key XPub
unsafeDeserializeXPub (ByteString -> key 'PolicyK XPub)
-> Maybe ByteString -> Maybe (key 'PolicyK XPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
policyBytes
        let intPool :: SeqAddressPool 'UtxoInternal key
intPool = key 'AccountK XPub
-> AddressPoolGap -> SeqAddressPool 'UtxoInternal key
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(SupportsDiscovery n key, Typeable c) =>
key 'AccountK XPub -> AddressPoolGap -> SeqAddressPool c key
Seq.newSeqAddressPool @n key 'AccountK XPub
accountXPub AddressPoolGap
iGap
        let extPool :: SeqAddressPool 'UtxoExternal key
extPool = key 'AccountK XPub
-> AddressPoolGap -> SeqAddressPool 'UtxoExternal key
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(SupportsDiscovery n key, Typeable c) =>
key 'AccountK XPub -> AddressPoolGap -> SeqAddressPool c key
Seq.newSeqAddressPool @n key 'AccountK XPub
accountXPub AddressPoolGap
eGap
        PendingIxs 'AddressK
pendingChangeIxs <- ReaderT SqlBackend IO (PendingIxs 'AddressK)
-> MaybeT (SqlPersistT IO) (PendingIxs 'AddressK)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT SqlBackend IO (PendingIxs 'AddressK)
 -> MaybeT (SqlPersistT IO) (PendingIxs 'AddressK))
-> ReaderT SqlBackend IO (PendingIxs 'AddressK)
-> MaybeT (SqlPersistT IO) (PendingIxs 'AddressK)
forall a b. (a -> b) -> a -> b
$ WalletId -> ReaderT SqlBackend IO (PendingIxs 'AddressK)
selectSeqStatePendingIxs WalletId
wid
        Prologue (SeqState n key)
-> MaybeT (SqlPersistT IO) (Prologue (SeqState n key))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prologue (SeqState n key)
 -> MaybeT (SqlPersistT IO) (Prologue (SeqState n key)))
-> Prologue (SeqState n key)
-> MaybeT (SqlPersistT IO) (Prologue (SeqState n key))
forall a b. (a -> b) -> a -> b
$ SeqState n key -> Prologue (SeqState n key)
forall (n :: NetworkDiscriminant) (key :: Depth -> * -> *).
SeqState n key -> Prologue (SeqState n key)
SeqPrologue (SeqState n key -> Prologue (SeqState n key))
-> SeqState n key -> Prologue (SeqState n key)
forall a b. (a -> b) -> a -> b
$ SeqAddressPool 'UtxoInternal key
-> SeqAddressPool 'UtxoExternal key
-> PendingIxs 'AddressK
-> key 'AccountK XPub
-> Maybe (key 'PolicyK XPub)
-> key 'AddressK XPub
-> DerivationPrefix
-> SeqState n key
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SeqAddressPool 'UtxoInternal k
-> SeqAddressPool 'UtxoExternal k
-> PendingIxs 'AddressK
-> k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> k 'AddressK XPub
-> DerivationPrefix
-> SeqState n k
Seq.SeqState
            SeqAddressPool 'UtxoInternal key
intPool
            SeqAddressPool 'UtxoExternal key
extPool
            PendingIxs 'AddressK
pendingChangeIxs
            key 'AccountK XPub
accountXPub
            Maybe (key 'PolicyK XPub)
policyXPub
            key 'AddressK XPub
rewardXPub
            DerivationPrefix
prefix

    loadDiscoveries :: WalletId -> SlotNo -> SqlPersistT IO (Discoveries (SeqState n key))
loadDiscoveries WalletId
wid SlotNo
sl =
        SeqAddressMap 'UtxoInternal key
-> SeqAddressMap 'UtxoExternal key -> Discoveries (SeqState n key)
forall (n :: NetworkDiscriminant) (key :: Depth -> * -> *).
SeqAddressMap 'UtxoInternal key
-> SeqAddressMap 'UtxoExternal key -> Discoveries (SeqState n key)
SeqDiscoveries
            (SeqAddressMap 'UtxoInternal key
 -> SeqAddressMap 'UtxoExternal key -> Discoveries (SeqState n key))
-> ReaderT SqlBackend IO (SeqAddressMap 'UtxoInternal key)
-> ReaderT
     SqlBackend
     IO
     (SeqAddressMap 'UtxoExternal key -> Discoveries (SeqState n key))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId
-> SlotNo
-> ReaderT SqlBackend IO (SeqAddressMap 'UtxoInternal key)
forall (c :: Role) (key :: Depth -> * -> *).
(MkKeyFingerprint key Address, Typeable c) =>
WalletId -> SlotNo -> SqlPersistT IO (SeqAddressMap c key)
selectSeqAddressMap WalletId
wid SlotNo
sl
            ReaderT
  SqlBackend
  IO
  (SeqAddressMap 'UtxoExternal key -> Discoveries (SeqState n key))
-> ReaderT SqlBackend IO (SeqAddressMap 'UtxoExternal key)
-> SqlPersistT IO (Discoveries (SeqState n key))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WalletId
-> SlotNo
-> ReaderT SqlBackend IO (SeqAddressMap 'UtxoExternal key)
forall (c :: Role) (key :: Depth -> * -> *).
(MkKeyFingerprint key Address, Typeable c) =>
WalletId -> SlotNo -> SqlPersistT IO (SeqAddressMap c key)
selectSeqAddressMap WalletId
wid SlotNo
sl

mkSeqStatePendingIxs :: W.WalletId -> PendingIxs 'AddressK -> [SeqStatePendingIx]
mkSeqStatePendingIxs :: WalletId -> PendingIxs 'AddressK -> [SeqStatePendingIx]
mkSeqStatePendingIxs WalletId
wid =
    (Index 'Soft 'AddressK -> SeqStatePendingIx)
-> [Index 'Soft 'AddressK] -> [SeqStatePendingIx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WalletId -> Word32 -> SeqStatePendingIx
SeqStatePendingIx WalletId
wid (Word32 -> SeqStatePendingIx)
-> (Index 'Soft 'AddressK -> Word32)
-> Index 'Soft 'AddressK
-> SeqStatePendingIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index 'Soft 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
W.getIndex) ([Index 'Soft 'AddressK] -> [SeqStatePendingIx])
-> (PendingIxs 'AddressK -> [Index 'Soft 'AddressK])
-> PendingIxs 'AddressK
-> [SeqStatePendingIx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingIxs 'AddressK -> [Index 'Soft 'AddressK]
forall (k :: Depth). PendingIxs k -> [Index 'Soft k]
pendingIxsToList

selectSeqStatePendingIxs :: W.WalletId -> SqlPersistT IO (PendingIxs 'AddressK)
selectSeqStatePendingIxs :: WalletId -> ReaderT SqlBackend IO (PendingIxs 'AddressK)
selectSeqStatePendingIxs WalletId
wid =
    [Index 'Soft 'AddressK] -> PendingIxs 'AddressK
forall (k :: Depth). [Index 'Soft k] -> PendingIxs k
pendingIxsFromList ([Index 'Soft 'AddressK] -> PendingIxs 'AddressK)
-> ([Entity SeqStatePendingIx] -> [Index 'Soft 'AddressK])
-> [Entity SeqStatePendingIx]
-> PendingIxs 'AddressK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity SeqStatePendingIx] -> [Index 'Soft 'AddressK]
forall (derivationType :: DerivationType) (level :: Depth).
[Entity SeqStatePendingIx] -> [Index derivationType level]
fromRes ([Entity SeqStatePendingIx] -> PendingIxs 'AddressK)
-> ReaderT SqlBackend IO [Entity SeqStatePendingIx]
-> ReaderT SqlBackend IO (PendingIxs 'AddressK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter SeqStatePendingIx]
-> [SelectOpt SeqStatePendingIx]
-> ReaderT SqlBackend IO [Entity SeqStatePendingIx]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
        [EntityField SeqStatePendingIx WalletId
forall typ. (typ ~ WalletId) => EntityField SeqStatePendingIx typ
SeqStatePendingWalletId EntityField SeqStatePendingIx WalletId
-> WalletId -> Filter SeqStatePendingIx
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
        [EntityField SeqStatePendingIx Word32 -> SelectOpt SeqStatePendingIx
forall record typ. EntityField record typ -> SelectOpt record
Desc EntityField SeqStatePendingIx Word32
forall typ. (typ ~ Word32) => EntityField SeqStatePendingIx typ
SeqStatePendingIxIndex]
  where
    fromRes :: [Entity SeqStatePendingIx] -> [Index derivationType level]
fromRes = (Entity SeqStatePendingIx -> Index derivationType level)
-> [Entity SeqStatePendingIx] -> [Index derivationType level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index (Word32 -> Index derivationType level)
-> (Entity SeqStatePendingIx -> Word32)
-> Entity SeqStatePendingIx
-> Index derivationType level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqStatePendingIx -> Word32
seqStatePendingIxIndex (SeqStatePendingIx -> Word32)
-> (Entity SeqStatePendingIx -> SeqStatePendingIx)
-> Entity SeqStatePendingIx
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SeqStatePendingIx -> SeqStatePendingIx
forall record. Entity record -> record
entityVal)

insertSeqAddressMap
    :: forall n c key. (PaymentAddress n key, Typeable c)
    =>  W.WalletId -> W.SlotNo -> SeqAddressMap c key -> SqlPersistT IO ()
insertSeqAddressMap :: WalletId -> SlotNo -> SeqAddressMap c key -> SqlPersistT IO ()
insertSeqAddressMap WalletId
wid SlotNo
sl (SeqAddressMap Map
  (KeyFingerprint "payment" key)
  (Index 'Soft 'AddressK, AddressState)
pool) = SqlPersistT IO () -> SqlPersistT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SqlPersistT IO () -> SqlPersistT IO ())
-> SqlPersistT IO () -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$
    ([SeqStateAddress] -> SqlPersistT IO ())
-> [SeqStateAddress] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [SeqStateAddress] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
        [ WalletId
-> SlotNo
-> Address
-> Word32
-> Role
-> AddressState
-> SeqStateAddress
SeqStateAddress WalletId
wid SlotNo
sl (KeyFingerprint "payment" key -> Address
forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
PaymentAddress network key =>
KeyFingerprint "payment" key -> Address
liftPaymentAddress @n KeyFingerprint "payment" key
addr)
            (Index 'Soft 'AddressK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
W.getIndex Index 'Soft 'AddressK
ix) (Typeable c => Role
forall (c :: Role). Typeable c => Role
roleVal @c) AddressState
status
        | (KeyFingerprint "payment" key
addr, (Index 'Soft 'AddressK
ix, AddressState
status)) <- Map
  (KeyFingerprint "payment" key)
  (Index 'Soft 'AddressK, AddressState)
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'AddressK, AddressState))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  (KeyFingerprint "payment" key)
  (Index 'Soft 'AddressK, AddressState)
pool
        ]

-- MkKeyFingerprint key (Proxy n, key 'AddressK XPub)
selectSeqAddressMap :: forall (c :: Role) key.
    ( MkKeyFingerprint key W.Address
    , Typeable c
    ) => W.WalletId -> W.SlotNo -> SqlPersistT IO (SeqAddressMap c key)
selectSeqAddressMap :: WalletId -> SlotNo -> SqlPersistT IO (SeqAddressMap c key)
selectSeqAddressMap WalletId
wid SlotNo
sl = do
    Map
  (KeyFingerprint "payment" key)
  (Index 'Soft 'AddressK, AddressState)
-> SeqAddressMap c key
forall (c :: Role) (key :: Depth -> * -> *).
Map
  (KeyFingerprint "payment" key)
  (Index 'Soft 'AddressK, AddressState)
-> SeqAddressMap c key
SeqAddressMap (Map
   (KeyFingerprint "payment" key)
   (Index 'Soft 'AddressK, AddressState)
 -> SeqAddressMap c key)
-> ([Entity SeqStateAddress]
    -> Map
         (KeyFingerprint "payment" key)
         (Index 'Soft 'AddressK, AddressState))
-> [Entity SeqStateAddress]
-> SeqAddressMap c key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyFingerprint "payment" key,
  (Index 'Soft 'AddressK, AddressState))]
-> Map
     (KeyFingerprint "payment" key)
     (Index 'Soft 'AddressK, AddressState)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyFingerprint "payment" key,
   (Index 'Soft 'AddressK, AddressState))]
 -> Map
      (KeyFingerprint "payment" key)
      (Index 'Soft 'AddressK, AddressState))
-> ([Entity SeqStateAddress]
    -> [(KeyFingerprint "payment" key,
         (Index 'Soft 'AddressK, AddressState))])
-> [Entity SeqStateAddress]
-> Map
     (KeyFingerprint "payment" key)
     (Index 'Soft 'AddressK, AddressState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity SeqStateAddress
 -> (KeyFingerprint "payment" key,
     (Index 'Soft 'AddressK, AddressState)))
-> [Entity SeqStateAddress]
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'AddressK, AddressState))]
forall a b. (a -> b) -> [a] -> [b]
map (SeqStateAddress
-> (KeyFingerprint "payment" key,
    (Index 'Soft 'AddressK, AddressState))
toTriple (SeqStateAddress
 -> (KeyFingerprint "payment" key,
     (Index 'Soft 'AddressK, AddressState)))
-> (Entity SeqStateAddress -> SeqStateAddress)
-> Entity SeqStateAddress
-> (KeyFingerprint "payment" key,
    (Index 'Soft 'AddressK, AddressState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SeqStateAddress -> SeqStateAddress
forall record. Entity record -> record
entityVal) ([Entity SeqStateAddress] -> SeqAddressMap c key)
-> ReaderT SqlBackend IO [Entity SeqStateAddress]
-> SqlPersistT IO (SeqAddressMap c key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter SeqStateAddress]
-> [SelectOpt SeqStateAddress]
-> ReaderT SqlBackend IO [Entity SeqStateAddress]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
        [ EntityField SeqStateAddress WalletId
forall typ. (typ ~ WalletId) => EntityField SeqStateAddress typ
SeqStateAddressWalletId EntityField SeqStateAddress WalletId
-> WalletId -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
        , EntityField SeqStateAddress SlotNo
forall typ. (typ ~ SlotNo) => EntityField SeqStateAddress typ
SeqStateAddressSlot EntityField SeqStateAddress SlotNo
-> SlotNo -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SlotNo
sl
        , EntityField SeqStateAddress Role
forall typ. (typ ~ Role) => EntityField SeqStateAddress typ
SeqStateAddressRole EntityField SeqStateAddress Role -> Role -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Typeable c => Role
forall (c :: Role). Typeable c => Role
roleVal @c
        ] [EntityField SeqStateAddress Word32 -> SelectOpt SeqStateAddress
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField SeqStateAddress Word32
forall typ. (typ ~ Word32) => EntityField SeqStateAddress typ
SeqStateAddressIndex]
  where
    toTriple :: SeqStateAddress
-> (KeyFingerprint "payment" key,
    (Index 'Soft 'AddressK, AddressState))
toTriple SeqStateAddress
x =
        ( Address -> KeyFingerprint "payment" key
forall (k :: Depth -> * -> *) from.
(HasCallStack, MkKeyFingerprint k from) =>
from -> KeyFingerprint "payment" k
Seq.unsafePaymentKeyFingerprint @key (SeqStateAddress -> Address
seqStateAddressAddress SeqStateAddress
x)
        ,   ( Int -> Index 'Soft 'AddressK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'Soft 'AddressK) -> Int -> Index 'Soft 'AddressK
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ SeqStateAddress -> Word32
seqStateAddressIndex SeqStateAddress
x
            , SeqStateAddress -> AddressState
seqStateAddressStatus SeqStateAddress
x
            )
        )

{-------------------------------------------------------------------------------
    Shared key address book storage
-------------------------------------------------------------------------------}
instance
    ( PersistPublicKey (key 'AccountK)
    , Shared.SupportsDiscovery n key
    , WalletKey key
    , key ~ SharedKey
    ) => PersistAddressBook (Shared.SharedState n key) where

    insertPrologue :: WalletId -> Prologue (SharedState n key) -> SqlPersistT IO ()
insertPrologue WalletId
wid (SharedPrologue st) = do
        let Shared.SharedState DerivationPrefix
prefix key 'AccountK XPub
accXPub ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM AddressPoolGap
gap Readiness (SharedAddressPools key)
readiness = SharedState n key
st
        DerivationPrefix
-> key 'AccountK XPub
-> AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SqlPersistT IO ()
insertSharedState DerivationPrefix
prefix key 'AccountK XPub
accXPub AddressPoolGap
gap ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM
        Map Cosigner XPub -> CredentialType -> SqlPersistT IO ()
insertCosigner (ScriptTemplate -> Map Cosigner XPub
cosigners ScriptTemplate
pTemplate) CredentialType
Payment
        Bool -> SqlPersistT IO () -> SqlPersistT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ScriptTemplate -> Bool
forall a. Maybe a -> Bool
isJust Maybe ScriptTemplate
dTemplateM) (SqlPersistT IO () -> SqlPersistT IO ())
-> SqlPersistT IO () -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$
            Map Cosigner XPub -> CredentialType -> SqlPersistT IO ()
insertCosigner (Maybe (Map Cosigner XPub) -> Map Cosigner XPub
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Map Cosigner XPub) -> Map Cosigner XPub)
-> Maybe (Map Cosigner XPub) -> Map Cosigner XPub
forall a b. (a -> b) -> a -> b
$ ScriptTemplate -> Map Cosigner XPub
cosigners (ScriptTemplate -> Map Cosigner XPub)
-> Maybe ScriptTemplate -> Maybe (Map Cosigner XPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptTemplate
dTemplateM) CredentialType
Delegation
        Bool -> SqlPersistT IO () -> SqlPersistT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Readiness (SharedAddressPools key)
forall a. Readiness a
Shared.Pending Readiness (SharedAddressPools key)
-> Readiness (SharedAddressPools key) -> Bool
forall a. Eq a => a -> a -> Bool
== Readiness (SharedAddressPools key)
readiness) (SqlPersistT IO () -> SqlPersistT IO ())
-> SqlPersistT IO () -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ do
            let (Shared.Active (Shared.SharedAddressPools SharedAddressPool 'UtxoExternal key
_ SharedAddressPool 'UtxoInternal key
_ PendingIxs 'ScriptK
pendingIxs)) =
                    Readiness (SharedAddressPools key)
readiness
            [Filter SharedStatePendingIx] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField SharedStatePendingIx WalletId
forall typ.
(typ ~ WalletId) =>
EntityField SharedStatePendingIx typ
SharedStatePendingWalletId EntityField SharedStatePendingIx WalletId
-> WalletId -> Filter SharedStatePendingIx
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
            ([SharedStatePendingIx] -> SqlPersistT IO ())
-> [SharedStatePendingIx] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [SharedStatePendingIx] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ (PendingIxs 'ScriptK -> [SharedStatePendingIx]
mkSharedStatePendingIxs PendingIxs 'ScriptK
pendingIxs)
      where
        insertSharedState :: DerivationPrefix
-> key 'AccountK XPub
-> AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SqlPersistT IO ()
insertSharedState DerivationPrefix
prefix key 'AccountK XPub
accXPub AddressPoolGap
gap ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM = do
            [Filter SharedState] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField SharedState WalletId
forall typ. (typ ~ WalletId) => EntityField SharedState typ
SharedStateWalletId EntityField SharedState WalletId -> WalletId -> Filter SharedState
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
            SharedState -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (SharedState -> SqlPersistT IO ())
-> SharedState -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ SharedState :: WalletId
-> ByteString
-> AddressPoolGap
-> Script Cosigner
-> Maybe (Script Cosigner)
-> DerivationPrefix
-> SharedState
SharedState
                { sharedStateWalletId :: WalletId
sharedStateWalletId = WalletId
wid
                , sharedStateAccountXPub :: ByteString
sharedStateAccountXPub = key 'AccountK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub key 'AccountK XPub
accXPub
                , sharedStateScriptGap :: AddressPoolGap
sharedStateScriptGap = AddressPoolGap
gap
                , sharedStatePaymentScript :: Script Cosigner
sharedStatePaymentScript = ScriptTemplate -> Script Cosigner
template ScriptTemplate
pTemplate
                , sharedStateDelegationScript :: Maybe (Script Cosigner)
sharedStateDelegationScript = ScriptTemplate -> Script Cosigner
template (ScriptTemplate -> Script Cosigner)
-> Maybe ScriptTemplate -> Maybe (Script Cosigner)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptTemplate
dTemplateM
                , sharedStateDerivationPrefix :: DerivationPrefix
sharedStateDerivationPrefix = DerivationPrefix
prefix
                }

        insertCosigner :: Map Cosigner XPub -> CredentialType -> SqlPersistT IO ()
insertCosigner Map Cosigner XPub
cs CredentialType
cred = do
            [Filter CosignerKey] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField CosignerKey WalletId
forall typ. (typ ~ WalletId) => EntityField CosignerKey typ
CosignerKeyWalletId EntityField CosignerKey WalletId -> WalletId -> Filter CosignerKey
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid, EntityField CosignerKey CredentialType
forall typ. (typ ~ CredentialType) => EntityField CosignerKey typ
CosignerKeyCredential EntityField CosignerKey CredentialType
-> CredentialType -> Filter CosignerKey
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. CredentialType
cred]
            ([CosignerKey] -> SqlPersistT IO ())
-> [CosignerKey] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [CosignerKey] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
                [ WalletId -> CredentialType -> ByteString -> Word8 -> CosignerKey
CosignerKey WalletId
wid CredentialType
cred (PersistPublicKey (key 'AccountK) =>
key 'AccountK XPub -> ByteString
forall (key :: * -> *).
PersistPublicKey key =>
key XPub -> ByteString
serializeXPub @(key 'AccountK) (key 'AccountK XPub -> ByteString)
-> key 'AccountK XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> key 'AccountK XPub
forall (key :: Depth -> * -> *) raw (depth :: Depth).
WalletKey key =>
raw -> key depth raw
liftRawKey XPub
xpub) Word8
c
                | ((Cosigner Word8
c), XPub
xpub) <- Map Cosigner XPub -> [(Cosigner, XPub)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map Cosigner XPub
cs
                ]

        mkSharedStatePendingIxs :: PendingIxs 'ScriptK -> [SharedStatePendingIx]
        mkSharedStatePendingIxs :: PendingIxs 'ScriptK -> [SharedStatePendingIx]
mkSharedStatePendingIxs =
            (Index 'Soft 'ScriptK -> SharedStatePendingIx)
-> [Index 'Soft 'ScriptK] -> [SharedStatePendingIx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WalletId -> Word32 -> SharedStatePendingIx
SharedStatePendingIx WalletId
wid (Word32 -> SharedStatePendingIx)
-> (Index 'Soft 'ScriptK -> Word32)
-> Index 'Soft 'ScriptK
-> SharedStatePendingIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index 'Soft 'ScriptK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
W.getIndex) ([Index 'Soft 'ScriptK] -> [SharedStatePendingIx])
-> (PendingIxs 'ScriptK -> [Index 'Soft 'ScriptK])
-> PendingIxs 'ScriptK
-> [SharedStatePendingIx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingIxs 'ScriptK -> [Index 'Soft 'ScriptK]
forall (k :: Depth). PendingIxs k -> [Index 'Soft k]
pendingIxsToList

    insertDiscoveries :: WalletId
-> SlotNo -> Discoveries (SharedState n key) -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl Discoveries (SharedState n key)
sharedDiscoveries = do
        ([SeqStateAddress] -> SqlPersistT IO ())
-> [SeqStateAddress] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [SeqStateAddress] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
            [ WalletId
-> SlotNo
-> Address
-> Word32
-> Role
-> AddressState
-> SeqStateAddress
SeqStateAddress WalletId
wid SlotNo
sl Address
addr Word32
ix Role
UtxoExternal AddressState
status
            | (Word32
ix, Address
addr, AddressState
status) <- ((KeyFingerprint "payment" key,
  (Index 'Soft 'ScriptK, AddressState))
 -> (Word32, Address, AddressState))
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'ScriptK, AddressState))]
-> [(Word32, Address, AddressState)]
forall a b. (a -> b) -> [a] -> [b]
map (KeyFingerprint "payment" key,
 (Index 'Soft 'ScriptK, AddressState))
-> (Word32, Address, AddressState)
convert ([(KeyFingerprint "payment" key,
   (Index 'Soft 'ScriptK, AddressState))]
 -> [(Word32, Address, AddressState)])
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'ScriptK, AddressState))]
-> [(Word32, Address, AddressState)]
forall a b. (a -> b) -> a -> b
$ Map
  (KeyFingerprint "payment" key) (Index 'Soft 'ScriptK, AddressState)
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'ScriptK, AddressState))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  (KeyFingerprint "payment" key) (Index 'Soft 'ScriptK, AddressState)
extAddrs
            ]
        ([SeqStateAddress] -> SqlPersistT IO ())
-> [SeqStateAddress] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [SeqStateAddress] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
            [ WalletId
-> SlotNo
-> Address
-> Word32
-> Role
-> AddressState
-> SeqStateAddress
SeqStateAddress WalletId
wid SlotNo
sl Address
addr Word32
ix Role
UtxoInternal AddressState
status
            | (Word32
ix, Address
addr, AddressState
status) <- ((KeyFingerprint "payment" key,
  (Index 'Soft 'ScriptK, AddressState))
 -> (Word32, Address, AddressState))
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'ScriptK, AddressState))]
-> [(Word32, Address, AddressState)]
forall a b. (a -> b) -> [a] -> [b]
map (KeyFingerprint "payment" key,
 (Index 'Soft 'ScriptK, AddressState))
-> (Word32, Address, AddressState)
convert ([(KeyFingerprint "payment" key,
   (Index 'Soft 'ScriptK, AddressState))]
 -> [(Word32, Address, AddressState)])
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'ScriptK, AddressState))]
-> [(Word32, Address, AddressState)]
forall a b. (a -> b) -> a -> b
$ Map
  (KeyFingerprint "payment" key) (Index 'Soft 'ScriptK, AddressState)
-> [(KeyFingerprint "payment" key,
     (Index 'Soft 'ScriptK, AddressState))]
forall k a. Map k a -> [(k, a)]
Map.toList Map
  (KeyFingerprint "payment" key) (Index 'Soft 'ScriptK, AddressState)
intAddrs
            ]
      where
        SharedDiscoveries (SharedAddressMap extAddrs) (SharedAddressMap intAddrs) =
            Discoveries (SharedState n key)
sharedDiscoveries
        convert :: (KeyFingerprint "payment" key,
 (Index 'Soft 'ScriptK, AddressState))
-> (Word32, Address, AddressState)
convert (KeyFingerprint "payment" key
addr,(Index 'Soft 'ScriptK
ix,AddressState
status)) =
            (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Index 'Soft 'ScriptK -> Int
forall a. Enum a => a -> Int
fromEnum Index 'Soft 'ScriptK
ix, KeyFingerprint "payment" key -> Address
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
Typeable n =>
KeyFingerprint "payment" k -> Address
Shared.liftPaymentAddress @n KeyFingerprint "payment" key
addr, AddressState
status)

    loadPrologue :: WalletId -> SqlPersistT IO (Maybe (Prologue (SharedState n key)))
loadPrologue WalletId
wid = MaybeT (SqlPersistT IO) (Prologue (SharedState n key))
-> SqlPersistT IO (Maybe (Prologue (SharedState n key)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (SqlPersistT IO) (Prologue (SharedState n key))
 -> SqlPersistT IO (Maybe (Prologue (SharedState n key))))
-> MaybeT (SqlPersistT IO) (Prologue (SharedState n key))
-> SqlPersistT IO (Maybe (Prologue (SharedState n key)))
forall a b. (a -> b) -> a -> b
$ do
        Entity SharedState
st <- ReaderT SqlBackend IO (Maybe (Entity SharedState))
-> MaybeT (SqlPersistT IO) (Entity SharedState)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT SqlBackend IO (Maybe (Entity SharedState))
 -> MaybeT (SqlPersistT IO) (Entity SharedState))
-> ReaderT SqlBackend IO (Maybe (Entity SharedState))
-> MaybeT (SqlPersistT IO) (Entity SharedState)
forall a b. (a -> b) -> a -> b
$ [Filter SharedState]
-> [SelectOpt SharedState]
-> ReaderT SqlBackend IO (Maybe (Entity SharedState))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [EntityField SharedState WalletId
forall typ. (typ ~ WalletId) => EntityField SharedState typ
SharedStateWalletId EntityField SharedState WalletId -> WalletId -> Filter SharedState
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid] []
        let SharedState WalletId
_ ByteString
accountBytes AddressPoolGap
gap Script Cosigner
pScript Maybe (Script Cosigner)
dScriptM DerivationPrefix
prefix = Entity SharedState -> SharedState
forall record. Entity record -> record
entityVal Entity SharedState
st
        let accXPub :: key 'AccountK XPub
accXPub = ByteString -> key 'AccountK XPub
forall (key :: * -> *).
PersistPublicKey key =>
ByteString -> key XPub
unsafeDeserializeXPub ByteString
accountBytes
        [(Cosigner, key 'AccountK XPub)]
pCosigners <- ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
-> MaybeT (SqlPersistT IO) [(Cosigner, key 'AccountK XPub)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
 -> MaybeT (SqlPersistT IO) [(Cosigner, key 'AccountK XPub)])
-> ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
-> MaybeT (SqlPersistT IO) [(Cosigner, key 'AccountK XPub)]
forall a b. (a -> b) -> a -> b
$ WalletId
-> CredentialType
-> ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
forall (k :: Depth -> * -> *).
PersistPublicKey (k 'AccountK) =>
WalletId
-> CredentialType -> SqlPersistT IO [(Cosigner, k 'AccountK XPub)]
selectCosigners @key WalletId
wid CredentialType
Payment
        [(Cosigner, key 'AccountK XPub)]
dCosigners <- ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
-> MaybeT (SqlPersistT IO) [(Cosigner, key 'AccountK XPub)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
 -> MaybeT (SqlPersistT IO) [(Cosigner, key 'AccountK XPub)])
-> ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
-> MaybeT (SqlPersistT IO) [(Cosigner, key 'AccountK XPub)]
forall a b. (a -> b) -> a -> b
$ WalletId
-> CredentialType
-> ReaderT SqlBackend IO [(Cosigner, key 'AccountK XPub)]
forall (k :: Depth -> * -> *).
PersistPublicKey (k 'AccountK) =>
WalletId
-> CredentialType -> SqlPersistT IO [(Cosigner, k 'AccountK XPub)]
selectCosigners @key WalletId
wid CredentialType
Delegation

        let prepareKeys :: [(a, key depth c)] -> [(a, c)]
prepareKeys = ((a, key depth c) -> (a, c)) -> [(a, key depth c)] -> [(a, c)]
forall a b. (a -> b) -> [a] -> [b]
map ((key depth c -> c) -> (a, key depth c) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second key depth c -> c
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey)
            pTemplate :: ScriptTemplate
pTemplate = Map Cosigner XPub -> Script Cosigner -> ScriptTemplate
ScriptTemplate ([(Cosigner, XPub)] -> Map Cosigner XPub
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Cosigner, XPub)] -> Map Cosigner XPub)
-> [(Cosigner, XPub)] -> Map Cosigner XPub
forall a b. (a -> b) -> a -> b
$ [(Cosigner, key 'AccountK XPub)] -> [(Cosigner, XPub)]
forall a (depth :: Depth) c. [(a, key depth c)] -> [(a, c)]
prepareKeys [(Cosigner, key 'AccountK XPub)]
pCosigners) Script Cosigner
pScript
            dTemplateM :: Maybe ScriptTemplate
dTemplateM = Map Cosigner XPub -> Script Cosigner -> ScriptTemplate
ScriptTemplate ([(Cosigner, XPub)] -> Map Cosigner XPub
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Cosigner, XPub)] -> Map Cosigner XPub)
-> [(Cosigner, XPub)] -> Map Cosigner XPub
forall a b. (a -> b) -> a -> b
$ [(Cosigner, key 'AccountK XPub)] -> [(Cosigner, XPub)]
forall a (depth :: Depth) c. [(a, key depth c)] -> [(a, c)]
prepareKeys [(Cosigner, key 'AccountK XPub)]
dCosigners) (Script Cosigner -> ScriptTemplate)
-> Maybe (Script Cosigner) -> Maybe ScriptTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Script Cosigner)
dScriptM
            mkSharedState :: Readiness (SharedAddressPools key) -> SharedState n key
mkSharedState = DerivationPrefix
-> key 'AccountK XPub
-> ScriptTemplate
-> Maybe ScriptTemplate
-> AddressPoolGap
-> Readiness (SharedAddressPools key)
-> SharedState n key
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
DerivationPrefix
-> k 'AccountK XPub
-> ScriptTemplate
-> Maybe ScriptTemplate
-> AddressPoolGap
-> Readiness (SharedAddressPools k)
-> SharedState n k
Shared.SharedState DerivationPrefix
prefix key 'AccountK XPub
accXPub ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM AddressPoolGap
gap
        PendingIxs 'ScriptK
pendingIxs <- ReaderT SqlBackend IO (PendingIxs 'ScriptK)
-> MaybeT (SqlPersistT IO) (PendingIxs 'ScriptK)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT SqlBackend IO (PendingIxs 'ScriptK)
selectSharedStatePendingIxs
        SharedState n key
prologue <- ReaderT SqlBackend IO (SharedState n key)
-> MaybeT (SqlPersistT IO) (SharedState n key)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT SqlBackend IO (SharedState n key)
 -> MaybeT (SqlPersistT IO) (SharedState n key))
-> ReaderT SqlBackend IO (SharedState n key)
-> MaybeT (SqlPersistT IO) (SharedState n key)
forall a b. (a -> b) -> a -> b
$ WalletId -> SqlPersistT IO Bool
multisigPoolAbsent WalletId
wid SqlPersistT IO Bool
-> (Bool -> SharedState n key)
-> ReaderT SqlBackend IO (SharedState n key)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Bool
True ->  Readiness (SharedAddressPools key) -> SharedState n key
mkSharedState Readiness (SharedAddressPools key)
forall a. Readiness a
Shared.Pending
            Bool
False -> Readiness (SharedAddressPools key) -> SharedState n key
mkSharedState (Readiness (SharedAddressPools key) -> SharedState n key)
-> Readiness (SharedAddressPools key) -> SharedState n key
forall a b. (a -> b) -> a -> b
$ SharedAddressPools key -> Readiness (SharedAddressPools key)
forall a. a -> Readiness a
Shared.Active (SharedAddressPools key -> Readiness (SharedAddressPools key))
-> SharedAddressPools key -> Readiness (SharedAddressPools key)
forall a b. (a -> b) -> a -> b
$ SharedAddressPool 'UtxoExternal key
-> SharedAddressPool 'UtxoInternal key
-> PendingIxs 'ScriptK
-> SharedAddressPools key
forall (key :: Depth -> * -> *).
SharedAddressPool 'UtxoExternal key
-> SharedAddressPool 'UtxoInternal key
-> PendingIxs 'ScriptK
-> SharedAddressPools key
Shared.SharedAddressPools
                (AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedAddressPool 'UtxoExternal key
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(key ~ SharedKey, SupportsDiscovery n key, Typeable c) =>
AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedAddressPool c key
Shared.newSharedAddressPool @n @'UtxoExternal AddressPoolGap
gap ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM)
                (AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedAddressPool 'UtxoInternal key
forall (n :: NetworkDiscriminant) (c :: Role)
       (key :: Depth -> * -> *).
(key ~ SharedKey, SupportsDiscovery n key, Typeable c) =>
AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedAddressPool c key
Shared.newSharedAddressPool @n @'UtxoInternal AddressPoolGap
gap ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM)
                PendingIxs 'ScriptK
pendingIxs
        Prologue (SharedState n key)
-> MaybeT (SqlPersistT IO) (Prologue (SharedState n key))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prologue (SharedState n key)
 -> MaybeT (SqlPersistT IO) (Prologue (SharedState n key)))
-> Prologue (SharedState n key)
-> MaybeT (SqlPersistT IO) (Prologue (SharedState n key))
forall a b. (a -> b) -> a -> b
$ SharedState n key -> Prologue (SharedState n key)
forall (n :: NetworkDiscriminant) (key :: Depth -> * -> *).
SharedState n key -> Prologue (SharedState n key)
SharedPrologue SharedState n key
prologue
      where
        selectSharedStatePendingIxs :: SqlPersistT IO (PendingIxs 'ScriptK)
        selectSharedStatePendingIxs :: ReaderT SqlBackend IO (PendingIxs 'ScriptK)
selectSharedStatePendingIxs =
            [Index 'Soft 'ScriptK] -> PendingIxs 'ScriptK
forall (k :: Depth). [Index 'Soft k] -> PendingIxs k
pendingIxsFromList ([Index 'Soft 'ScriptK] -> PendingIxs 'ScriptK)
-> ([Entity SharedStatePendingIx] -> [Index 'Soft 'ScriptK])
-> [Entity SharedStatePendingIx]
-> PendingIxs 'ScriptK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entity SharedStatePendingIx] -> [Index 'Soft 'ScriptK]
forall (derivationType :: DerivationType) (level :: Depth).
[Entity SharedStatePendingIx] -> [Index derivationType level]
fromRes ([Entity SharedStatePendingIx] -> PendingIxs 'ScriptK)
-> ReaderT SqlBackend IO [Entity SharedStatePendingIx]
-> ReaderT SqlBackend IO (PendingIxs 'ScriptK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter SharedStatePendingIx]
-> [SelectOpt SharedStatePendingIx]
-> ReaderT SqlBackend IO [Entity SharedStatePendingIx]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
                [EntityField SharedStatePendingIx WalletId
forall typ.
(typ ~ WalletId) =>
EntityField SharedStatePendingIx typ
SharedStatePendingWalletId EntityField SharedStatePendingIx WalletId
-> WalletId -> Filter SharedStatePendingIx
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
                [EntityField SharedStatePendingIx Word32
-> SelectOpt SharedStatePendingIx
forall record typ. EntityField record typ -> SelectOpt record
Desc EntityField SharedStatePendingIx Word32
forall typ. (typ ~ Word32) => EntityField SharedStatePendingIx typ
SharedStatePendingIxIndex]
          where
              fromRes :: [Entity SharedStatePendingIx] -> [Index derivationType level]
fromRes = (Entity SharedStatePendingIx -> Index derivationType level)
-> [Entity SharedStatePendingIx] -> [Index derivationType level]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index (Word32 -> Index derivationType level)
-> (Entity SharedStatePendingIx -> Word32)
-> Entity SharedStatePendingIx
-> Index derivationType level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedStatePendingIx -> Word32
sharedStatePendingIxIndex (SharedStatePendingIx -> Word32)
-> (Entity SharedStatePendingIx -> SharedStatePendingIx)
-> Entity SharedStatePendingIx
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity SharedStatePendingIx -> SharedStatePendingIx
forall record. Entity record -> record
entityVal)

    loadDiscoveries :: WalletId
-> SlotNo -> SqlPersistT IO (Discoveries (SharedState n key))
loadDiscoveries WalletId
wid SlotNo
sl = do
        SharedAddressMap 'UtxoExternal key
extAddrMap <- forall (c :: Role) (k :: Depth -> * -> *).
(MkKeyFingerprint k Address, Typeable c) =>
SqlPersistT IO (SharedAddressMap c k)
forall (k :: Depth -> * -> *).
(MkKeyFingerprint k Address, Typeable 'UtxoExternal) =>
SqlPersistT IO (SharedAddressMap 'UtxoExternal k)
loadAddresses @'UtxoExternal
        SharedAddressMap 'UtxoInternal key
intAddrMap <- forall (c :: Role) (k :: Depth -> * -> *).
(MkKeyFingerprint k Address, Typeable c) =>
SqlPersistT IO (SharedAddressMap c k)
forall (k :: Depth -> * -> *).
(MkKeyFingerprint k Address, Typeable 'UtxoInternal) =>
SqlPersistT IO (SharedAddressMap 'UtxoInternal k)
loadAddresses @'UtxoInternal
        Discoveries (SharedState n key)
-> SqlPersistT IO (Discoveries (SharedState n key))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Discoveries (SharedState n key)
 -> SqlPersistT IO (Discoveries (SharedState n key)))
-> Discoveries (SharedState n key)
-> SqlPersistT IO (Discoveries (SharedState n key))
forall a b. (a -> b) -> a -> b
$ SharedAddressMap 'UtxoExternal key
-> SharedAddressMap 'UtxoInternal key
-> Discoveries (SharedState n key)
forall (n :: NetworkDiscriminant) (key :: Depth -> * -> *).
SharedAddressMap 'UtxoExternal key
-> SharedAddressMap 'UtxoInternal key
-> Discoveries (SharedState n key)
SharedDiscoveries SharedAddressMap 'UtxoExternal key
extAddrMap SharedAddressMap 'UtxoInternal key
intAddrMap
      where
        loadAddresses
            :: forall (c :: Role) (k :: Depth -> Type -> Type).
               ( MkKeyFingerprint k W.Address
               , Typeable c )
            => SqlPersistT IO (SharedAddressMap c k)
        loadAddresses :: SqlPersistT IO (SharedAddressMap c k)
loadAddresses = do
            [SeqStateAddress]
addrs <- (Entity SeqStateAddress -> SeqStateAddress)
-> [Entity SeqStateAddress] -> [SeqStateAddress]
forall a b. (a -> b) -> [a] -> [b]
map Entity SeqStateAddress -> SeqStateAddress
forall record. Entity record -> record
entityVal ([Entity SeqStateAddress] -> [SeqStateAddress])
-> ReaderT SqlBackend IO [Entity SeqStateAddress]
-> ReaderT SqlBackend IO [SeqStateAddress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter SeqStateAddress]
-> [SelectOpt SeqStateAddress]
-> ReaderT SqlBackend IO [Entity SeqStateAddress]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
                [ EntityField SeqStateAddress WalletId
forall typ. (typ ~ WalletId) => EntityField SeqStateAddress typ
SeqStateAddressWalletId EntityField SeqStateAddress WalletId
-> WalletId -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
                , EntityField SeqStateAddress SlotNo
forall typ. (typ ~ SlotNo) => EntityField SeqStateAddress typ
SeqStateAddressSlot EntityField SeqStateAddress SlotNo
-> SlotNo -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SlotNo
sl
                , EntityField SeqStateAddress Role
forall typ. (typ ~ Role) => EntityField SeqStateAddress typ
SeqStateAddressRole EntityField SeqStateAddress Role -> Role -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Typeable c => Role
forall (c :: Role). Typeable c => Role
roleVal @c
                ] [EntityField SeqStateAddress Word32 -> SelectOpt SeqStateAddress
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField SeqStateAddress Word32
forall typ. (typ ~ Word32) => EntityField SeqStateAddress typ
SeqStateAddressIndex]
            SharedAddressMap c k -> SqlPersistT IO (SharedAddressMap c k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SharedAddressMap c k -> SqlPersistT IO (SharedAddressMap c k))
-> SharedAddressMap c k -> SqlPersistT IO (SharedAddressMap c k)
forall a b. (a -> b) -> a -> b
$ Map
  (KeyFingerprint "payment" k) (Index 'Soft 'ScriptK, AddressState)
-> SharedAddressMap c k
forall (c :: Role) (key :: Depth -> * -> *).
Map
  (KeyFingerprint "payment" key) (Index 'Soft 'ScriptK, AddressState)
-> SharedAddressMap c key
SharedAddressMap (Map
   (KeyFingerprint "payment" k) (Index 'Soft 'ScriptK, AddressState)
 -> SharedAddressMap c k)
-> Map
     (KeyFingerprint "payment" k) (Index 'Soft 'ScriptK, AddressState)
-> SharedAddressMap c k
forall a b. (a -> b) -> a -> b
$ [(KeyFingerprint "payment" k,
  (Index 'Soft 'ScriptK, AddressState))]
-> Map
     (KeyFingerprint "payment" k) (Index 'Soft 'ScriptK, AddressState)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (KeyFingerprint "payment" k
fingerprint, (Int -> Index 'Soft 'ScriptK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'Soft 'ScriptK) -> Int -> Index 'Soft 'ScriptK
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix, AddressState
status))
                | SeqStateAddress WalletId
_ SlotNo
_ Address
addr Word32
ix Role
_ AddressState
status <- [SeqStateAddress]
addrs
                , Right KeyFingerprint "payment" k
fingerprint <- [Address
-> Either
     (ErrMkKeyFingerprint k Address) (KeyFingerprint "payment" k)
forall (key :: Depth -> * -> *) from.
MkKeyFingerprint key from =>
from
-> Either
     (ErrMkKeyFingerprint key from) (KeyFingerprint "payment" key)
paymentKeyFingerprint Address
addr]
                ]

selectCosigners
    :: forall k. PersistPublicKey (k 'AccountK)
    => W.WalletId
    -> CredentialType
    -> SqlPersistT IO [(Cosigner, k 'AccountK XPub)]
selectCosigners :: WalletId
-> CredentialType -> SqlPersistT IO [(Cosigner, k 'AccountK XPub)]
selectCosigners WalletId
wid CredentialType
cred = do
    (Entity CosignerKey -> (Cosigner, k 'AccountK XPub))
-> [Entity CosignerKey] -> [(Cosigner, k 'AccountK XPub)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CosignerKey -> (Cosigner, k 'AccountK XPub)
forall (key :: * -> *).
PersistPublicKey key =>
CosignerKey -> (Cosigner, key XPub)
cosignerFromEntity (CosignerKey -> (Cosigner, k 'AccountK XPub))
-> (Entity CosignerKey -> CosignerKey)
-> Entity CosignerKey
-> (Cosigner, k 'AccountK XPub)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity CosignerKey -> CosignerKey
forall record. Entity record -> record
entityVal) ([Entity CosignerKey] -> [(Cosigner, k 'AccountK XPub)])
-> ReaderT SqlBackend IO [Entity CosignerKey]
-> SqlPersistT IO [(Cosigner, k 'AccountK XPub)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter CosignerKey]
-> [SelectOpt CosignerKey]
-> ReaderT SqlBackend IO [Entity CosignerKey]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
        [ EntityField CosignerKey WalletId
forall typ. (typ ~ WalletId) => EntityField CosignerKey typ
CosignerKeyWalletId EntityField CosignerKey WalletId -> WalletId -> Filter CosignerKey
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
        , EntityField CosignerKey CredentialType
forall typ. (typ ~ CredentialType) => EntityField CosignerKey typ
CosignerKeyCredential EntityField CosignerKey CredentialType
-> CredentialType -> Filter CosignerKey
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. CredentialType
cred
        ] []
 where
   cosignerFromEntity :: CosignerKey -> (Cosigner, key XPub)
cosignerFromEntity (CosignerKey WalletId
_ CredentialType
_ ByteString
key Word8
c) =
       (Word8 -> Cosigner
Cosigner Word8
c, ByteString -> key XPub
forall (key :: * -> *).
PersistPublicKey key =>
ByteString -> key XPub
unsafeDeserializeXPub ByteString
key)

-- | Check whether we have ever stored checkpoints for a multi-signature pool
--
-- FIXME during APD-1043:
-- Whether the 'SharedState' is 'Pending' or 'Active' should be apparent
-- from the data in the table corresponding to the 'Prologue'.
-- Testing whether the table corresponding to 'Discoveries' is present
-- or absent is a nice idea, but it ultimately complicates the separation
-- between Prologue and Discoveries.
-- Solution: Add a 'Ready' column in the next version of the database format.
multisigPoolAbsent :: W.WalletId -> SqlPersistT IO Bool
multisigPoolAbsent :: WalletId -> SqlPersistT IO Bool
multisigPoolAbsent WalletId
wid =
    Maybe (Entity SeqStateAddress) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Entity SeqStateAddress) -> Bool)
-> ReaderT SqlBackend IO (Maybe (Entity SeqStateAddress))
-> SqlPersistT IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter SeqStateAddress]
-> [SelectOpt SeqStateAddress]
-> ReaderT SqlBackend IO (Maybe (Entity SeqStateAddress))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
        [ EntityField SeqStateAddress WalletId
forall typ. (typ ~ WalletId) => EntityField SeqStateAddress typ
SeqStateAddressWalletId EntityField SeqStateAddress WalletId
-> WalletId -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
        , EntityField SeqStateAddress Role
forall typ. (typ ~ Role) => EntityField SeqStateAddress typ
SeqStateAddressRole EntityField SeqStateAddress Role -> Role -> Filter SeqStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Role
UtxoExternal
        ] []

{-------------------------------------------------------------------------------
    HD Random address book storage
-------------------------------------------------------------------------------}
-- piggy-back on RndState existing instance, to simulate the same behavior.
instance PersistAddressBook (Rnd.RndAnyState n p)
  where
    insertPrologue :: WalletId -> Prologue (RndAnyState n p) -> SqlPersistT IO ()
insertPrologue WalletId
wid (PR s) = WalletId -> Prologue (RndState n) -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> Prologue s -> SqlPersistT IO ()
insertPrologue WalletId
wid Prologue (RndState n)
s
    insertDiscoveries :: WalletId
-> SlotNo -> Discoveries (RndAnyState n p) -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl (DR s) = WalletId -> SlotNo -> Discoveries (RndState n) -> SqlPersistT IO ()
forall s.
PersistAddressBook s =>
WalletId -> SlotNo -> Discoveries s -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl Discoveries (RndState n)
s
    loadPrologue :: WalletId -> SqlPersistT IO (Maybe (Prologue (RndAnyState n p)))
loadPrologue WalletId
wid = (Prologue (RndState n) -> Prologue (RndAnyState n p))
-> Maybe (Prologue (RndState n))
-> Maybe (Prologue (RndAnyState n p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prologue (RndState n) -> Prologue (RndAnyState n p)
forall (n :: NetworkDiscriminant) (p :: Nat).
Prologue (RndState n) -> Prologue (RndAnyState n p)
PR (Maybe (Prologue (RndState n))
 -> Maybe (Prologue (RndAnyState n p)))
-> ReaderT SqlBackend IO (Maybe (Prologue (RndState n)))
-> SqlPersistT IO (Maybe (Prologue (RndAnyState n p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId -> ReaderT SqlBackend IO (Maybe (Prologue (RndState n)))
forall s.
PersistAddressBook s =>
WalletId -> SqlPersistT IO (Maybe (Prologue s))
loadPrologue WalletId
wid
    loadDiscoveries :: WalletId
-> SlotNo -> SqlPersistT IO (Discoveries (RndAnyState n p))
loadDiscoveries WalletId
wid SlotNo
sl = Discoveries (RndState n) -> Discoveries (RndAnyState n p)
forall (n :: NetworkDiscriminant) (p :: Nat).
Discoveries (RndState n) -> Discoveries (RndAnyState n p)
DR (Discoveries (RndState n) -> Discoveries (RndAnyState n p))
-> ReaderT SqlBackend IO (Discoveries (RndState n))
-> SqlPersistT IO (Discoveries (RndAnyState n p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletId
-> SlotNo -> ReaderT SqlBackend IO (Discoveries (RndState n))
forall s.
PersistAddressBook s =>
WalletId -> SlotNo -> SqlPersistT IO (Discoveries s)
loadDiscoveries WalletId
wid SlotNo
sl

-- | Persisting 'RndState' requires that the wallet root key has already been
-- added to the database with 'putPrivateKey'. Unlike sequential AD, random
-- address discovery requires a root key to recognize addresses.
instance PersistAddressBook (Rnd.RndState n) where
    insertPrologue :: WalletId -> Prologue (RndState n) -> SqlPersistT IO ()
insertPrologue WalletId
wid (RndPrologue st) = do
        let ix :: Word32
ix  = Index 'Hardened 'AccountK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
W.getIndex (RndState n
st RndState n
-> ((Index 'Hardened 'AccountK
     -> Const (Index 'Hardened 'AccountK) (Index 'Hardened 'AccountK))
    -> RndState n -> Const (Index 'Hardened 'AccountK) (RndState n))
-> Index 'Hardened 'AccountK
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "accountIndex"
  ((Index 'Hardened 'AccountK
    -> Const (Index 'Hardened 'AccountK) (Index 'Hardened 'AccountK))
   -> RndState n -> Const (Index 'Hardened 'AccountK) (RndState n))
(Index 'Hardened 'AccountK
 -> Const (Index 'Hardened 'AccountK) (Index 'Hardened 'AccountK))
-> RndState n -> Const (Index 'Hardened 'AccountK) (RndState n)
#accountIndex)
        let gen :: StdGen
gen = RndState n
st RndState n
-> ((StdGen -> Const StdGen StdGen)
    -> RndState n -> Const StdGen (RndState n))
-> StdGen
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "gen"
  ((StdGen -> Const StdGen StdGen)
   -> RndState n -> Const StdGen (RndState n))
(StdGen -> Const StdGen StdGen)
-> RndState n -> Const StdGen (RndState n)
#gen
        let pwd :: Passphrase "addr-derivation-payload"
pwd = RndState n
st RndState n
-> ((Passphrase "addr-derivation-payload"
     -> Const
          (Passphrase "addr-derivation-payload")
          (Passphrase "addr-derivation-payload"))
    -> RndState n
    -> Const (Passphrase "addr-derivation-payload") (RndState n))
-> Passphrase "addr-derivation-payload"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "hdPassphrase"
  ((Passphrase "addr-derivation-payload"
    -> Const
         (Passphrase "addr-derivation-payload")
         (Passphrase "addr-derivation-payload"))
   -> RndState n
   -> Const (Passphrase "addr-derivation-payload") (RndState n))
(Passphrase "addr-derivation-payload"
 -> Const
      (Passphrase "addr-derivation-payload")
      (Passphrase "addr-derivation-payload"))
-> RndState n
-> Const (Passphrase "addr-derivation-payload") (RndState n)
#hdPassphrase
        Key RndState -> RndState -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
repsert (WalletId -> Key RndState
RndStateKey WalletId
wid) (WalletId -> Word32 -> StdGen -> HDPassphrase -> RndState
RndState WalletId
wid Word32
ix StdGen
gen (Passphrase "addr-derivation-payload" -> HDPassphrase
HDPassphrase Passphrase "addr-derivation-payload"
pwd))
        WalletId -> Map DerivationPath Address -> SqlPersistT IO ()
insertRndStatePending WalletId
wid (RndState n
st RndState n
-> ((Map DerivationPath Address
     -> Const (Map DerivationPath Address) (Map DerivationPath Address))
    -> RndState n -> Const (Map DerivationPath Address) (RndState n))
-> Map DerivationPath Address
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "pendingAddresses"
  ((Map DerivationPath Address
    -> Const (Map DerivationPath Address) (Map DerivationPath Address))
   -> RndState n -> Const (Map DerivationPath Address) (RndState n))
(Map DerivationPath Address
 -> Const (Map DerivationPath Address) (Map DerivationPath Address))
-> RndState n -> Const (Map DerivationPath Address) (RndState n)
#pendingAddresses)

    insertDiscoveries :: WalletId -> SlotNo -> Discoveries (RndState n) -> SqlPersistT IO ()
insertDiscoveries WalletId
wid SlotNo
sl (RndDiscoveries addresses) = do
        ([RndStateAddress] -> SqlPersistT IO ())
-> [RndStateAddress] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [RndStateAddress] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
            [ WalletId
-> SlotNo
-> Word32
-> Word32
-> Address
-> AddressState
-> RndStateAddress
RndStateAddress WalletId
wid SlotNo
sl Word32
accIx Word32
addrIx Address
addr AddressState
st
            | ((W.Index Word32
accIx, W.Index Word32
addrIx), (Address
addr, AddressState
st))
                <- Map DerivationPath (Address, AddressState)
-> [(DerivationPath, (Address, AddressState))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map DerivationPath (Address, AddressState)
addresses
            ]

    loadPrologue :: WalletId -> SqlPersistT IO (Maybe (Prologue (RndState n)))
loadPrologue WalletId
wid = MaybeT (SqlPersistT IO) (Prologue (RndState n))
-> SqlPersistT IO (Maybe (Prologue (RndState n)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (SqlPersistT IO) (Prologue (RndState n))
 -> SqlPersistT IO (Maybe (Prologue (RndState n))))
-> MaybeT (SqlPersistT IO) (Prologue (RndState n))
-> SqlPersistT IO (Maybe (Prologue (RndState n)))
forall a b. (a -> b) -> a -> b
$ do
        Entity RndState
st <- ReaderT SqlBackend IO (Maybe (Entity RndState))
-> MaybeT (SqlPersistT IO) (Entity RndState)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT SqlBackend IO (Maybe (Entity RndState))
 -> MaybeT (SqlPersistT IO) (Entity RndState))
-> ReaderT SqlBackend IO (Maybe (Entity RndState))
-> MaybeT (SqlPersistT IO) (Entity RndState)
forall a b. (a -> b) -> a -> b
$ [Filter RndState]
-> [SelectOpt RndState]
-> ReaderT SqlBackend IO (Maybe (Entity RndState))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst
            [ EntityField RndState WalletId
forall typ. (typ ~ WalletId) => EntityField RndState typ
RndStateWalletId EntityField RndState WalletId -> WalletId -> Filter RndState
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
            ] []
        let (RndState WalletId
_ Word32
ix StdGen
gen (HDPassphrase Passphrase "addr-derivation-payload"
pwd)) = Entity RndState -> RndState
forall record. Entity record -> record
entityVal Entity RndState
st
        Map DerivationPath Address
pendingAddresses <- ReaderT SqlBackend IO (Map DerivationPath Address)
-> MaybeT (SqlPersistT IO) (Map DerivationPath Address)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT SqlBackend IO (Map DerivationPath Address)
 -> MaybeT (SqlPersistT IO) (Map DerivationPath Address))
-> ReaderT SqlBackend IO (Map DerivationPath Address)
-> MaybeT (SqlPersistT IO) (Map DerivationPath Address)
forall a b. (a -> b) -> a -> b
$ WalletId -> ReaderT SqlBackend IO (Map DerivationPath Address)
selectRndStatePending WalletId
wid
        Prologue (RndState n)
-> MaybeT (SqlPersistT IO) (Prologue (RndState n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prologue (RndState n)
 -> MaybeT (SqlPersistT IO) (Prologue (RndState n)))
-> Prologue (RndState n)
-> MaybeT (SqlPersistT IO) (Prologue (RndState n))
forall a b. (a -> b) -> a -> b
$ RndState n -> Prologue (RndState n)
forall (n :: NetworkDiscriminant).
RndState n -> Prologue (RndState n)
RndPrologue (RndState n -> Prologue (RndState n))
-> RndState n -> Prologue (RndState n)
forall a b. (a -> b) -> a -> b
$ RndState :: forall (network :: NetworkDiscriminant).
Passphrase "addr-derivation-payload"
-> Index 'Hardened 'AccountK
-> Map DerivationPath (Address, AddressState)
-> Map DerivationPath Address
-> StdGen
-> RndState network
Rnd.RndState
            { hdPassphrase :: Passphrase "addr-derivation-payload"
hdPassphrase = Passphrase "addr-derivation-payload"
pwd
            , accountIndex :: Index 'Hardened 'AccountK
accountIndex = Word32 -> Index 'Hardened 'AccountK
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index Word32
ix
            , discoveredAddresses :: Map DerivationPath (Address, AddressState)
discoveredAddresses = Map DerivationPath (Address, AddressState)
forall k a. Map k a
Map.empty
            , pendingAddresses :: Map DerivationPath Address
pendingAddresses = Map DerivationPath Address
pendingAddresses
            , gen :: StdGen
gen = StdGen
gen
            }

    loadDiscoveries :: WalletId -> SlotNo -> SqlPersistT IO (Discoveries (RndState n))
loadDiscoveries WalletId
wid SlotNo
sl = do
        [(DerivationPath, (Address, AddressState))]
addrs <- (Entity RndStateAddress
 -> (DerivationPath, (Address, AddressState)))
-> [Entity RndStateAddress]
-> [(DerivationPath, (Address, AddressState))]
forall a b. (a -> b) -> [a] -> [b]
map (RndStateAddress -> (DerivationPath, (Address, AddressState))
forall (derivationType :: DerivationType) (level :: Depth)
       (derivationType :: DerivationType) (level :: Depth).
RndStateAddress
-> ((Index derivationType level, Index derivationType level),
    (Address, AddressState))
assocFromEntity (RndStateAddress -> (DerivationPath, (Address, AddressState)))
-> (Entity RndStateAddress -> RndStateAddress)
-> Entity RndStateAddress
-> (DerivationPath, (Address, AddressState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity RndStateAddress -> RndStateAddress
forall record. Entity record -> record
entityVal) ([Entity RndStateAddress]
 -> [(DerivationPath, (Address, AddressState))])
-> ReaderT SqlBackend IO [Entity RndStateAddress]
-> ReaderT
     SqlBackend IO [(DerivationPath, (Address, AddressState))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter RndStateAddress]
-> [SelectOpt RndStateAddress]
-> ReaderT SqlBackend IO [Entity RndStateAddress]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
            [ EntityField RndStateAddress WalletId
forall typ. (typ ~ WalletId) => EntityField RndStateAddress typ
RndStateAddressWalletId EntityField RndStateAddress WalletId
-> WalletId -> Filter RndStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
            , EntityField RndStateAddress SlotNo
forall typ. (typ ~ SlotNo) => EntityField RndStateAddress typ
RndStateAddressSlot EntityField RndStateAddress SlotNo
-> SlotNo -> Filter RndStateAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. SlotNo
sl
            ] []
        Discoveries (RndState n)
-> SqlPersistT IO (Discoveries (RndState n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Discoveries (RndState n)
 -> SqlPersistT IO (Discoveries (RndState n)))
-> Discoveries (RndState n)
-> SqlPersistT IO (Discoveries (RndState n))
forall a b. (a -> b) -> a -> b
$ Map DerivationPath (Address, AddressState)
-> Discoveries (RndState n)
forall (n :: NetworkDiscriminant).
Map DerivationPath (Address, AddressState)
-> Discoveries (RndState n)
RndDiscoveries (Map DerivationPath (Address, AddressState)
 -> Discoveries (RndState n))
-> Map DerivationPath (Address, AddressState)
-> Discoveries (RndState n)
forall a b. (a -> b) -> a -> b
$ [(DerivationPath, (Address, AddressState))]
-> Map DerivationPath (Address, AddressState)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(DerivationPath, (Address, AddressState))]
addrs
      where
        assocFromEntity :: RndStateAddress
-> ((Index derivationType level, Index derivationType level),
    (Address, AddressState))
assocFromEntity (RndStateAddress WalletId
_ SlotNo
_ Word32
accIx Word32
addrIx Address
addr AddressState
st) =
            ((Word32 -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index Word32
accIx, Word32 -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index Word32
addrIx), (Address
addr, AddressState
st))

insertRndStatePending
    :: W.WalletId
    -> Map Rnd.DerivationPath W.Address
    -> SqlPersistT IO ()
insertRndStatePending :: WalletId -> Map DerivationPath Address -> SqlPersistT IO ()
insertRndStatePending WalletId
wid Map DerivationPath Address
addresses = do
    [Filter RndStatePendingAddress] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField RndStatePendingAddress WalletId
forall typ.
(typ ~ WalletId) =>
EntityField RndStatePendingAddress typ
RndStatePendingAddressWalletId EntityField RndStatePendingAddress WalletId
-> WalletId -> Filter RndStatePendingAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid]
    ([RndStatePendingAddress] -> SqlPersistT IO ())
-> [RndStatePendingAddress] -> SqlPersistT IO ()
forall record b.
PersistEntity record =>
([record] -> SqlPersistT IO b) -> [record] -> SqlPersistT IO ()
dbChunked [RndStatePendingAddress] -> SqlPersistT IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_
        [ WalletId -> Word32 -> Word32 -> Address -> RndStatePendingAddress
RndStatePendingAddress WalletId
wid Word32
accIx Word32
addrIx Address
addr
        | ((W.Index Word32
accIx, W.Index Word32
addrIx), Address
addr) <- Map DerivationPath Address -> [(DerivationPath, Address)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map DerivationPath Address
addresses
        ]

selectRndStatePending
    :: W.WalletId
    -> SqlPersistT IO (Map Rnd.DerivationPath W.Address)
selectRndStatePending :: WalletId -> ReaderT SqlBackend IO (Map DerivationPath Address)
selectRndStatePending WalletId
wid = do
    [RndStatePendingAddress]
addrs <- (Entity RndStatePendingAddress -> RndStatePendingAddress)
-> [Entity RndStatePendingAddress] -> [RndStatePendingAddress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Entity RndStatePendingAddress -> RndStatePendingAddress
forall record. Entity record -> record
entityVal ([Entity RndStatePendingAddress] -> [RndStatePendingAddress])
-> ReaderT SqlBackend IO [Entity RndStatePendingAddress]
-> ReaderT SqlBackend IO [RndStatePendingAddress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter RndStatePendingAddress]
-> [SelectOpt RndStatePendingAddress]
-> ReaderT SqlBackend IO [Entity RndStatePendingAddress]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList
        [ EntityField RndStatePendingAddress WalletId
forall typ.
(typ ~ WalletId) =>
EntityField RndStatePendingAddress typ
RndStatePendingAddressWalletId EntityField RndStatePendingAddress WalletId
-> WalletId -> Filter RndStatePendingAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. WalletId
wid
        ] []
    Map DerivationPath Address
-> ReaderT SqlBackend IO (Map DerivationPath Address)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map DerivationPath Address
 -> ReaderT SqlBackend IO (Map DerivationPath Address))
-> Map DerivationPath Address
-> ReaderT SqlBackend IO (Map DerivationPath Address)
forall a b. (a -> b) -> a -> b
$ [(DerivationPath, Address)] -> Map DerivationPath Address
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(DerivationPath, Address)] -> Map DerivationPath Address)
-> [(DerivationPath, Address)] -> Map DerivationPath Address
forall a b. (a -> b) -> a -> b
$ (RndStatePendingAddress -> (DerivationPath, Address))
-> [RndStatePendingAddress] -> [(DerivationPath, Address)]
forall a b. (a -> b) -> [a] -> [b]
map RndStatePendingAddress -> (DerivationPath, Address)
forall (derivationType :: DerivationType) (level :: Depth)
       (derivationType :: DerivationType) (level :: Depth).
RndStatePendingAddress
-> ((Index derivationType level, Index derivationType level),
    Address)
assocFromEntity [RndStatePendingAddress]
addrs
  where
    assocFromEntity :: RndStatePendingAddress
-> ((Index derivationType level, Index derivationType level),
    Address)
assocFromEntity (RndStatePendingAddress WalletId
_ Word32
accIx Word32
addrIx Address
addr) =
        ((Word32 -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index Word32
accIx, Word32 -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
W.Index Word32
addrIx), Address
addr)