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

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

import Cardano.Crypto.Signing (RedeemVerificationKey, VerificationKey)
import Cardano.HeapWords
import Cardano.Ledger.Binary (
  Case (..),
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeListLenCanonical,
  decodeWord8Canonical,
  encodeListLen,
  fromByronCBOR,
  matchSize,
  szCases,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)
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
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. 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: AddrSpendingData -> ()
$crnf :: AddrSpendingData -> ()
NFData)

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

instance ToCBOR AddrSpendingData where
  toCBOR :: AddrSpendingData -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR AddrSpendingData where
  fromCBOR :: forall s. Decoder s AddrSpendingData
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

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

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

instance DecCBOR AddrSpendingData where
  decCBOR :: forall s. Decoder s AddrSpendingData
decCBOR = do
    Int
len <- forall s. Decoder s Int
decodeListLenCanonical
    forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"AddrSpendingData" Int
2 Int
len
    forall s. Decoder s Word8
decodeWord8Canonical forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> VerificationKey -> AddrSpendingData
VerKeyASD forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
2 -> RedeemVerificationKey -> AddrSpendingData
RedeemASD forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
tag -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError 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
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
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
Ord, 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: AddrType -> ()
$crnf :: AddrType -> ()
NFData, Context -> AddrType -> IO (Maybe ThunkInfo)
Proxy AddrType -> String
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

instance ToCBOR AddrType where
  toCBOR :: AddrType -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR AddrType where
  fromCBOR :: forall s. Decoder s AddrType
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Tag 1 was previously used for scripts, but never appeared on the chain
instance EncCBOR AddrType where
  encCBOR :: AddrType -> Encoding
encCBOR =
    forall a. EncCBOR a => a -> Encoding
encCBOR @Word8 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. EncCBOR t => Proxy t -> Size) -> Proxy AddrType -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy AddrType
_ = forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @Word8)

instance DecCBOR AddrType where
  decCBOR :: forall s. Decoder s AddrType
decCBOR =
    forall s. Decoder s Word8
decodeWord8Canonical forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATVerKey
      Word8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrType
ATRedeem
      Word8
tag -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError 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