{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- For a UTxO to be considered a suitable collateral input, it must:
--    - Be a pure ADA UTxO (no tokens)
--    - Require a verification key witness to be spent
--    - Not be locked by a script
--
-- UTxOs of this kind are sometimes referred to as "VK" inputs.

module Cardano.Wallet.Primitive.Collateral
    (
    -- * Data types
      AddressType(..)
    , Credential(..)

    -- * Classifying address types
    , asCollateral
    , addressSuitableForCollateral
    , addressTypeSuitableForCollateral

    -- * Reading address types
    , addressTypeFromHeaderNibble
    , getAddressType
    , addressType

    -- * Writing address types
    , addressTypeToHeaderNibble
    , putAddressType
    ) where

import Prelude

import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxOut (..) )
import Data.Word
    ( Word8 )
import Data.Word.Odd
    ( Word4 )

import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Data.Binary.Get as B
import qualified Data.Binary.Put as B
import qualified Data.Bits as Bits
import qualified Data.ByteString.Lazy as BL

-- In the realm of cardano-ledger-specs, we recognize the following types of
-- addresses:
--   (see https://hydra.iohk.io/build/6752483/download/1/ledger-spec.pdf):
--
-- | Address type       | Payment Credential | Stake Credential | Header, first nibble |
-- |--------------------+--------------------+------------------+----------------------|
-- | Base address       | keyhash            | keyhash          |                 0000 |
-- |                    | scripthash         | keyhash          |                 0001 |
-- |                    | keyhash            | scripthash       |                 0010 |
-- |                    | scripthash         | scripthash       |                 0011 |
-- | Pointer address    | keyhash            | ptr              |                 0100 |
-- |                    | scripthash         | ptr              |                 0101 |
-- | Enterprise address | keyhash            | -                |                 0110 |
-- |                    | scripthash         | 0                |                 0111 |
-- | Bootstrap address  | keyhash            | -                |                 1000 |
-- | Stake address      | -                  | keyhash          |                 1110 |
-- |                    | -                  | scripthash       |                 1111 |
-- | Future formats     | ?                  | ?                |            1001-1101 |
--
-- We represent these types of addresses with the following data types:

-- | The type of the address.
data AddressType
    = BaseAddress Credential Credential
    | PointerAddress Credential
    | EnterpriseAddress Credential
    | StakeAddress Credential
    | BootstrapAddress
    -- ^ A Bootstrap (a.k.a. Byron) address
    deriving (AddressType -> AddressType -> Bool
(AddressType -> AddressType -> Bool)
-> (AddressType -> AddressType -> Bool) -> Eq AddressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressType -> AddressType -> Bool
$c/= :: AddressType -> AddressType -> Bool
== :: AddressType -> AddressType -> Bool
$c== :: AddressType -> AddressType -> Bool
Eq, Int -> AddressType -> ShowS
[AddressType] -> ShowS
AddressType -> String
(Int -> AddressType -> ShowS)
-> (AddressType -> String)
-> ([AddressType] -> ShowS)
-> Show AddressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressType] -> ShowS
$cshowList :: [AddressType] -> ShowS
show :: AddressType -> String
$cshow :: AddressType -> String
showsPrec :: Int -> AddressType -> ShowS
$cshowsPrec :: Int -> AddressType -> ShowS
Show)

-- | The type of the credential used in an address.
data Credential
    = CredentialKeyHash
    | CredentialScriptHash
    deriving (Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: Credential -> Credential -> Bool
Eq, Int -> Credential -> ShowS
[Credential] -> ShowS
Credential -> String
(Int -> Credential -> ShowS)
-> (Credential -> String)
-> ([Credential] -> ShowS)
-> Show Credential
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential] -> ShowS
$cshowList :: [Credential] -> ShowS
show :: Credential -> String
$cshow :: Credential -> String
showsPrec :: Int -> Credential -> ShowS
$cshowsPrec :: Int -> Credential -> ShowS
Show)

-- To parse the address type, we can inspect the first four bits (nibble) of the
-- address:

-- | Construct an @AddressType@ from the binary representation.
addressTypeFromHeaderNibble :: Word4 -> Maybe AddressType
addressTypeFromHeaderNibble :: Word4 -> Maybe AddressType
addressTypeFromHeaderNibble = \case
    Word4
0b0000 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> Credential -> AddressType
BaseAddress Credential
CredentialKeyHash Credential
CredentialKeyHash)
    Word4
0b0001 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> Credential -> AddressType
BaseAddress Credential
CredentialScriptHash Credential
CredentialKeyHash)
    Word4
0b0010 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> Credential -> AddressType
BaseAddress Credential
CredentialKeyHash Credential
CredentialScriptHash)
    Word4
0b0011 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> Credential -> AddressType
BaseAddress Credential
CredentialScriptHash Credential
CredentialScriptHash)
    Word4
0b0100 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> AddressType
PointerAddress Credential
CredentialKeyHash)
    Word4
0b0101 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> AddressType
PointerAddress Credential
CredentialScriptHash)
    Word4
0b0110 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> AddressType
EnterpriseAddress Credential
CredentialKeyHash)
    Word4
0b0111 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> AddressType
EnterpriseAddress Credential
CredentialScriptHash)
    Word4
0b1000 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (AddressType
BootstrapAddress)
    Word4
0b1110 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> AddressType
StakeAddress Credential
CredentialKeyHash)
    Word4
0b1111 -> AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just (Credential -> AddressType
StakeAddress Credential
CredentialScriptHash)
    Word4
_      -> Maybe AddressType
forall a. Maybe a
Nothing

-- | Get an AddressType from a binary stream.
getAddressType :: B.Get AddressType
getAddressType :: Get AddressType
getAddressType = do
    Word8
