Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add additional wallet primitives and wallet layer primitives #29

Merged
merged 1 commit into from
Mar 7, 2019
Merged

Add additional wallet primitives and wallet layer primitives #29

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 2 additions & 10 deletions cardano-wallet.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,20 +28,16 @@ library
-Wall
-Wcompat
-fwarn-redundant-constraints

if (!flag(development))
ghc-options: -Werror

build-depends:
base

-- Hackage Dependencies
, bytestring
, cborg
, containers
, deepseq
, text

, transformers
hs-source-dirs:
src
exposed-modules:
Expand All @@ -62,15 +58,14 @@ executable cardano-wallet-server
-threaded -rtsopts
-Wall
-O2

build-depends:
base

hs-source-dirs:
app/server
main-is:
Main.hs


test-suite unit
default-language:
Haskell2010
Expand All @@ -81,14 +76,11 @@ test-suite unit
-threaded -rtsopts
-Wall
-O2

if (!flag(development))
ghc-options: -Werror

build-depends:
base
, cardano-wallet

, base58-bytestring
, bytestring
, cborg
Expand Down
126 changes: 95 additions & 31 deletions src/Cardano/Wallet/Primitive.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Copyright: © 2018-2019 IOHK
Expand All @@ -24,15 +27,24 @@ module Cardano.Wallet.Primitive
, Tx(..)
, TxIn(..)
, TxOut(..)
, txId
, txIns
, txOutsOurs
, updatePending

-- * Address
, Address (..)
, IsOurs(..)

-- * Coin
, Coin (..)
, isValidCoin

-- * UTxO
, UTxO (..)
, balance
, changeUTxO
, utxoFromTx
, excluding
, isSubsetOf
, restrictedBy
Expand All @@ -47,12 +59,18 @@ import Prelude

import Control.DeepSeq
( NFData (..) )
import Control.Monad.Trans.State.Strict
( State, runState, state )
import Data.ByteString
( ByteString )
import Data.Map.Strict
( Map )
import Data.Maybe
( catMaybes )
import Data.Set
( Set )
import Data.Traversable
( for )
import Data.Word
( Word16, Word32, Word64 )
import GHC.Generics
Expand Down Expand Up @@ -101,15 +119,48 @@ data Tx = Tx
-- ^ Order of outputs matter in the transaction representations. Outputs
-- are used as inputs for next transactions which refer to them using
-- their indexes. It matters also for serialization.
} deriving (Show, Eq, Ord, Generic)
} deriving (Show, Generic, Ord, Eq)

instance NFData Tx

-- | Calculating a transaction id. Assumed to be effectively injective
txId :: Tx -> Hash "Tx"
txId = error
"txId: not yet implemented. We need the ability to encode a Tx to CBOR for:\
\ BA.convert . hash @_ @Blake2b_256 . CBOR.toStrictByteString . encodeTx"

txIns :: Set Tx -> Set TxIn
txIns =
foldMap (Set.fromList . inputs)

txOutsOurs
:: forall s. (IsOurs s)
=> Set Tx
-> s
-> (Set TxOut, s)
txOutsOurs txs =
runState $ Set.fromList <$> forMaybe (foldMap outputs txs) pick
where
pick :: TxOut -> State s (Maybe TxOut)
pick out = do
predicate <- state $ isOurs (address out)
return $ if predicate then Just out else Nothing

forMaybe :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]
forMaybe xs = fmap catMaybes . for xs

updatePending :: Block -> Set Tx -> Set Tx
updatePending b =
let
isStillPending ins = Set.null . Set.intersection ins . Set.fromList . inputs
in
Set.filter (isStillPending (txIns $ transactions b))


