|
| 1 | +{-# LANGUAGE BinaryLiterals #-} |
| 2 | +{-# LANGUAGE DataKinds #-} |
| 3 | +{-# LANGUAGE LambdaCase #-} |
| 4 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 5 | +{-# LANGUAGE TypeApplications #-} |
| 6 | + |
| 7 | +-- | |
| 8 | +-- For a UTxO to be considered a suitable collateral input, it must: |
| 9 | +-- - Be a pure ADA UTxO (no tokens) |
| 10 | +-- - Require a verification key witness to be spent |
| 11 | +-- - Not be locked by a script |
| 12 | +-- |
| 13 | +-- UTxOs of this kind are sometimes referred to as "VK" inputs. |
| 14 | + |
| 15 | +module Cardano.Wallet.Primitive.Collateral |
| 16 | + ( |
| 17 | + -- * Data types |
| 18 | + AddressType(..) |
| 19 | + , Credential(..) |
| 20 | + |
| 21 | + -- * Classifying address types |
| 22 | + , asCollateral |
| 23 | + , addressSuitableForCollateral |
| 24 | + , addressTypeSuitableForCollateral |
| 25 | + |
| 26 | + -- * Reading address types |
| 27 | + , addressTypeFromHeaderNibble |
| 28 | + , getAddressType |
| 29 | + , addressType |
| 30 | + |
| 31 | + -- * Writing address types |
| 32 | + , addressTypeToHeaderNibble |
| 33 | + , putAddressType |
| 34 | + ) where |
| 35 | + |
| 36 | +import Prelude |
| 37 | + |
| 38 | +import Cardano.Wallet.Primitive.Types.Address |
| 39 | + ( Address (..) ) |
| 40 | +import Cardano.Wallet.Primitive.Types.Coin |
| 41 | + ( Coin ) |
| 42 | +import Cardano.Wallet.Primitive.Types.Tx |
| 43 | + ( TxOut (..) ) |
| 44 | +import Data.Word |
| 45 | + ( Word8 ) |
| 46 | +import Data.Word.Odd |
| 47 | + ( Word4 ) |
| 48 | + |
| 49 | +import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle |
| 50 | +import qualified Data.Binary.Get as B |
| 51 | +import qualified Data.Binary.Put as B |
| 52 | +import qualified Data.Bits as Bits |
| 53 | +import qualified Data.ByteString.Lazy as BL |
| 54 | + |
| 55 | +-- In the realm of cardano-ledger-specs, we recognize the following types of |
| 56 | +-- addresses: |
| 57 | +-- (see https://hydra.iohk.io/build/6752483/download/1/ledger-spec.pdf): |
| 58 | +-- |
| 59 | +-- | Address type | Payment Credential | Stake Credential | Header, first nibble | |
| 60 | +-- |--------------------+--------------------+------------------+----------------------| |
| 61 | +-- | Base address | keyhash | keyhash | 0000 | |
| 62 | +-- | | scripthash | keyhash | 0001 | |
| 63 | +-- | | keyhash | scripthash | 0010 | |
| 64 | +-- | | scripthash | scripthash | 0011 | |
| 65 | +-- | Pointer address | keyhash | ptr | 0100 | |
| 66 | +-- | | scripthash | ptr | 0101 | |
| 67 | +-- | Enterprise address | keyhash | - | 0110 | |
| 68 | +-- | | scripthash | 0 | 0111 | |
| 69 | +-- | Bootstrap address | keyhash | - | 1000 | |
| 70 | +-- | Stake address | - | keyhash | 1110 | |
| 71 | +-- | | - | scripthash | 1111 | |
| 72 | +-- | Future formats | ? | ? | 1001-1101 | |
| 73 | +-- |
| 74 | +-- We represent these types of addresses with the following data types: |
| 75 | + |
| 76 | +-- | The type of the address. |
| 77 | +data AddressType |
| 78 | + = BaseAddress Credential Credential |
| 79 | + | PointerAddress Credential |
| 80 | + | EnterpriseAddress Credential |
| 81 | + | StakeAddress Credential |
| 82 | + | BootstrapAddress |
| 83 | + -- ^ A Bootstrap (a.k.a. Byron) address |
| 84 | + deriving (Eq, Show) |
| 85 | + |
| 86 | +-- | The type of the credential used in an address. |
| 87 | +data Credential |
| 88 | + = CredentialKeyHash |
| 89 | + | CredentialScriptHash |
| 90 | + deriving (Eq, Show) |
| 91 | + |
| 92 | +-- To parse the address type, we can inspect the first four bits (nibble) of the |
| 93 | +-- address: |
| 94 | + |
| 95 | +-- | Construct an @AddressType@ from the binary representation. |
| 96 | +addressTypeFromHeaderNibble :: Word4 -> Maybe AddressType |
| 97 | +addressTypeFromHeaderNibble = \case |
| 98 | + 0b0000 -> Just (BaseAddress CredentialKeyHash CredentialKeyHash) |
| 99 | + 0b0001 -> Just (BaseAddress CredentialScriptHash CredentialKeyHash) |
| 100 | + 0b0010 -> Just (BaseAddress CredentialKeyHash CredentialScriptHash) |
| 101 | + 0b0011 -> Just (BaseAddress CredentialScriptHash CredentialScriptHash) |
| 102 | + 0b0100 -> Just (PointerAddress CredentialKeyHash) |
| 103 | + 0b0101 -> Just (PointerAddress CredentialScriptHash) |
| 104 | + 0b0110 -> Just (EnterpriseAddress CredentialKeyHash) |
| 105 | + 0b0111 -> Just (EnterpriseAddress CredentialScriptHash) |
| 106 | + 0b1000 -> Just (BootstrapAddress) |
| 107 | + 0b1110 -> Just (StakeAddress CredentialKeyHash) |
| 108 | + 0b1111 -> Just (StakeAddress CredentialScriptHash) |
| 109 | + _ -> Nothing |
| 110 | + |
| 111 | +-- | Get an AddressType from a binary stream. |
| 112 | +getAddressType :: B.Get AddressType |
| 113 | +getAddressType = do |
| 114 | + headerAndNetwork <- B.getWord8 |
| 115 | + let headerNibble = |
| 116 | + fromIntegral @Word8 @Word4 (headerAndNetwork `Bits.shiftR` 4) |
| 117 | + maybe |
| 118 | + (fail "Unknown address type.") |
| 119 | + (pure) |
| 120 | + (addressTypeFromHeaderNibble headerNibble) |
| 121 | + |
| 122 | +-- For testing and other purposes, it is also helpful to have a way of writing |
| 123 | +-- the AddressType back to a binary stream. |
| 124 | + |
| 125 | +-- | Return the binary representation of an @AddressType@. |
| 126 | +addressTypeToHeaderNibble :: AddressType -> Word4 |
| 127 | +addressTypeToHeaderNibble = \case |
| 128 | + BaseAddress CredentialKeyHash CredentialKeyHash -> 0b0000 |
| 129 | + BaseAddress CredentialScriptHash CredentialKeyHash -> 0b0001 |
| 130 | + BaseAddress CredentialKeyHash CredentialScriptHash -> 0b0010 |
| 131 | + BaseAddress CredentialScriptHash CredentialScriptHash -> 0b0011 |
| 132 | + PointerAddress CredentialKeyHash -> 0b0100 |
| 133 | + PointerAddress CredentialScriptHash -> 0b0101 |
| 134 | + EnterpriseAddress CredentialKeyHash -> 0b0110 |
| 135 | + EnterpriseAddress CredentialScriptHash -> 0b0111 |
| 136 | + BootstrapAddress -> 0b1000 |
| 137 | + StakeAddress CredentialKeyHash -> 0b1110 |
| 138 | + StakeAddress CredentialScriptHash -> 0b1111 |
| 139 | + |
| 140 | +-- | Write an AddressType to a binary stream. |
| 141 | +putAddressType :: AddressType -> B.Put |
| 142 | +putAddressType t = |
| 143 | + B.putWord8 $ |
| 144 | + fromIntegral @Word4 @Word8 (addressTypeToHeaderNibble t) `Bits.shiftL` 4 |
| 145 | + |
| 146 | +-- | Indicates whether or not the given address is suitable for collateral. |
| 147 | +-- |
| 148 | +addressSuitableForCollateral :: Address -> Bool |
| 149 | +addressSuitableForCollateral = |
| 150 | + maybe False addressTypeSuitableForCollateral . addressType |
| 151 | + |
| 152 | +-- By inspecting the bit pattern of an Address, we can determine its address |
| 153 | +-- type. |
| 154 | + |
| 155 | +-- | Get the address type of a given address. |
| 156 | +addressType :: Address -> Maybe AddressType |
| 157 | +addressType (Address bytes) = |
| 158 | + case B.runGetOrFail getAddressType (BL.fromStrict bytes) of |
| 159 | + Left _ -> |
| 160 | + Nothing |
| 161 | + Right (_, _, addrType) -> |
| 162 | + Just addrType |
| 163 | + |
| 164 | +-- The funds associated with an address are considered suitable for use as |
| 165 | +-- collateral iff the payment credential column of that address is "key hash". |
| 166 | + |
| 167 | +-- | A simple function which determines if an @AddressType@ is suitable for use |
| 168 | +-- as collateral. Only @AddressType@s with a "key hash" payment credential are |
| 169 | +-- considered suitable for use as collateral. |
| 170 | +addressTypeSuitableForCollateral :: AddressType -> Bool |
| 171 | +addressTypeSuitableForCollateral = \case |
| 172 | + BaseAddress CredentialKeyHash CredentialKeyHash -> True |
| 173 | + BaseAddress CredentialKeyHash CredentialScriptHash -> True |
| 174 | + BaseAddress CredentialScriptHash CredentialKeyHash -> False |
| 175 | + BaseAddress CredentialScriptHash CredentialScriptHash -> False |
| 176 | + PointerAddress CredentialKeyHash -> True |
| 177 | + PointerAddress CredentialScriptHash -> False |
| 178 | + EnterpriseAddress CredentialKeyHash -> True |
| 179 | + EnterpriseAddress CredentialScriptHash -> False |
| 180 | + StakeAddress CredentialKeyHash -> False |
| 181 | + StakeAddress CredentialScriptHash -> False |
| 182 | + BootstrapAddress -> True |
| 183 | + |
| 184 | +-- | If the given @TxOut@ represents a UTxO that is suitable for use as |
| 185 | +-- a collateral input, returns @Just@ along with the total ADA value of the |
| 186 | +-- UTxO. Otherwise returns @Nothing@ if it is not a suitable collateral value. |
| 187 | +asCollateral |
| 188 | + :: TxOut |
| 189 | + -- ^ TxOut from a UTxO entry |
| 190 | + -> Maybe Coin |
| 191 | + -- ^ The total ADA value of that UTxO if it is suitable for collateral, |
| 192 | + -- otherwise Nothing. |
| 193 | +asCollateral txOut |
| 194 | + | addressSuitableForCollateral (address txOut) = |
| 195 | + TokenBundle.toCoin (tokens txOut) |
| 196 | + | otherwise = |
| 197 | + Nothing |
![iohk-bors[bot]](https://avatars.githubusercontent.com/in/17473?v=4&size=40){kind=avatar}
0 commit comments