headerAndNetwork <- Get Word8
B.getWord8
    let headerNibble :: Word4
headerNibble =
            Word8 -> Word4
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Word4 (Word8
headerAndNetwork Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.shiftR` Int
4)
    Get AddressType
-> (AddressType -> Get AddressType)
-> Maybe AddressType
-> Get AddressType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (String -> Get AddressType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown address type.")
        (AddressType -> Get AddressType
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        (Word4 -> Maybe AddressType
addressTypeFromHeaderNibble Word4
headerNibble)

-- For testing and other purposes, it is also helpful to have a way of writing
-- the AddressType back to a binary stream.

-- | Return the binary representation of an @AddressType@.
addressTypeToHeaderNibble :: AddressType -> Word4
addressTypeToHeaderNibble :: AddressType -> Word4
addressTypeToHeaderNibble = \case
    BaseAddress Credential
CredentialKeyHash Credential
CredentialKeyHash       -> Word4
0b0000
    BaseAddress Credential
CredentialScriptHash Credential
CredentialKeyHash    -> Word4
0b0001
    BaseAddress Credential
CredentialKeyHash Credential
CredentialScriptHash    -> Word4
0b0010
    BaseAddress Credential
CredentialScriptHash Credential
CredentialScriptHash -> Word4
0b0011
    PointerAddress Credential
CredentialKeyHash                      -> Word4
0b0100
    PointerAddress Credential
CredentialScriptHash                   -> Word4
0b0101
    EnterpriseAddress Credential
CredentialKeyHash                   -> Word4
0b0110
    EnterpriseAddress Credential
CredentialScriptHash                -> Word4
0b0111
    AddressType
BootstrapAddress                                      -> Word4
0b1000
    StakeAddress Credential
CredentialKeyHash                        -> Word4
0b1110
    StakeAddress Credential
CredentialScriptHash                     -> Word4
0b1111

-- | Write an AddressType to a binary stream.
putAddressType :: AddressType -> B.Put
putAddressType :: AddressType -> Put
putAddressType AddressType
t =
    Word8 -> Put
B.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$
    Word4 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word4 @Word8 (AddressType -> Word4
addressTypeToHeaderNibble AddressType
t) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`Bits.shiftL` Int
4

-- | Indicates whether or not the given address is suitable for collateral.
--
addressSuitableForCollateral :: Address -> Bool
addressSuitableForCollateral :: Address -> Bool
addressSuitableForCollateral =
    Bool -> (AddressType -> Bool) -> Maybe AddressType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False AddressType -> Bool
addressTypeSuitableForCollateral (Maybe AddressType -> Bool)
-> (Address -> Maybe AddressType) -> Address -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Maybe AddressType
addressType

-- By inspecting the bit pattern of an Address, we can determine its address
-- type.

-- | Get the address type of a given address.
addressType :: Address -> Maybe AddressType
addressType :: Address -> Maybe AddressType
addressType (Address ByteString
bytes) =
    case Get AddressType
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, AddressType)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
B.runGetOrFail Get AddressType
getAddressType (ByteString -> ByteString
BL.fromStrict ByteString
bytes) of
        Left (ByteString, ByteOffset, String)
_ ->
            Maybe AddressType
forall a. Maybe a
Nothing
        Right (ByteString
_, ByteOffset
_, AddressType
addrType) ->
            AddressType -> Maybe AddressType
forall a. a -> Maybe a
Just AddressType
addrType

-- The funds associated with an address are considered suitable for use as
-- collateral iff the payment credential column of that address is "key hash".

-- | A simple function which determines if an @AddressType@ is suitable for use
-- as collateral. Only @AddressType@s with a "key hash" payment credential are
-- considered suitable for use as collateral.
addressTypeSuitableForCollateral :: AddressType -> Bool
addressTypeSuitableForCollateral :: AddressType -> Bool
addressTypeSuitableForCollateral = \case
    BaseAddress Credential
CredentialKeyHash Credential
CredentialKeyHash       -> Bool
True
    BaseAddress Credential
CredentialKeyHash Credential
CredentialScriptHash    -> Bool
True
    BaseAddress Credential
CredentialScriptHash Credential
CredentialKeyHash    -> Bool
False
    BaseAddress Credential
CredentialScriptHash Credential
CredentialScriptHash -> Bool
False
    PointerAddress Credential
CredentialKeyHash                      -> Bool
True
    PointerAddress Credential
CredentialScriptHash                   -> Bool
False
    EnterpriseAddress Credential
CredentialKeyHash                   -> Bool
True
    EnterpriseAddress Credential
CredentialScriptHash                -> Bool
False
    StakeAddress Credential
CredentialKeyHash                        -> Bool
False
    StakeAddress Credential
CredentialScriptHash                     -> Bool
False
    AddressType
BootstrapAddress                                      -> Bool
True

-- | If the given @TxOut@ represents a UTxO that is suitable for use as
-- a collateral input, returns @Just@ along with the total ADA value of the
-- UTxO. Otherwise returns @Nothing@ if it is not a suitable collateral value.
asCollateral
    :: TxOut
    -- ^ TxOut from a UTxO entry
    -> Maybe Coin
    -- ^ The total ADA value of that UTxO if it is suitable for collateral,
    -- otherwise Nothing.
asCollateral :: TxOut -> Maybe Coin
asCollateral TxOut
txOut
    | Address -> Bool
addressSuitableForCollateral (TxOut -> Address
address TxOut
txOut) =
        TokenBundle -> Maybe Coin
TokenBundle.toCoin (TxOut -> TokenBundle
tokens TxOut
txOut)
    | Bool
otherwise =
        Maybe Coin
forall a. Maybe a
Nothing