Skip to content

Commit

Permalink
Use key flavors in MintBurn module.
Browse files Browse the repository at this point in the history
  • Loading branch information
paolino committed May 24, 2023
1 parent 9b0f753 commit 94e2ed9
Show file tree
Hide file tree
Showing 5 changed files with 152 additions and 119 deletions.
35 changes: 19 additions & 16 deletions lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
Expand Up @@ -222,11 +222,7 @@ import Cardano.Wallet.Address.Derivation.Byron
import Cardano.Wallet.Address.Derivation.Icarus
( IcarusKey )
import Cardano.Wallet.Address.Derivation.MintBurn
( scriptSlotIntervals
, toTokenMapAndScript
, toTokenPolicyId
, withinSlotInterval
)
( scriptSlotIntervals, withinSlotInterval )
import Cardano.Wallet.Address.Derivation.SharedKey
( SharedKey (..), replaceCosignersWithVerKeys )
import Cardano.Wallet.Address.Derivation.Shelley
Expand Down Expand Up @@ -263,6 +259,8 @@ import Cardano.Wallet.Address.Discovery.Shared
)
import Cardano.Wallet.Address.HasDelegation
( HasDelegation (..) )
import Cardano.Wallet.Address.Keys.MintBurn
( toTokenMapAndScript, toTokenPolicyId )
import Cardano.Wallet.Address.Keys.WalletKey
( AfterByron )
import Cardano.Wallet.Api
Expand Down Expand Up @@ -430,7 +428,12 @@ import Cardano.Wallet.Compat
import Cardano.Wallet.DB
( DBFactory (..), DBFresh, DBLayer, loadDBLayer )
import Cardano.Wallet.Flavor
( KeyOf, WalletFlavor (..), WalletFlavorS (ShelleyWallet), keyFlavor )
( KeyFlavorS (..)
, KeyOf
, WalletFlavor (..)
, WalletFlavorS (ShelleyWallet)
, keyFlavor
)
import Cardano.Wallet.Network
( NetworkLayer (..), fetchRewardAccountBalances, timeInterpreter )
import Cardano.Wallet.Pools
Expand Down Expand Up @@ -2493,7 +2496,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
(ApiT scriptT)
(Just (ApiT tName))
(ApiMint (ApiMintData _ amt)) ->
toTokenMapAndScript @ShelleyKey
toTokenMapAndScript ShelleyKeyS
scriptT
(Map.singleton (Cosigner 0) policyXPub)
tName
Expand All @@ -2504,7 +2507,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
(ApiT scriptT)
(Just (ApiT tName))
(ApiBurn (ApiBurnData amt)) ->
toTokenMapAndScript @ShelleyKey
toTokenMapAndScript ShelleyKeyS
scriptT
(Map.singleton (Cosigner 0) policyXPub)
tName
Expand Down Expand Up @@ -2692,7 +2695,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d
(ApiMintBurnData (ApiT scriptT) (Just (ApiT tName))
(ApiMint (ApiMintData (Just addr) amt))) =
let (assetId, tokenQuantity, _) =
toTokenMapAndScript @ShelleyKey
toTokenMapAndScript ShelleyKeyS
scriptT (Map.singleton (Cosigner 0) policyXPub)
tName amt
assets = fromFlatList [(assetId, tokenQuantity)]
Expand Down Expand Up @@ -4168,13 +4171,12 @@ postPolicyKey ctx (ApiT wid) hashed apiPassphrase =
pwd = getApiT (apiPassphrase ^. #passphrase)

postPolicyId
:: forall ctx s k
. ( ctx ~ ApiLayer s 'CredFromKeyK
, WalletKey k
, WalletFlavor s
, k ~ KeyOf s
:: forall s k
. ( WalletFlavor s
, KeyOf s ~ k
, AfterByron k ~ 'True
)
=> ctx
=> ApiLayer s 'CredFromKeyK
-> ApiT WalletId
-> ApiPostPolicyIdData
-> Handler ApiPolicyId
Expand All @@ -4190,7 +4192,8 @@ postPolicyId ctx (ApiT wid) payload = do
withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
(xpub, _) <- liftHandler $ W.readPolicyPublicKey @_ @s wrk
pure $ ApiPolicyId $ ApiT $
toTokenPolicyId @k scriptTempl (Map.singleton (Cosigner 0) xpub)
toTokenPolicyId (keyFlavor @s)
scriptTempl (Map.singleton (Cosigner 0) xpub)
where
scriptTempl = getApiT (payload ^. #policyScriptTemplate)

Expand Down
1 change: 1 addition & 0 deletions lib/wallet/cardano-wallet.cabal
Expand Up @@ -240,6 +240,7 @@ library
Cardano.Wallet.Address.Discovery.Shared
Cardano.Wallet.Address.HasDelegation
Cardano.Wallet.Address.Keys.BoundedAddressLength
Cardano.Wallet.Address.Keys.MintBurn
Cardano.Wallet.Address.Keys.PersistPrivateKey
Cardano.Wallet.Address.Keys.WalletKey
Cardano.Wallet.Address.Pool
Expand Down
97 changes: 3 additions & 94 deletions lib/wallet/src/Cardano/Wallet/Address/Derivation/MintBurn.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
Expand All @@ -24,21 +25,18 @@ module Cardano.Wallet.Address.Derivation.MintBurn
( -- * Constants
purposeCIP1855
-- * Helpers
, derivePolicyKeyAndHash
, derivePolicyPrivateKey
, policyDerivationPath
, toTokenMapAndScript
, toTokenPolicyId
, scriptSlotIntervals
, withinSlotInterval
) where

import Prelude

import Cardano.Address.Derivation
( XPrv, XPub )
( XPrv )
import Cardano.Address.Script
( Cosigner, KeyHash, Script (..), ScriptHash (..), toScriptHash )
( Script (..) )
import Cardano.Crypto.Wallet
( deriveXPrv )
import Cardano.Crypto.Wallet.Types
Expand All @@ -48,48 +46,28 @@ import Cardano.Wallet.Address.Derivation
, DerivationIndex (..)
, DerivationType (..)
, Index (..)
, WalletKey
, getIndex
, getRawKey
, hashVerificationKey
, liftRawKey
, publicKey
)
import Cardano.Wallet.Address.Discovery
( coinTypeAda )
import Cardano.Wallet.Primitive.Passphrase
( Passphrase (..) )
import Cardano.Wallet.Primitive.Types
( SlotNo (..) )
import Cardano.Wallet.Primitive.Types.Hash
( Hash (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
( AssetId (..) )
import Cardano.Wallet.Primitive.Types.TokenPolicy
( TokenName, TokenPolicyId (..) )
import Cardano.Wallet.Primitive.Types.TokenQuantity
( TokenQuantity (..) )
import Data.IntCast
( intCast )
import Data.Interval
( Interval, (<=..<=) )
import Data.List.NonEmpty
( NonEmpty )
import Data.Map.Strict
( Map )
import Data.Word
( Word64 )
import GHC.Stack
( HasCallStack )
import Numeric.Natural
( Natural )

import qualified Cardano.Address.Script as CA
import qualified Data.Interval as I
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map


-- | Purpose for forged policy keys is a constant set to 1855' (or 0x8000073F)
-- following the original CIP-1855: "Forging policy keys for HD Wallets".
Expand Down Expand Up @@ -121,24 +99,6 @@ derivePolicyPrivateKey (Passphrase pwd) rootXPrv (Index policyIx) =
-- lvl3 derivation; hardened derivation of policy' index
in deriveXPrv DerivationScheme2 pwd coinTypeXPrv policyIx

-- | Derive the policy private key that should be used to create mint/burn
-- scripts, as well as the key hash of the policy public key.
derivePolicyKeyAndHash
:: WalletKey key
=> Passphrase "encryption"
-- ^ Passphrase for wallet
-> key 'RootK XPrv
-- ^ Root private key to derive policy private key from
-> Index 'Hardened 'PolicyK
-- ^ Index of policy script
-> (key 'PolicyK XPrv, KeyHash)
-- ^ Policy private key
derivePolicyKeyAndHash pwd rootPrv policyIx = (policyK, vkeyHash)
where
policyK = liftRawKey policyPrv
policyPrv = derivePolicyPrivateKey pwd (getRawKey rootPrv) policyIx
vkeyHash = hashVerificationKey CA.Payment (publicKey policyK)

policyDerivationPath
:: NonEmpty DerivationIndex
policyDerivationPath = NE.fromList
Expand All @@ -150,57 +110,6 @@ policyDerivationPath = NE.fromList
policyIx :: Index 'Hardened 'PolicyK
policyIx = minBound

toTokenPolicyId
:: forall key. WalletKey key
=> Script Cosigner
-> Map Cosigner XPub
-> TokenPolicyId
toTokenPolicyId scriptTempl cosignerMap =
UnsafeTokenPolicyId
. Hash
. unScriptHash
. toScriptHash
$ replaceCosigner @key cosignerMap scriptTempl

toTokenMapAndScript
:: forall key. WalletKey key
=> Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
toTokenMapAndScript scriptTempl cosignerMap tName val =
( AssetId (toTokenPolicyId @key scriptTempl cosignerMap) tName
, TokenQuantity val
, replaceCosigner @key cosignerMap scriptTempl
)

replaceCosigner
:: forall key
. HasCallStack
=> WalletKey key
=> Map Cosigner XPub
-> Script Cosigner
-> Script KeyHash
replaceCosigner cosignerMap = \case
RequireSignatureOf c ->
RequireSignatureOf $ toKeyHash c
RequireAllOf xs ->
RequireAllOf (map (replaceCosigner @key cosignerMap) xs)
RequireAnyOf xs ->
RequireAnyOf (map (replaceCosigner @key cosignerMap) xs)
RequireSomeOf m xs ->
RequireSomeOf m (map (replaceCosigner @key cosignerMap) xs)
ActiveFromSlot s ->
ActiveFromSlot s
ActiveUntilSlot s ->
ActiveUntilSlot s
where
toKeyHash :: HasCallStack => Cosigner -> KeyHash
toKeyHash c = case Map.lookup c cosignerMap of
Just xpub -> hashVerificationKey @key CA.Policy (liftRawKey xpub)
Nothing -> error "Impossible: cosigner without xpub."

scriptSlotIntervals
:: Script a
-> [Interval Natural]
Expand Down
116 changes: 116 additions & 0 deletions lib/wallet/src/Cardano/Wallet/Address/Keys/MintBurn.hs
@@ -0,0 +1,116 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.Wallet.Address.Keys.MintBurn
( derivePolicyKeyAndHash
, toTokenMapAndScript
, toTokenPolicyId
) where

import Prelude

import Cardano.Wallet.Address.Derivation
( Index, DerivationType (..), Depth (..))
import Cardano.Address.Script
( Cosigner, KeyHash, Script (..), ScriptHash (unScriptHash), toScriptHash )
import Cardano.Wallet.Address.Keys.WalletKey
( AfterByron, hashVerificationKeyNew, liftRawKeyNew, getRawKeyNew, publicKeyNew )
import Cardano.Wallet.Flavor
( KeyFlavorS )
import Cardano.Wallet.Primitive.Types.Hash
( Hash (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
( AssetId (..) )
import Cardano.Wallet.Primitive.Types.TokenPolicy
( TokenName, TokenPolicyId (..) )
import Cardano.Wallet.Primitive.Types.TokenQuantity
( TokenQuantity (..) )
import Data.Map
( Map )
import GHC.Natural
( Natural )
import GHC.Stack
( HasCallStack )

import qualified Cardano.Address.Script as CA
import qualified Data.Map as Map
import Cardano.Wallet.Primitive.Passphrase (Passphrase(..))
import Cardano.Address.Derivation (XPrv, XPub)
import Cardano.Wallet.Address.Derivation.MintBurn (derivePolicyPrivateKey)

toTokenPolicyId
:: forall key
. (HasCallStack, AfterByron key ~ 'True)
=> KeyFlavorS key
-> Script Cosigner
-> Map Cosigner XPub
-> TokenPolicyId
toTokenPolicyId kf scriptTempl cosignerMap =
UnsafeTokenPolicyId
. Hash
. unScriptHash
. toScriptHash
$ replaceCosigner kf cosignerMap scriptTempl

toTokenMapAndScript
:: forall key
. (HasCallStack, AfterByron key ~ 'True)
=> KeyFlavorS key
-> Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
toTokenMapAndScript kf scriptTempl cosignerMap tName val =
( AssetId (toTokenPolicyId kf scriptTempl cosignerMap) tName
, TokenQuantity val
, replaceCosigner kf cosignerMap scriptTempl
)

replaceCosigner
:: forall key
. (HasCallStack, AfterByron key ~ 'True)
=> KeyFlavorS key
-> Map Cosigner XPub
-> Script Cosigner
-> Script KeyHash
replaceCosigner kf cosignerMap = \case
RequireSignatureOf c ->
RequireSignatureOf $ toKeyHash c
RequireAllOf xs ->
RequireAllOf (map (replaceCosigner kf cosignerMap) xs)
RequireAnyOf xs ->
RequireAnyOf (map (replaceCosigner kf cosignerMap) xs)
RequireSomeOf m xs ->
RequireSomeOf m (map (replaceCosigner kf cosignerMap) xs)
ActiveFromSlot s ->
ActiveFromSlot s
ActiveUntilSlot s ->
ActiveUntilSlot s
where
toKeyHash :: HasCallStack => Cosigner -> KeyHash
toKeyHash c = case Map.lookup c cosignerMap of
Just xpub -> hashVerificationKeyNew kf CA.Policy (liftRawKeyNew kf xpub)
Nothing -> error "Impossible: cosigner without xpub."


-- | Derive the policy private key that should be used to create mint/burn
-- scripts, as well as the key hash of the policy public key.
derivePolicyKeyAndHash
:: AfterByron key ~ 'True
=> KeyFlavorS key
-> Passphrase "encryption"
-- ^ Passphrase for wallet
-> key 'RootK XPrv
-- ^ Root private key to derive policy private key from
-> Index 'Hardened 'PolicyK
-- ^ Index of policy script
-> (key 'PolicyK XPrv, KeyHash)
-- ^ Policy private key
derivePolicyKeyAndHash kf pwd rootPrv policyIx = (policyK, vkeyHash)
where
policyK = liftRawKeyNew kf policyPrv
policyPrv = derivePolicyPrivateKey pwd (getRawKeyNew kf rootPrv) policyIx
vkeyHash = hashVerificationKeyNew kf CA.Payment (publicKeyNew kf policyK)

0 comments on commit 94e2ed9

Please sign in to comment.