{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Shelley.Spec.Ledger.Credential
  ( Credential (KeyHashObj, ScriptHashObj),
    GenesisCredential (..),
    Ix,
    PaymentCredential,
    Ptr (..),
    StakeCredential,
    StakeReference (..),
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Crypto, Era)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey, (.:), (.=))
import qualified Data.Aeson as Aeson
import Data.Foldable (asum)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
import Quiet
import Shelley.Spec.Ledger.BaseTypes (invalidKey)
import Shelley.Spec.Ledger.Keys
  ( HasKeyRole (..),
    KeyHash,
    KeyRole (..),
  )
import Shelley.Spec.Ledger.Orphans ()
import Shelley.Spec.Ledger.Scripts (ScriptHash)
import Shelley.Spec.Ledger.Serialization
  ( CBORGroup (..),
    FromCBORGroup (..),
    ToCBORGroup (..),
    decodeRecordSum,
  )
import Shelley.Spec.Ledger.Slot (SlotNo (..))

-- | Script hash or key hash for a payment or a staking object.
--
-- Note that credentials (unlike raw key hashes) do appear to vary from era to
-- era, since they reference the hash of a script, which can change. This
-- parameter is a phantom, however, so in actuality the instances will remain
-- the same.
data Credential (kr :: KeyRole) era
  = ScriptHashObj {-# UNPACK #-} !(ScriptHash era)
  | KeyHashObj {-# UNPACK #-} !(KeyHash kr (Crypto era))
  deriving (Int -> Credential kr era -> ShowS
[Credential kr era] -> ShowS
Credential kr era -> String
(Int -> Credential kr era -> ShowS)
-> (Credential kr era -> String)
-> ([Credential kr era] -> ShowS)
-> Show (Credential kr era)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (kr :: KeyRole) era. Int -> Credential kr era -> ShowS
forall (kr :: KeyRole) era. [Credential kr era] -> ShowS
forall (kr :: KeyRole) era. Credential kr era -> String
showList :: [Credential kr era] -> ShowS
$cshowList :: forall (kr :: KeyRole) era. [Credential kr era] -> ShowS
show :: Credential kr era -> String
$cshow :: forall (kr :: KeyRole) era. Credential kr era -> String
showsPrec :: Int -> Credential kr era -> ShowS
$cshowsPrec :: forall (kr :: KeyRole) era. Int -> Credential kr era -> ShowS
Show, Credential kr era -> Credential kr era -> Bool
(Credential kr era -> Credential kr era -> Bool)
-> (Credential kr era -> Credential kr era -> Bool)
-> Eq (Credential kr era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
/= :: Credential kr era -> Credential kr era -> Bool
$c/= :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
== :: Credential kr era -> Credential kr era -> Bool
$c== :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
Eq, (forall x. Credential kr era -> Rep (Credential kr era) x)
-> (forall x. Rep (Credential kr era) x -> Credential kr era)
-> Generic (Credential kr era)
forall x. Rep (Credential kr era) x -> Credential kr era
forall x. Credential kr era -> Rep (Credential kr era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kr :: KeyRole) era x.
Rep (Credential kr era) x -> Credential kr era
forall (kr :: KeyRole) era x.
Credential kr era -> Rep (Credential kr era) x
$cto :: forall (kr :: KeyRole) era x.
Rep (Credential kr era) x -> Credential kr era
$cfrom :: forall (kr :: KeyRole) era x.
Credential kr era -> Rep (Credential kr era) x
Generic, Credential kr era -> ()
(Credential kr era -> ()) -> NFData (Credential kr era)
forall a. (a -> ()) -> NFData a
forall (kr :: KeyRole) era. Credential kr era -> ()
rnf :: Credential kr era -> ()
$crnf :: forall (kr :: KeyRole) era. Credential kr era -> ()
NFData, Eq (Credential kr era)
Eq (Credential kr era)
-> (Credential kr era -> Credential kr era -> Ordering)
-> (Credential kr era -> Credential kr era -> Bool)
-> (Credential kr era -> Credential kr era -> Bool)
-> (Credential kr era -> Credential kr era -> Bool)
-> (Credential kr era -> Credential kr era -> Bool)
-> (Credential kr era -> Credential kr era -> Credential kr era)
-> (Credential kr era -> Credential kr era -> Credential kr era)
-> Ord (Credential kr era)
Credential kr era -> Credential kr era -> Bool
Credential kr era -> Credential kr era -> Ordering
Credential kr era -> Credential kr era -> Credential kr era
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
forall (kr :: KeyRole) era. Eq (Credential kr era)
forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Ordering
forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Credential kr era
min :: Credential kr era -> Credential kr era -> Credential kr era
$cmin :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Credential kr era
max :: Credential kr era -> Credential kr era -> Credential kr era
$cmax :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Credential kr era
>= :: Credential kr era -> Credential kr era -> Bool
$c>= :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
> :: Credential kr era -> Credential kr era -> Bool
$c> :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
<= :: Credential kr era -> Credential kr era -> Bool
$c<= :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
< :: Credential kr era -> Credential kr era -> Bool
$c< :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Bool
compare :: Credential kr era -> Credential kr era -> Ordering
$ccompare :: forall (kr :: KeyRole) era.
Credential kr era -> Credential kr era -> Ordering
$cp1Ord :: forall (kr :: KeyRole) era. Eq (Credential kr era)
Ord)

instance HasKeyRole Credential where
  coerceKeyRole :: Credential r crypto -> Credential r' crypto
coerceKeyRole (ScriptHashObj ScriptHash crypto
x) = ScriptHash crypto -> Credential r' crypto
forall (kr :: KeyRole) era. ScriptHash era -> Credential kr era
ScriptHashObj ScriptHash crypto
x
  coerceKeyRole (KeyHashObj KeyHash r (Crypto crypto)
x) = KeyHash r' (Crypto crypto) -> Credential r' crypto
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
KeyHashObj (KeyHash r' (Crypto crypto) -> Credential r' crypto)
-> KeyHash r' (Crypto crypto) -> Credential r' crypto
forall a b. (a -> b) -> a -> b
$ KeyHash r (Crypto crypto) -> KeyHash r' (Crypto crypto)
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
coerceKeyRole KeyHash r (Crypto crypto)
x

instance NoThunks (Credential kr era)

instance
  Era era =>
  ToJSON (Credential kr era)
  where
  toJSON :: Credential kr era -> Value
toJSON (ScriptHashObj ScriptHash era
hash) =
    [Pair] -> Value
Aeson.object
      [ Text
"script hash" Text -> ScriptHash era -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ScriptHash era
hash
      ]
  toJSON (KeyHashObj KeyHash kr (Crypto era)
hash) =
    [Pair] -> Value
Aeson.object
      [ Text
"key hash" Text -> KeyHash kr (Crypto era) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= KeyHash kr (Crypto era)
hash
      ]

instance Era era => FromJSON (Credential kr era) where
  parseJSON :: Value -> Parser (Credential kr era)
parseJSON =
    String
-> (Object -> Parser (Credential kr era))
-> Value
-> Parser (Credential kr era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Credential" ((Object -> Parser (Credential kr era))
 -> Value -> Parser (Credential kr era))
-> (Object -> Parser (Credential kr era))
-> Value
-> Parser (Credential kr era)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      [Parser (Credential kr era)] -> Parser (Credential kr era)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Object -> Parser (Credential kr era)
forall era (kr :: KeyRole).
Era era =>
Object -> Parser (Credential kr era)
parser1 Object
obj, Object -> Parser (Credential kr era)
forall era (kr :: KeyRole).
Crypto (Crypto era) =>
Object -> Parser (Credential kr era)
parser2 Object
obj]
    where
      parser1 :: Object -> Parser (Credential kr era)
parser1 Object
obj = ScriptHash era -> Credential kr era
forall (kr :: KeyRole) era. ScriptHash era -> Credential kr era
ScriptHashObj (ScriptHash era -> Credential kr era)
-> Parser (ScriptHash era) -> Parser (Credential kr era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (ScriptHash era)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"script hash"
      parser2 :: Object -> Parser (Credential kr era)
parser2 Object
obj = KeyHash kr (Crypto era) -> Credential kr era
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
KeyHashObj (KeyHash kr (Crypto era) -> Credential kr era)
-> Parser (KeyHash kr (Crypto era)) -> Parser (Credential kr era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (KeyHash kr (Crypto era))
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"key hash"

instance Era era => ToJSONKey (Credential kr era)

instance Era era => FromJSONKey (Credential kr era)

type PaymentCredential era = Credential 'Payment era

type StakeCredential era = Credential 'Staking era

data StakeReference era
  = StakeRefBase !(StakeCredential era)
  | StakeRefPtr !Ptr
  | StakeRefNull
  deriving (Int -> StakeReference era -> ShowS
[StakeReference era] -> ShowS
StakeReference era -> String
(Int -> StakeReference era -> ShowS)
-> (StakeReference era -> String)
-> ([StakeReference era] -> ShowS)
-> Show (StakeReference era)
forall era. Int -> StakeReference era -> ShowS
forall era. [StakeReference era] -> ShowS
forall era. StakeReference era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeReference era] -> ShowS
$cshowList :: forall era. [StakeReference era] -> ShowS
show :: StakeReference era -> String
$cshow :: forall era. StakeReference era -> String
showsPrec :: Int -> StakeReference era -> ShowS
$cshowsPrec :: forall era. Int -> StakeReference era -> ShowS
Show, StakeReference era -> StakeReference era -> Bool
(StakeReference era -> StakeReference era -> Bool)
-> (StakeReference era -> StakeReference era -> Bool)
-> Eq (StakeReference era)
forall era. StakeReference era -> StakeReference era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakeReference era -> StakeReference era -> Bool
$c/= :: forall era. StakeReference era -> StakeReference era -> Bool
== :: StakeReference era -> StakeReference era -> Bool
$c== :: forall era. StakeReference era -> StakeReference era -> Bool
Eq, (forall x. StakeReference era -> Rep (StakeReference era) x)
-> (forall x. Rep (StakeReference era) x -> StakeReference era)
-> Generic (StakeReference era)
forall x. Rep (StakeReference era) x -> StakeReference era
forall x. StakeReference era -> Rep (StakeReference era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (StakeReference era) x -> StakeReference era
forall era x. StakeReference era -> Rep (StakeReference era) x
$cto :: forall era x. Rep (StakeReference era) x -> StakeReference era
$cfrom :: forall era x. StakeReference era -> Rep (StakeReference era) x
Generic, StakeReference era -> ()
(StakeReference era -> ()) -> NFData (StakeReference era)
forall era. StakeReference era -> ()
forall a. (a -> ()) -> NFData a
rnf :: StakeReference era -> ()
$crnf :: forall era. StakeReference era -> ()
NFData, Eq (StakeReference era)
Eq (StakeReference era)
-> (StakeReference era -> StakeReference era -> Ordering)
-> (StakeReference era -> StakeReference era -> Bool)
-> (StakeReference era -> StakeReference era -> Bool)
-> (StakeReference era -> StakeReference era -> Bool)
-> (StakeReference era -> StakeReference era -> Bool)
-> (StakeReference era -> StakeReference era -> StakeReference era)
-> (StakeReference era -> StakeReference era -> StakeReference era)
-> Ord (StakeReference era)
StakeReference era -> StakeReference era -> Bool
StakeReference era -> StakeReference era -> Ordering
StakeReference era -> StakeReference era -> StakeReference era
forall era. Eq (StakeReference era)
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
forall era. StakeReference era -> StakeReference era -> Bool
forall era. StakeReference era -> StakeReference era -> Ordering
forall era.
StakeReference era -> StakeReference era -> StakeReference era
min :: StakeReference era -> StakeReference era -> StakeReference era
$cmin :: forall era.
StakeReference era -> StakeReference era -> StakeReference era
max :: StakeReference era -> StakeReference era -> StakeReference era
$cmax :: forall era.
StakeReference era -> StakeReference era -> StakeReference era
>= :: StakeReference era -> StakeReference era -> Bool
$c>= :: forall era. StakeReference era -> StakeReference era -> Bool
> :: StakeReference era -> StakeReference era -> Bool
$c> :: forall era. StakeReference era -> StakeReference era -> Bool
<= :: StakeReference era -> StakeReference era -> Bool
$c<= :: forall era. StakeReference era -> StakeReference era -> Bool
< :: StakeReference era -> StakeReference era -> Bool
$c< :: forall era. StakeReference era -> StakeReference era -> Bool
compare :: StakeReference era -> StakeReference era -> Ordering
$ccompare :: forall era. StakeReference era -> StakeReference era -> Ordering
$cp1Ord :: forall era. Eq (StakeReference era)
Ord)

instance NoThunks (StakeReference era)

type Ix = Natural

-- | Pointer to a slot, transaction index and index in certificate list.
data Ptr
  = Ptr !SlotNo !Ix !Ix
  deriving (Int -> Ptr -> ShowS
[Ptr] -> ShowS
Ptr -> String
(Int -> Ptr -> ShowS)
-> (Ptr -> String) -> ([Ptr] -> ShowS) -> Show Ptr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ptr] -> ShowS
$cshowList :: [Ptr] -> ShowS
show :: Ptr -> String
$cshow :: Ptr -> String
showsPrec :: Int -> Ptr -> ShowS
$cshowsPrec :: Int -> Ptr -> ShowS
Show, Ptr -> Ptr -> Bool
(Ptr -> Ptr -> Bool) -> (Ptr -> Ptr -> Bool) -> Eq Ptr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ptr -> Ptr -> Bool
$c/= :: Ptr -> Ptr -> Bool
== :: Ptr -> Ptr -> Bool
$c== :: Ptr -> Ptr -> Bool
Eq, Eq Ptr
Eq Ptr
-> (Ptr -> Ptr -> Ordering)
-> (Ptr -> Ptr -> Bool)
-> (Ptr -> Ptr -> Bool)
-> (Ptr -> Ptr -> Bool)
-> (Ptr -> Ptr -> Bool)
-> (Ptr -> Ptr -> Ptr)
-> (Ptr -> Ptr -> Ptr)
-> Ord Ptr
Ptr -> Ptr -> Bool
Ptr -> Ptr -> Ordering
Ptr -> Ptr -> Ptr
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 :: Ptr -> Ptr -> Ptr
$cmin :: Ptr -> Ptr -> Ptr
max :: Ptr -> Ptr -> Ptr
$cmax :: Ptr -> Ptr -> Ptr
>= :: Ptr -> Ptr -> Bool
$c>= :: Ptr -> Ptr -> Bool
> :: Ptr -> Ptr -> Bool
$c> :: Ptr -> Ptr -> Bool
<= :: Ptr -> Ptr -> Bool
$c<= :: Ptr -> Ptr -> Bool
< :: Ptr -> Ptr -> Bool
$c< :: Ptr -> Ptr -> Bool
compare :: Ptr -> Ptr -> Ordering
$ccompare :: Ptr -> Ptr -> Ordering
$cp1Ord :: Eq Ptr
Ord, (forall x. Ptr -> Rep Ptr x)
-> (forall x. Rep Ptr x -> Ptr) -> Generic Ptr
forall x. Rep Ptr x -> Ptr
forall x. Ptr -> Rep Ptr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ptr x -> Ptr
$cfrom :: forall x. Ptr -> Rep Ptr x
Generic, Ptr -> ()
(Ptr -> ()) -> NFData Ptr
forall a. (a -> ()) -> NFData a
rnf :: Ptr -> ()
$crnf :: Ptr -> ()
NFData, Context -> Ptr -> IO (Maybe ThunkInfo)
Proxy Ptr -> String
(Context -> Ptr -> IO (Maybe ThunkInfo))
-> (Context -> Ptr -> IO (Maybe ThunkInfo))
-> (Proxy Ptr -> String)
-> NoThunks Ptr
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Ptr -> String
$cshowTypeOf :: Proxy Ptr -> String
wNoThunks :: Context -> Ptr -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Ptr -> IO (Maybe ThunkInfo)
noThunks :: Context -> Ptr -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Ptr -> IO (Maybe ThunkInfo)
NoThunks)
  deriving (Typeable Ptr
Typeable Ptr
-> (Ptr -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size)
-> ToCBOR Ptr
Ptr -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
toCBOR :: Ptr -> Encoding
$ctoCBOR :: Ptr -> Encoding
$cp1ToCBOR :: Typeable Ptr
ToCBOR, Typeable Ptr
Decoder s Ptr
Typeable Ptr
-> (forall s. Decoder s Ptr) -> (Proxy Ptr -> Text) -> FromCBOR Ptr
Proxy Ptr -> Text
forall s. Decoder s Ptr
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy Ptr -> Text
$clabel :: Proxy Ptr -> Text
fromCBOR :: Decoder s Ptr
$cfromCBOR :: forall s. Decoder s Ptr
$cp1FromCBOR :: Typeable Ptr
FromCBOR) via CBORGroup Ptr

instance
  (Typeable kr, Era era, Typeable (Core.Script era)) =>
  ToCBOR (Credential kr era)
  where
  toCBOR :: Credential kr era -> Encoding
toCBOR = \case
    KeyHashObj KeyHash kr (Crypto era)
kh -> 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
<> KeyHash kr (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash kr (Crypto era)
kh
    ScriptHashObj ScriptHash era
hs -> 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
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ScriptHash era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ScriptHash era
hs

instance
  (Typeable kr, Era era, Typeable (Core.Script era)) =>
  FromCBOR (Credential kr era)
  where
  fromCBOR :: Decoder s (Credential kr era)
fromCBOR = String
-> (Word -> Decoder s (Int, Credential kr era))
-> Decoder s (Credential kr era)
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
"Credential" ((Word -> Decoder s (Int, Credential kr era))
 -> Decoder s (Credential kr era))
-> (Word -> Decoder s (Int, Credential kr era))
-> Decoder s (Credential kr era)
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> do
        KeyHash kr (Crypto era)
x <- Decoder s (KeyHash kr (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, Credential kr era) -> Decoder s (Int, Credential kr era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, KeyHash kr (Crypto era) -> Credential kr era
forall (kr :: KeyRole) era.
KeyHash kr (Crypto era) -> Credential kr era
KeyHashObj KeyHash kr (Crypto era)
x)
      Word
1 -> do
        ScriptHash era
x <- Decoder s (ScriptHash era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, Credential kr era) -> Decoder s (Int, Credential kr era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, ScriptHash era -> Credential kr era
forall (kr :: KeyRole) era. ScriptHash era -> Credential kr era
ScriptHashObj ScriptHash era
x)
      Word
k -> Word -> Decoder s (Int, Credential kr era)
forall s a. Word -> Decoder s a
invalidKey Word
k

instance ToCBORGroup Ptr where
  toCBORGroup :: Ptr -> Encoding
toCBORGroup (Ptr SlotNo
sl Ix
txIx Ix
certIx) =
    SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNo
sl
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Ix -> Integer
forall a. Integral a => a -> Integer
toInteger Ix
txIx) :: Word)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Ix -> Integer
forall a. Integral a => a -> Integer
toInteger Ix
certIx) :: Word)
  encodedGroupSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
encodedGroupSizeExpr forall t. ToCBOR t => Proxy t -> Size
size_ Proxy Ptr
proxy =
    (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SlotNo -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size_ (Ptr -> SlotNo
getSlotNo (Ptr -> SlotNo) -> Proxy Ptr -> Proxy SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Ptr
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ix -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size_ (Ptr -> Ix
getIx1 (Ptr -> Ix) -> Proxy Ptr -> Proxy Ix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Ptr
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Ix -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size_ (Ptr -> Ix
getIx2 (Ptr -> Ix) -> Proxy Ptr -> Proxy Ix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Ptr
proxy)
    where
      getSlotNo :: Ptr -> SlotNo
      getSlotNo :: Ptr -> SlotNo
getSlotNo (Ptr SlotNo
a Ix
_ Ix
_) = SlotNo
a
      getIx1, getIx2 :: Ptr -> Ix
      getIx1 :: Ptr -> Ix
getIx1 (Ptr SlotNo
_ Ix
x Ix
_) = Ix
x
      getIx2 :: Ptr -> Ix
getIx2 (Ptr SlotNo
_ Ix
_ Ix
x) = Ix
x

  listLen :: Ptr -> Word
listLen Ptr
_ = Word
3
  listLenBound :: Proxy Ptr -> Word
listLenBound Proxy Ptr
_ = Word
3

instance FromCBORGroup Ptr where
  fromCBORGroup :: Decoder s Ptr
fromCBORGroup = SlotNo -> Ix -> Ix -> Ptr
Ptr (SlotNo -> Ix -> Ix -> Ptr)
-> Decoder s SlotNo -> Decoder s (Ix -> Ix -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Ix -> Ix -> Ptr)
-> Decoder s Ix -> Decoder s (Ix -> Ptr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Ix
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Ix -> Ptr) -> Decoder s Ix -> Decoder s Ptr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Ix
forall a s. FromCBOR a => Decoder s a
fromCBOR

newtype GenesisCredential era = GenesisCredential
  { GenesisCredential era -> KeyHash 'Genesis (Crypto era)
unGenesisCredential ::
      KeyHash 'Genesis (Crypto era)
  }
  deriving ((forall x. GenesisCredential era -> Rep (GenesisCredential era) x)
-> (forall x.
    Rep (GenesisCredential era) x -> GenesisCredential era)
-> Generic (GenesisCredential era)
forall x. Rep (GenesisCredential era) x -> GenesisCredential era
forall x. GenesisCredential era -> Rep (GenesisCredential era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (GenesisCredential era) x -> GenesisCredential era
forall era x.
GenesisCredential era -> Rep (GenesisCredential era) x
$cto :: forall era x.
Rep (GenesisCredential era) x -> GenesisCredential era
$cfrom :: forall era x.
GenesisCredential era -> Rep (GenesisCredential era) x
Generic)
  deriving (Int -> GenesisCredential era -> ShowS
[GenesisCredential era] -> ShowS
GenesisCredential era -> String
(Int -> GenesisCredential era -> ShowS)
-> (GenesisCredential era -> String)
-> ([GenesisCredential era] -> ShowS)
-> Show (GenesisCredential era)
forall era. Int -> GenesisCredential era -> ShowS
forall era. [GenesisCredential era] -> ShowS
forall era. GenesisCredential era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisCredential era] -> ShowS
$cshowList :: forall era. [GenesisCredential era] -> ShowS
show :: GenesisCredential era -> String
$cshow :: forall era. GenesisCredential era -> String
showsPrec :: Int -> GenesisCredential era -> ShowS
$cshowsPrec :: forall era. Int -> GenesisCredential era -> ShowS
Show) via Quiet (GenesisCredential era)

instance Ord (GenesisCredential era) where
  compare :: GenesisCredential era -> GenesisCredential era -> Ordering
compare (GenesisCredential KeyHash 'Genesis (Crypto era)
gh) (GenesisCredential KeyHash 'Genesis (Crypto era)
gh') = KeyHash 'Genesis (Crypto era)
-> KeyHash 'Genesis (Crypto era) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare KeyHash 'Genesis (Crypto era)
gh KeyHash 'Genesis (Crypto era)
gh'

instance Eq (GenesisCredential era) where
  == :: GenesisCredential era -> GenesisCredential era -> Bool
(==) (GenesisCredential KeyHash 'Genesis (Crypto era)
gh) (GenesisCredential KeyHash 'Genesis (Crypto era)
gh') = KeyHash 'Genesis (Crypto era)
gh KeyHash 'Genesis (Crypto era)
-> KeyHash 'Genesis (Crypto era) -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash 'Genesis (Crypto era)
gh'

instance
  (Typeable era, Era era) =>
  ToCBOR (GenesisCredential era)
  where
  toCBOR :: GenesisCredential era -> Encoding
toCBOR (GenesisCredential KeyHash 'Genesis (Crypto era)
kh) =
    KeyHash 'Genesis (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'Genesis (Crypto era)
kh