{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.Common.AddrSpendingData
  ( AddrSpendingData (..),
    AddrType (..),
    addrSpendingDataToType,
  )
where

import Cardano.Binary
  ( Case (..),
    DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLenCanonical,
    decodeWord8Canonical,
    encodeListLen,
    matchSize,
    szCases,
  )
import Cardano.Crypto.Signing (RedeemVerificationKey, VerificationKey)
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint, build)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

-- | Data which is bound to an address and must be revealed in order to spend
--   lovelace belonging to this address.
data AddrSpendingData
  = -- | Funds can be spent by revealing a 'VerificationKey' and providing a valid
    --   signature
    VerKeyASD !VerificationKey
  | -- | Funds can be spent by revealing a 'RedeemVerificationKey' and providing a
    --   valid signature
    RedeemASD !RedeemVerificationKey
  deriving (AddrSpendingData -> AddrSpendingData -> Bool
(AddrSpendingData -> AddrSpendingData -> Bool)
-> (AddrSpendingData -> AddrSpendingData -> Bool)
-> Eq AddrSpendingData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddrSpendingData -> AddrSpendingData -> Bool
$c/= :: AddrSpendingData -> AddrSpendingData -> Bool
== :: AddrSpendingData -> AddrSpendingData -> Bool
$c== :: AddrSpendingData -> AddrSpendingData -> Bool
Eq, (forall x. AddrSpendingData -> Rep AddrSpendingData x)
-> (forall x. Rep AddrSpendingData x -> AddrSpendingData)
-> Generic AddrSpendingData
forall x. Rep AddrSpendingData x -> AddrSpendingData
forall x. AddrSpendingData -> Rep AddrSpendingData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddrSpendingData x -> AddrSpendingData
$cfrom :: forall x. AddrSpendingData -> Rep AddrSpendingData x
Generic, Int -> AddrSpendingData -> ShowS
[AddrSpendingData] -> ShowS
AddrSpendingData -> String
(Int -> AddrSpendingData -> ShowS)
-> (AddrSpendingData -> String)
-> ([AddrSpendingData] -> ShowS)
-> Show AddrSpendingData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrSpendingData] -> ShowS
$cshowList :: [AddrSpendingData] -> ShowS
show :: AddrSpendingData -> String
$cshow :: AddrSpendingData -> String
showsPrec :: Int -> AddrSpendingData -> ShowS
$cshowsPrec :: Int -> AddrSpendingData -> ShowS
Show)
  deriving anyclass (AddrSpendingData -> ()
(AddrSpendingData -> ()) -> NFData AddrSpendingData
forall a. (a -> ()) -> NFData a
rnf :: AddrSpendingData -> ()
$crnf :: AddrSpendingData -> ()
NFData)

instance B.Buildable AddrSpendingData where
  build :: AddrSpendingData -> Builder
build = \case
    VerKeyASD VerificationKey
