Skip to content
Permalink
Browse files

More wip Address derivation

  • Loading branch information...
rvl committed May 16, 2019
1 parent b677581 commit bbbe0f833c41f373885171c164e443b5f4ed8f3a
@@ -34,7 +34,14 @@ import Cardano.Wallet.DB
import Cardano.Wallet.DB.SqliteTypes
( AddressScheme (..), TxId (..), sqlSettings' )
import Cardano.Wallet.Primitive.AddressDerivation
( Depth (..), Key, deserializeKey, getKey, serializeKey )
( Depth (..)
, Key
, deserializeXPrv
, deserializeXPub
, getKey
, serializeXPrv
, serializeXPub
)
import Cardano.Wallet.Primitive.AddressDiscovery
( IsOurs (..) )
import Cardano.Wallet.Primitive.Types
@@ -71,6 +78,8 @@ import Data.Text
( Text )
import Data.Time.Clock
( UTCTime )
import Data.Typeable
( Typeable )
import Data.Word
( Word32 )
import Database.Persist.Sql
@@ -81,6 +90,7 @@ import Database.Persist.Sql
, deleteWhere
, deleteWhereCount
, entityVal
, insert
, insertMany_
, insert_
, putMany
@@ -108,6 +118,7 @@ import System.IO
import System.Log.FastLogger
( fromLogStr )

import qualified Cardano.Wallet.Primitive.AddressDerivation as W
import qualified Cardano.Wallet.Primitive.AddressDiscovery as W
import qualified Cardano.Wallet.Primitive.Model as W
import qualified Cardano.Wallet.Primitive.Types as W
@@ -255,6 +266,7 @@ SeqState
seqStateTableWalletId W.WalletId sql=wallet_id
seqStateTableCheckpointSlot W.SlotId sql=slot

UniqueSeqState seqStateTableWalletId seqStateTableCheckpointSlot
Foreign Checkpoint fk_checkpoint_seq_state seqStateTableWalletId seqStateTableCheckpointSlot
deriving Show Generic

@@ -279,6 +291,7 @@ SeqStateInternalPool
seqStateInternalPoolSeqStateId SeqStateId
seqStateInternalPoolAddressPool AddressPoolId
UniqueSeqStateInternalPool seqStateInternalPoolSeqStateId seqStateInternalPoolAddressPool
Primary seqStateInternalPoolSeqStateId
deriving Show Generic

-- Sequential address discovery scheme -- external address pool
@@ -287,13 +300,16 @@ SeqStateExternalPool
seqStateExternalPoolSeqStateId SeqStateId
seqStateExternalPoolAddressPool AddressPoolId
UniqueSeqStateExternalPool seqStateExternalPoolSeqStateId seqStateExternalPoolAddressPool
Primary seqStateExternalPoolSeqStateId
deriving Show Generic

-- Sequential address discovery scheme -- pending indexes
-- Sequential address discovery scheme -- pending change indexes
SeqStatePendingIx
seqStatePendingIxSeqStateId SeqStateId
seqStatePendingIxPos Word32
seqStatePendingIxIndex Word32

Primary seqStatePendingIxSeqStateId seqStatePendingIxPos
deriving Show Generic
|]

@@ -516,12 +532,12 @@ mkPrivateKeyEntity wid kh = PrivateKey
, privateKeyTableHash = hash
}
where
(root, hash) = serializeKey kh
(root, hash) = serializeXPrv kh