data TxIn = TxIn
{ txId
{ inputId
:: !(Hash "Tx")
, txIx
, inputIx
:: !Word32
} deriving (Show, Generic, Eq, Ord)

Expand All @@ -134,37 +185,40 @@ newtype Address = Address

instance NFData Address

-- | This abstraction exists to give us the ability to keep the wallet business
-- logic agnostic to the address derivation and discovery mechanisms.
--
-- This is needed because two different address schemes lives on Cardano:
-- - A hierarchical random scheme:
-- rather 'custom' made, with several flaws; this is the original and now
-- legacy address scheme.
--
-- - A hierarchical sequential scheme:
-- a new scheme based on the BIP-0044 specification, which is better suited
-- for our present needs.
--
-- In practice, we will need a wallet that can support both, even if not at the
-- same time, and this little abstraction can buy us this without introducing
-- too much overhead.
class IsOurs s where
isOurs :: Address -> s -> (Bool, s)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I never quite understood why we need state for this. Is it to keep track of the number unused addresses as we discover them?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The state is necessary for sequential derivation, but useless for the random one. For the sequential derivation, we have to keep track of a pool of addresses. The edge of the pool contains a given number (the address pool gap) of consecutive undiscovered / unused addresses. When we discover an address within this edge, we extend the pool to always keep gap consecutive undiscovered addresses at the edge. So, the process of looking an address up is intrinsically stateful: previous lookups matter, and the order in which you've done them matters too.

With the random address scheme / legacy scheme of cardano-sl, we do not "discover" address so-to-speak, we decrypt them as they contain a encrypted payload. If we are able to decrypt the payload, it means the address is ours. Given the passphrase, the operation is stateless and the addresses you've looked up before won't change anything to the answer.



-- * Coin

-- | Coins are stored as Lovelace (reminder: 1 Lovelace = 1e6 ADA)
newtype Coin = Coin
{ getCoin :: Word64
} deriving stock (Show, Ord, Eq, Generic)
deriving newtype (Enum, Num, Real, Integral)

instance NFData Coin

instance Bounded Coin where
minBound = Coin 0
maxBound = Coin 45000000000000000

instance Semigroup Coin where
(Coin a) <> (Coin b) =
invariant
( mconcat
[ "Cardano.Wallet.Primitive.Coin (<>), sum out of bounds: "
, show a
, " + "
, show b
]
)
(Coin (a + b))
(<= maxBound)

instance Monoid Coin where
mempty = minBound
mconcat = foldr (<>) mempty
isValidCoin :: Coin -> Bool
isValidCoin c = c >= minBound && c <= maxBound
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Hm sure.

Where will this be used? Could Coin be a more abstract type here? Maybe not.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That's is mostly for testing now, and, generally speaking, since we don't have any smart-constructor on Coin, we are kinda free to put any value we want inside a Coin. So, in practice, we may need to verify this. This is dubious however, I admit.



-- * UTxO
Expand All @@ -179,6 +233,25 @@ instance Dom UTxO where
type DomElem UTxO = TxIn
dom (UTxO utxo) = Map.keysSet utxo

balance :: UTxO -> Integer
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

NOTE: balance isn't giving back a Coin because this may overflow. Hence, we'll have to handle that properly whenever we make use of that.

balance =
Map.foldl' (\total out -> total + fromIntegral (getCoin (coin out))) 0 . getUTxO

utxoFromTx :: Tx -> UTxO
utxoFromTx tx@(Tx _ outs) =
UTxO $ Map.fromList $ zip (TxIn (txId tx) <$> [0..]) outs

changeUTxO
:: IsOurs s
=> Set Tx
-> s
-> (UTxO, s)
changeUTxO pending = runState $ do
ours <- state $ txOutsOurs pending
let utxo = foldMap utxoFromTx pending
let ins = txIns pending
return $ (utxo `restrictedTo` ours) `restrictedBy` ins

-- ins⋪ u
excluding :: UTxO -> Set TxIn -> UTxO
excluding (UTxO utxo) =
Expand All @@ -200,24 +273,15 @@ restrictedTo (UTxO utxo) outs =
UTxO $ Map.filter (`Set.member` outs) utxo


-- * Generic

class Dom a where
type DomElem a :: *
dom :: a -> Set (DomElem a)


-- * Helpers

newtype Hash (tag :: Symbol) = Hash
{ getHash :: ByteString
} deriving (Show, Generic, Eq, Ord)

instance NFData (Hash tag)


invariant
:: String
-> a
-> (a -> Bool)
-> a
invariant msg a predicate =
if predicate a then a else error msg
12 changes: 6 additions & 6 deletions test/unit/Cardano/Wallet/BinarySpec.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,8 +49,8 @@ block2 = Block
[ Tx
{ inputs =
[ TxIn
{ txId = hash16 "60dbb2679ee920540c18195a3d92ee9be50aee6ed5f891d92d51db8a76b02cd2"
, txIx = 3
{ inputId = hash16 "60dbb2679ee920540c18195a3d92ee9be50aee6ed5f891d92d51db8a76b02cd2"
, inputIx = 3
}
]
, outputs =
Expand Down Expand Up @@ -79,11 +79,11 @@ block3 = Block
[ Tx
{ inputs =
[ TxIn
{ txId = hash16 "6967e2b5c3ad5ae07a9bd8d888f1836195a04f7a1cb4b6d083261870068fab1b"
, txIx = 1}
{ inputId = hash16 "6967e2b5c3ad5ae07a9bd8d888f1836195a04f7a1cb4b6d083261870068fab1b"
, inputIx = 1}
, TxIn
{ txId = hash16 "7064addc0968bccd7d57d2e7aa1e9c2f666d8387042483fc1e87200cfb96c8f1"
, txIx = 0} ]
{ inputId = hash16 "7064addc0968bccd7d57d2e7aa1e9c2f666d8387042483fc1e87200cfb96c8f1"
, inputIx = 0} ]
, outputs =
[ TxOut
{ address = addr58 "37btjrVyb4KBsw2f3V76ntfwqDPgyf3QmmdsrTSmCnuTGYtS9JgVXzxeQEsKjgWurKoyw9BDNEtLxWtU9znK49SC8bLTirk6YqcAESFxXJkSyXhQKL"
Expand Down
Loading