vk -> Format Builder (VerificationKey -> Builder)
-> VerificationKey -> Builder
forall a. Format Builder a -> a
bprint (Format (VerificationKey -> Builder) (VerificationKey -> Builder)
"VerKeyASD " Format (VerificationKey -> Builder) (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (VerificationKey -> Builder)
forall a r. Buildable a => Format r (a -> r)
build) VerificationKey
vk
    RedeemASD RedeemVerificationKey
rvk -> Format Builder (RedeemVerificationKey -> Builder)
-> RedeemVerificationKey -> Builder
forall a. Format Builder a -> a
bprint (Format
  (RedeemVerificationKey -> Builder)
  (RedeemVerificationKey -> Builder)
"RedeemASD " Format
  (RedeemVerificationKey -> Builder)
  (RedeemVerificationKey -> Builder)
-> Format Builder (RedeemVerificationKey -> Builder)
-> Format Builder (RedeemVerificationKey -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (RedeemVerificationKey -> Builder)
forall a r. Buildable a => Format r (a -> r)
build) RedeemVerificationKey
rvk

-- Tag 1 was previously used for scripts, but never appeared on the chain
instance ToCBOR AddrSpendingData where
  toCBOR :: AddrSpendingData -> Encoding
toCBOR = \case
    VerKeyASD VerificationKey
vk -> Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VerificationKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VerificationKey
vk
    RedeemASD RedeemVerificationKey
redeemVK ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RedeemVerificationKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR RedeemVerificationKey
redeemVK

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy AddrSpendingData -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy AddrSpendingData
_ =
    [Case Size] -> Size
szCases
      [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"VerKeyASD" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy (Word8, VerificationKey) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (Word8, VerificationKey) -> Size)
-> Proxy (Word8, VerificationKey) -> Size
forall a b. (a -> b) -> a -> b
$ Proxy (Word8, VerificationKey)
forall k (t :: k). Proxy t
Proxy @(Word8, VerificationKey),
        Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"RedeemASD" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ Proxy (Word8, RedeemVerificationKey) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (Word8, RedeemVerificationKey) -> Size)
-> Proxy (Word8, RedeemVerificationKey) -> Size
forall a b. (a -> b) -> a -> b
$ Proxy (Word8, RedeemVerificationKey)
forall k (t :: k). Proxy t
Proxy @(Word8, RedeemVerificationKey)
      ]

instance FromCBOR AddrSpendingData where
  fromCBOR :: Decoder s AddrSpendingData
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLenCanonical
    Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"AddrSpendingData" Int
2 Int
len
    Decoder s Word8
forall s. Decoder s Word8
decodeWord8Canonical Decoder s Word8
-> (Word8 -> Decoder s AddrSpendingData)
-> Decoder s AddrSpendingData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> VerificationKey -> AddrSpendingData
VerKeyASD (VerificationKey -> AddrSpendingData)
-> Decoder s VerificationKey -> Decoder s AddrSpendingData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s VerificationKey
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
2 -> RedeemVerificationKey -> AddrSpendingData
RedeemASD (RedeemVerificationKey -> AddrSpendingData)
-> Decoder s RedeemVerificationKey -> Decoder s AddrSpendingData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s RedeemVerificationKey
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
tag -> DecoderError -> Decoder s AddrSpendingData
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s AddrSpendingData)
-> DecoderError -> Decoder s AddrSpendingData
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"AddrSpendingData" Word8
tag

