# 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
    ( 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 -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 (Eq, Show)

-- | The type of the credential used in an address.
data Credential
    = CredentialKeyHash
    | CredentialScriptHash
    deriving (Eq, 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 = \case
    0b0000 -> Just (BaseAddress CredentialKeyHash CredentialKeyHash)
    0b0001 -> Just (BaseAddress CredentialScriptHash CredentialKeyHash)
    0b0010 -> Just (BaseAddress CredentialKeyHash CredentialScriptHash)
    0b0011 -> Just (BaseAddress CredentialScriptHash CredentialScriptHash)
    0b0100 -> Just (PointerAddress CredentialKeyHash)
    0b0101 -> Just (PointerAddress CredentialScriptHash)
    0b0110 -> Just (EnterpriseAddress CredentialKeyHash)
    0b0111 -> Just (EnterpriseAddress CredentialScriptHash)
    0b1000 -> Just (BootstrapAddress)
    0b1110 -> Just (StakeAddress CredentialKeyHash)
    0b1111 -> Just (StakeAddress CredentialScriptHash)
    _      -> Nothing

  | Get an AddressType from a binary stream .
getAddressType :: B.Get AddressType
getAddressType = do
    headerAndNetwork <- B.getWord8
    let headerNibble =
            fromIntegral @Word8 @Word4 (headerAndNetwork `Bits.shiftR` 4)
    maybe
        (fail "Unknown address type.")
        (pure)
        (addressTypeFromHeaderNibble 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 = \case
    BaseAddress CredentialKeyHash CredentialKeyHash       -> 0b0000
    BaseAddress CredentialScriptHash CredentialKeyHash    -> 0b0001
    BaseAddress CredentialKeyHash CredentialScriptHash    -> 0b0010
    BaseAddress CredentialScriptHash CredentialScriptHash -> 0b0011
    PointerAddress CredentialKeyHash                      -> 0b0100
    PointerAddress CredentialScriptHash                   -> 0b0101
    EnterpriseAddress CredentialKeyHash                   -> 0b0110
    EnterpriseAddress CredentialScriptHash                -> 0b0111
    BootstrapAddress                                      -> 0b1000
    StakeAddress CredentialKeyHash                        -> 0b1110
    StakeAddress CredentialScriptHash                     -> 0b1111

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

-- | Indicates whether or not the given address is suitable for collateral.
--
addressSuitableForCollateral :: Address -> Bool
addressSuitableForCollateral =
    maybe False addressTypeSuitableForCollateral . 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 bytes) =
    case B.runGetOrFail getAddressType (BL.fromStrict bytes) of
        Left _ ->
            Nothing
        Right (_, _, addrType) ->
            Just 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  with a " key hash " payment credential are
-- considered suitable for use as collateral.
addressTypeSuitableForCollateral :: AddressType -> Bool
addressTypeSuitableForCollateral = \case
    BaseAddress CredentialKeyHash CredentialKeyHash       -> True
    BaseAddress CredentialKeyHash CredentialScriptHash    -> True
    BaseAddress CredentialScriptHash CredentialKeyHash    -> False
    BaseAddress CredentialScriptHash CredentialScriptHash -> False
    PointerAddress CredentialKeyHash                      -> True
    PointerAddress CredentialScriptHash                   -> False
    EnterpriseAddress CredentialKeyHash                   -> True
    EnterpriseAddress CredentialScriptHash                -> False
    StakeAddress CredentialKeyHash                        -> False
    StakeAddress CredentialScriptHash                     -> False
    BootstrapAddress                                      -> 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  if it is suitable for collateral ,
    -- otherwise Nothing.
asCollateral txOut
    | addressSuitableForCollateral (address txOut) =
        TokenBundle.toCoin (tokens txOut)
    | otherwise =
        Nothing

 |
 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.
 * Data types
 * Classifying address types
 * Reading address types
 * Writing address types
 In the realm of cardano-ledger-specs, we recognize the following types of
 addresses:
   (see -spec.pdf):

 | Address type       | Payment Credential | Stake Credential | Header, first nibble |
 |--------------------+--------------------+------------------+----------------------|
 | Base address       | keyhash            | keyhash          |                 0000 |
 |                    | 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.
 | The type of the credential used in an address.
 address:
 | Construct an @AddressType@ from the binary representation.
 For testing and other purposes, it is also helpful to have a way of writing
 | Return the binary representation of an @AddressType@.
 | Indicates whether or not the given address is suitable for collateral.

 By inspecting the bit pattern of an Address, we can determine its address
 type.
 | Get the address type of a given address.
 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
 considered suitable for use as collateral.
 | 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
 otherwise Nothing.
# LANGUAGE BinaryLiterals #
# LANGUAGE DataKinds #
# LANGUAGE LambdaCase #
# LANGUAGE ScopedTypeVariables #
# LANGUAGE TypeApplications #


module Cardano.Wallet.Primitive.Collateral
    (
      AddressType(..)
    , Credential(..)

    , asCollateral
    , addressSuitableForCollateral
    , addressTypeSuitableForCollateral

    , addressTypeFromHeaderNibble
    , getAddressType
    , addressType

    , 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
    ( 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

  |                     | scripthash          | keyhash           |                  0001 |
  |                     | keyhash             | scripthash        |                  0010 |

data AddressType
    = BaseAddress Credential Credential
    | PointerAddress Credential
    | EnterpriseAddress Credential
    | StakeAddress Credential
    | BootstrapAddress
  ^ A Bootstrap ( a.k.a . Byron ) address
    deriving (Eq, Show)

data Credential
    = CredentialKeyHash
    | CredentialScriptHash
    deriving (Eq, Show)

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

addressTypeFromHeaderNibble :: Word4 -> Maybe AddressType
addressTypeFromHeaderNibble = \case
    0b0000 -> Just (BaseAddress CredentialKeyHash CredentialKeyHash)
    0b0001 -> Just (BaseAddress CredentialScriptHash CredentialKeyHash)
    0b0010 -> Just (BaseAddress CredentialKeyHash CredentialScriptHash)
    0b0011 -> Just (BaseAddress CredentialScriptHash CredentialScriptHash)
    0b0100 -> Just (PointerAddress CredentialKeyHash)
    0b0101 -> Just (PointerAddress CredentialScriptHash)
    0b0110 -> Just (EnterpriseAddress CredentialKeyHash)
    0b0111 -> Just (EnterpriseAddress CredentialScriptHash)
    0b1000 -> Just (BootstrapAddress)
    0b1110 -> Just (StakeAddress CredentialKeyHash)
    0b1111 -> Just (StakeAddress CredentialScriptHash)
    _      -> Nothing

  | Get an AddressType from a binary stream .
getAddressType :: B.Get AddressType
getAddressType = do
    headerAndNetwork <- B.getWord8
    let headerNibble =
            fromIntegral @Word8 @Word4 (headerAndNetwork `Bits.shiftR` 4)
    maybe
        (fail "Unknown address type.")
        (pure)
        (addressTypeFromHeaderNibble headerNibble)

  the AddressType back to a binary stream .

addressTypeToHeaderNibble :: AddressType -> Word4
addressTypeToHeaderNibble = \case
    BaseAddress CredentialKeyHash CredentialKeyHash       -> 0b0000
    BaseAddress CredentialScriptHash CredentialKeyHash    -> 0b0001
    BaseAddress CredentialKeyHash CredentialScriptHash    -> 0b0010
    BaseAddress CredentialScriptHash CredentialScriptHash -> 0b0011
    PointerAddress CredentialKeyHash                      -> 0b0100
    PointerAddress CredentialScriptHash                   -> 0b0101
    EnterpriseAddress CredentialKeyHash                   -> 0b0110
    EnterpriseAddress CredentialScriptHash                -> 0b0111
    BootstrapAddress                                      -> 0b1000
    StakeAddress CredentialKeyHash                        -> 0b1110
    StakeAddress CredentialScriptHash                     -> 0b1111

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

addressSuitableForCollateral :: Address -> Bool
addressSuitableForCollateral =
    maybe False addressTypeSuitableForCollateral . addressType


addressType :: Address -> Maybe AddressType
addressType (Address bytes) =
    case B.runGetOrFail getAddressType (BL.fromStrict bytes) of
        Left _ ->
            Nothing
        Right (_, _, addrType) ->
            Just addrType


  as collateral . Only  with a " key hash " payment credential are
addressTypeSuitableForCollateral :: AddressType -> Bool
addressTypeSuitableForCollateral = \case
    BaseAddress CredentialKeyHash CredentialKeyHash       -> True
    BaseAddress CredentialKeyHash CredentialScriptHash    -> True
    BaseAddress CredentialScriptHash CredentialKeyHash    -> False
    BaseAddress CredentialScriptHash CredentialScriptHash -> False
    PointerAddress CredentialKeyHash                      -> True
    PointerAddress CredentialScriptHash                   -> False
    EnterpriseAddress CredentialKeyHash                   -> True
    EnterpriseAddress CredentialScriptHash                -> False
    StakeAddress CredentialKeyHash                        -> False
    StakeAddress CredentialScriptHash                     -> False
    BootstrapAddress                                      -> True

  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  if it is suitable for collateral ,
asCollateral txOut
    | addressSuitableForCollateral (address txOut) =
        TokenBundle.toCoin (tokens txOut)
    | otherwise =
        Nothing