privateKeyFromEntity
:: PrivateKey
-> Either String (Key 'RootK XPrv, W.Hash "encryption")
privateKeyFromEntity (PrivateKey _ k h) = deserializeKey (k, h)
privateKeyFromEntity (PrivateKey _ k h) = deserializeXPrv (k, h)

mkCheckpointEntity
:: forall s t. W.TxId t
@@ -573,8 +589,8 @@ checkpointFromEntity
-> [TxOut]
-> s
-> W.Wallet s t
checkpointFromEntity (Checkpoint _ tip) utxo ins outs s =
W.Wallet utxo' pending tip s
checkpointFromEntity (Checkpoint _ tip) utxo ins outs =
W.Wallet utxo' pending tip
where
utxo' = W.UTxO . Map.fromList $
[ (W.TxIn input ix, W.TxOut addr coin)
@@ -768,9 +784,75 @@ class PersistState s where
addressScheme :: Proxy s -> AddressScheme

instance PersistState (W.SeqState t) where
insertState (_wid, _sl) _st = do
pure ()
selectState (_wid, _sl) = do
pure Nothing
insertState (wid, sl) st = do
ssid <- insert (SeqState wid sl)
intApId <- insertAddressPool $ W.internalPool st
extApId <- insertAddressPool $ W.externalPool st
insert_ $ SeqStateInternalPool ssid intApId
insert_ $ SeqStateExternalPool ssid extApId
insertMany_ $ mkSeqStatePendingIxs ssid $ W.pendingChangeIxs st

selectState (_wid, _sl) = pure Nothing
{-
selectState (wid, sl) = runMaybeT $ do
ssid <- MaybeT $ selectFirst [ SeqStateTableWalletId ==. wid
, SeqStateTableCheckpointSlot ==. sl ] []
intApId <- MaybeT $ seqStateInternalPoolAddressPool . entityVal <$>
selectFirst [ SeqStateInternalPoolSeqStateId ==. ssid ] []
extApId <- MaybeT $ seqStateExternalPoolAddressPool . entityVal <$>
selectFirst [ SeqStateExternalPoolSeqStateId ==. ssid ] []
internalPool <- MaybeT $ selectAddressPool intApId
externalPool <- MaybeT $ selectAddressPool extApId
pendingChangeIxs <- lift $ selectSeqStatePendingIxs ssid
pure $ W.SeqState internalPool externalPool pendingChangeIxs
-}

deleteState _ wid = deleteCascadeWhere [SeqStateTableWalletId ==. wid]
addressScheme _ = Sequential

mkSeqStatePendingIxs :: SeqStateId -> W.PendingIxs -> [SeqStatePendingIx]
mkSeqStatePendingIxs ssid (W.PendingIxs ixs) =
[SeqStatePendingIx ssid i (W.getIndex ix) | (i, ix) <- zip [0..] ixs]

insertAddressPool
:: MonadIO m
=> W.AddressPool t c
-> ReaderT SqlBackend m AddressPoolId -- SqlPersistT m AddressPoolId
insertAddressPool ap = do
apid <- insert $ AddressPool (serializeXPub $ W.accountPubKey ap) (W.gap ap)
insertMany_ [ AddressPoolIndex apid a (W.getIndex i)
| (a, i) <- Map.toList (W.indexedAddresses ap) ]
pure apid

{-
selectAddressPool
:: forall m t chain. (W.KeyToAddress t, Typeable chain, MonadIO m)
=> AddressPoolId
-> ReaderT SqlBackend m (Maybe (W.AddressPool t chain))
selectAddressPool apid = do
ix <- fmap entityVal <$> selectList [IndexAddressPool ==. apid] []
ap <- fmap entityVal <$> selectFirst [AddressPoolId ==. apid] []
pure $ addressPoolFromEntity ix <$> ap
addressPoolFromEntity
:: forall t chain. (W.KeyToAddress t, Typeable chain)
=> [AddressPoolIndex]
-- ^ Must be sorted by indexNumber
-> AddressPool
-> W.AddressPool t chain
addressPoolFromEntity ixs (AddressPool pubKey gap) =
ap { W.indexedAddresses = addrs }
where
ap = W.mkAddressPool pubKey' gap []
pubKey' = error "todo: pubkey" $ deserializeXPub pubKey
addrs = Map.fromList [(addr, W.Index ix) | AddressPoolIndex _ addr ix <- ixs]
-}

selectSeqStatePendingIxs :: MonadIO m => SeqStateId -> ReaderT SqlBackend m W.PendingIxs
selectSeqStatePendingIxs ssid =
fromRes <$> selectList
[SeqStatePendingIxSeqStateId ==. ssid]
[Asc SeqStatePendingIxPos]
where
fromRes = W.PendingIxs . fmap (W.Index . seqStatePendingIxIndex . entityVal)
@@ -30,8 +30,7 @@ module Cardano.Wallet.Primitive.AddressDerivation
Key
, getKey
, Depth (..)
, Index
, getIndex
, Index (..)
, DerivationType (..)
, publicKey
, digest
@@ -42,9 +42,10 @@ module Cardano.Wallet.Primitive.AddressDiscovery
, accountPubKey
, mkAddressPool
, lookupAddress
, indexedAddresses -- fixme: internals exposed for sql

-- * Pending Change Indexes
, PendingIxs
, PendingIxs (..)
, emptyPendingIxs

-- ** State

0 comments on commit bbbe0f8

Please sign in to comment.
You can’t perform that action at this time.