-- | Type of an address. It corresponds to constructors of 'AddrSpendingData'.
--   It's separated, because 'Address' doesn't store 'AddrSpendingData', but we
--   want to know its type.
data AddrType
  = ATVerKey
  | ATRedeem
  deriving (AddrType -> AddrType -> Bool
(AddrType -> AddrType -> Bool)
-> (AddrType -> AddrType -> Bool) -> Eq AddrType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddrType -> AddrType -> Bool
$c/= :: AddrType -> AddrType -> Bool
== :: AddrType -> AddrType -> Bool
$c== :: AddrType -> AddrType -> Bool
Eq, Eq AddrType
Eq AddrType
-> (AddrType -> AddrType -> Ordering)
-> (AddrType -> AddrType -> Bool)
-> (AddrType -> AddrType -> Bool)
-> (AddrType -> AddrType -> Bool)
-> (AddrType -> AddrType -> Bool)
-> (AddrType -> AddrType -> AddrType)
-> (AddrType -> AddrType -> AddrType)
-> Ord AddrType
AddrType -> AddrType -> Bool
AddrType -> AddrType -> Ordering
AddrType -> AddrType -> AddrType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AddrType -> AddrType -> AddrType
$cmin :: AddrType -> AddrType -> AddrType
max :: AddrType -> AddrType -> AddrType
$cmax :: AddrType -> AddrType -> AddrType
>= :: AddrType -> AddrType -> Bool
$c>= :: AddrType -> AddrType -> Bool
> :: AddrType -> AddrType -> Bool
$c> :: AddrType -> AddrType -> Bool
<= :: AddrType -> AddrType -> Bool
$c<= :: AddrType -> AddrType -> Bool
< :: AddrType -> AddrType -> Bool
$c< :: AddrType -> AddrType -> Bool
compare :: AddrType -> AddrType -> Ordering
$ccompare :: AddrType -> AddrType -> Ordering
$cp1Ord :: Eq AddrType
Ord, (forall x. AddrType -> Rep AddrType x)
-> (forall x. Rep AddrType x -> AddrType) -> Generic AddrType
forall x. Rep AddrType x -> AddrType
forall x. AddrType -> Rep AddrType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddrType x -> AddrType
$cfrom :: forall x. AddrType -> Rep AddrType x
Generic, Int -> AddrType -> ShowS
[AddrType] -> ShowS
AddrType -> String
(Int -> AddrType -> ShowS)
-> (AddrType -> String) -> ([AddrType] -> ShowS) -> Show AddrType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrType] -> ShowS
$cshowList :: [AddrType] -> ShowS
show :: AddrType -> String
$cshow :: AddrType -> String
showsPrec :: Int -> AddrType -> ShowS
$cshowsPrec :: Int -> AddrType -> ShowS
Show)
  deriving anyclass (AddrType -> ()
(AddrType -> ()) -> NFData AddrType
forall a. (a -> ()) -> NFData a
rnf :: AddrType -> ()
$crnf :: AddrType -> ()
NFData, Context -> AddrType -> IO (Maybe ThunkInfo)
Proxy AddrType -> String
(Context -> AddrType -> IO (Maybe ThunkInfo))
-> (Context -> AddrType -> IO (Maybe ThunkInfo))
-> (Proxy AddrType -> String)
-> NoThunks AddrType
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy AddrType -> String
$cshowTypeOf :: Proxy AddrType -> String
wNoThunks :: Context -> AddrType -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AddrType -> IO (Maybe ThunkInfo)
noThunks :: Context -> AddrType -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> AddrType -> IO (Maybe ThunkInfo)
NoThunks)

-- Used for debugging purposes only
instance ToJSON AddrType

-- Tag 1 was previously used for scripts, but never appeared on the chain
instance ToCBOR AddrType where
  toCBOR :: AddrType -> Encoding
toCBOR =
    ToCBOR Word8 => Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 (Word8 -> Encoding) -> (AddrType -> Word8) -> AddrType -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
      AddrType
ATVerKey -> Word8
0
      AddrType
ATRedeem -> Word8
2

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy AddrType -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy AddrType
_ = (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word8 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy Word8
forall k (t :: k). Proxy t
Proxy @Word8)

instance FromCBOR AddrType where
  fromCBOR :: Decoder s AddrType
fromCBOR =
    Decoder s Word8
forall s. Decoder s Word8
decodeWord8Canonical Decoder s Word8
-> (Word8 -> Decoder s AddrType) -> Decoder s AddrType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> AddrType -> Decoder s AddrType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATVerKey
      Word8
2 -> AddrType -> Decoder s AddrType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATRedeem
      Word8
tag -> DecoderError -> Decoder s AddrType
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s AddrType)
-> DecoderError -> Decoder s AddrType
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"AddrType" Word8
tag

instance HeapWords AddrType where
  heapWords :: AddrType -> Int
heapWords = \case
    AddrType
ATVerKey -> Int
0
    AddrType
ATRedeem -> Int
0

-- | Convert 'AddrSpendingData' to the corresponding 'AddrType'
addrSpendingDataToType :: AddrSpendingData -> AddrType
addrSpendingDataToType :: AddrSpendingData -> AddrType
addrSpendingDataToType = \case
  VerKeyASD {} -> AddrType
ATVerKey
  RedeemASD {} -> AddrType
ATRedeem