{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Ledger.Credential (
  Credential (KeyHashObj, ScriptHashObj),
  PaymentCredential,
  credKeyHash,
  credKeyHashWitness,
  credScriptHash,
  credToText,
  parseCredential,
  Ptr (Ptr),
  mkPtrNormalized,
  ptrSlotNo,
  ptrTxIx,
  ptrCertIx,
  SlotNo32 (..),
  StakeCredential,
  StakeReference (..),
  normalizePtr,
) where

import Cardano.Crypto.Hash (hashFromTextAsHex, hashToTextAsHex)
import Cardano.Ledger.BaseTypes (CertIx (..), SlotNo (..), TxIx (..), integralToBounded)
import Cardano.Ledger.Binary (
  CBORGroup (..),
  DecCBOR (..),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  FromCBOR (..),
  ToCBOR (..),
  ifDecoderVersionAtLeast,
  natVersion,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Keys (
  HasKeyRole (..),
  KeyHash (..),
  KeyRole (..),
  asWitness,
 )
import Control.Applicative ((<|>))
import Control.DeepSeq (NFData)
import Data.Aeson (
  FromJSON (..),
  FromJSONKey (..),
  FromJSONKeyFunction (..),
  KeyValue,
  ToJSON,
  ToJSONKey (..),
  object,
  pairs,
  (.:),
  (.=),
 )
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (toJSONKeyText)
import Data.Default (Default (..))
import Data.Foldable (asum)
import Data.Maybe (fromMaybe)
import Data.MemPack
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

-- | 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)
  = ScriptHashObj !ScriptHash
  | KeyHashObj !(KeyHash kr)
  deriving (Int -> Credential kr -> ShowS
[Credential kr] -> ShowS
Credential kr -> String
(Int -> Credential kr -> ShowS)
-> (Credential kr -> String)
-> ([Credential kr] -> ShowS)
-> Show (Credential kr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (kr :: KeyRole). Int -> Credential kr -> ShowS
forall (kr :: KeyRole). [Credential kr] -> ShowS
forall (kr :: KeyRole). Credential kr -> String
$cshowsPrec :: forall (kr :: KeyRole). Int -> Credential kr -> ShowS
showsPrec :: Int -> Credential kr -> ShowS
$cshow :: forall (kr :: KeyRole). Credential kr -> String
show :: Credential kr -> String
$cshowList :: forall (kr :: KeyRole). [Credential kr] -> ShowS
showList :: [Credential kr] -> ShowS
Show, Credential kr -> Credential kr -> Bool
(Credential kr -> Credential kr -> Bool)
-> (Credential kr -> Credential kr -> Bool) -> Eq (Credential kr)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
$c== :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
== :: Credential kr -> Credential kr -> Bool
$c/= :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
/= :: Credential kr -> Credential kr -> Bool
Eq, (forall x. Credential kr -> Rep (Credential kr) x)
-> (forall x. Rep (Credential kr) x -> Credential kr)
-> Generic (Credential kr)
forall x. Rep (Credential kr) x -> Credential kr
forall x. Credential kr -> Rep (Credential kr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kr :: KeyRole) x. Rep (Credential kr) x -> Credential kr
forall (kr :: KeyRole) x. Credential kr -> Rep (Credential kr) x
$cfrom :: forall (kr :: KeyRole) x. Credential kr -> Rep (Credential kr) x
from :: forall x. Credential kr -> Rep (Credential kr) x
$cto :: forall (kr :: KeyRole) x. Rep (Credential kr) x -> Credential kr
to :: forall x. Rep (Credential kr) x -> Credential kr
Generic, Eq (Credential kr)
Eq (Credential kr) =>
(Credential kr -> Credential kr -> Ordering)
-> (Credential kr -> Credential kr -> Bool)
-> (Credential kr -> Credential kr -> Bool)
-> (Credential kr -> Credential kr -> Bool)
-> (Credential kr -> Credential kr -> Bool)
-> (Credential kr -> Credential kr -> Credential kr)
-> (Credential kr -> Credential kr -> Credential kr)
-> Ord (Credential kr)
Credential kr -> Credential kr -> Bool
Credential kr -> Credential kr -> Ordering
Credential kr -> Credential kr -> Credential kr
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). Eq (Credential kr)
forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
forall (kr :: KeyRole). Credential kr -> Credential kr -> Ordering
forall (kr :: KeyRole).
Credential kr -> Credential kr -> Credential kr
$ccompare :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Ordering
compare :: Credential kr -> Credential kr -> Ordering
$c< :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
< :: Credential kr -> Credential kr -> Bool
$c<= :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
<= :: Credential kr -> Credential kr -> Bool
$c> :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
> :: Credential kr -> Credential kr -> Bool
$c>= :: forall (kr :: KeyRole). Credential kr -> Credential kr -> Bool
>= :: Credential kr -> Credential kr -> Bool
$cmax :: forall (kr :: KeyRole).
Credential kr -> Credential kr -> Credential kr
max :: Credential kr -> Credential kr -> Credential kr
$cmin :: forall (kr :: KeyRole).
Credential kr -> Credential kr -> Credential kr
min :: Credential kr -> Credential kr -> Credential kr
Ord)

instance NFData (Credential r)

instance Typeable kr => MemPack (Credential kr) where
  packedByteCount :: Credential kr -> Int
packedByteCount = \case
    ScriptHashObj ScriptHash
hash -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ScriptHash -> Int
forall a. MemPack a => a -> Int
packedByteCount ScriptHash
hash
    KeyHashObj KeyHash kr
hash -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ KeyHash kr -> Int
forall a. MemPack a => a -> Int
packedByteCount KeyHash kr
hash
  packM :: forall s. Credential kr -> Pack s ()
packM = \case
    ScriptHashObj ScriptHash
hash -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ScriptHash -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. ScriptHash -> Pack s ()
packM ScriptHash
hash
    KeyHashObj KeyHash kr
hash -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyHash kr -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. KeyHash kr -> Pack s ()
packM KeyHash kr
hash
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Credential kr)
unpackM =
    Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag
-> (Tag -> Unpack b (Credential kr)) -> Unpack b (Credential kr)
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential kr)
-> Unpack b ScriptHash -> Unpack b (Credential kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b ScriptHash
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b ScriptHash
unpackM
      Tag
1 -> KeyHash kr -> Credential kr
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash kr -> Credential kr)
-> Unpack b (KeyHash kr) -> Unpack b (Credential kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (KeyHash kr)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (KeyHash kr)
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @(Credential kr) Tag
n
  {-# INLINE unpackM #-}

instance Default (Credential r) where
  def :: Credential r
def = KeyHash r -> Credential r
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash r
forall a. Default a => a
def

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

instance NoThunks (Credential kr)

instance ToJSON (Credential kr) where
  toJSON :: Credential kr -> Value
toJSON (ScriptHashObj ScriptHash
hash) =
    [Pair] -> Value
Aeson.object
      [ Key
"scriptHash" Key -> ScriptHash -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
hash
      ]
  toJSON (KeyHashObj KeyHash kr
hash) =
    [Pair] -> Value
Aeson.object
      [ Key
"keyHash" Key -> KeyHash kr -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= KeyHash kr
hash
      ]

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

instance ToJSONKey (Credential kr) where
  toJSONKey :: ToJSONKeyFunction (Credential kr)
toJSONKey = (Credential kr -> Text) -> ToJSONKeyFunction (Credential kr)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Credential kr -> Text
forall (kr :: KeyRole). Credential kr -> Text
credToText

instance FromJSONKey (Credential kr) where
  fromJSONKey :: FromJSONKeyFunction (Credential kr)
fromJSONKey = (Text -> Parser (Credential kr))
-> FromJSONKeyFunction (Credential kr)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser (Credential kr)
forall (m :: * -> *) (kr :: KeyRole).
MonadFail m =>
Text -> m (Credential kr)
parseCredential

parseCredential ::
  MonadFail m =>
  T.Text ->
  m (Credential kr)
parseCredential :: forall (m :: * -> *) (kr :: KeyRole).
MonadFail m =>
Text -> m (Credential kr)
parseCredential Text
t = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" Text
t of
  [Text
"scriptHash", Text
hash] ->
    m (Credential kr)
-> (Hash ADDRHASH EraIndependentScript -> m (Credential kr))
-> Maybe (Hash ADDRHASH EraIndependentScript)
-> m (Credential kr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Text -> m (Credential kr)
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
badHash Text
hash)
      (Credential kr -> m (Credential kr)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> m (Credential kr))
-> (Hash ADDRHASH EraIndependentScript -> Credential kr)
-> Hash ADDRHASH EraIndependentScript
-> m (Credential kr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential kr)
-> (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript
-> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash)
      (Text -> Maybe (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex Text
hash)
  [Text
"keyHash", Text
hash] ->
    m (Credential kr)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> m (Credential kr))
-> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> m (Credential kr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Text -> m (Credential kr)
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
badHash Text
hash)
      (Credential kr -> m (Credential kr)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> m (Credential kr))
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> Credential kr)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> m (Credential kr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash kr -> Credential kr
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash kr -> Credential kr)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash kr)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash kr
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash)
      (Text -> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall h a. HashAlgorithm h => Text -> Maybe (Hash h a)
hashFromTextAsHex Text
hash)
  [Text]
_ -> String -> m (Credential kr)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Credential kr)) -> String -> m (Credential kr)
forall a b. (a -> b) -> a -> b
$ String
"Invalid credential: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t
  where
    badHash :: a -> m a
badHash a
h = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Invalid hash: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
h

credToText :: Credential kr -> T.Text
credToText :: forall (kr :: KeyRole). Credential kr -> Text
credToText (ScriptHashObj (ScriptHash Hash ADDRHASH EraIndependentScript
hash)) = Text
"scriptHash-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH EraIndependentScript -> Text
forall h a. Hash h a -> Text
hashToTextAsHex Hash ADDRHASH EraIndependentScript
hash
credToText (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
has)) = Text
"keyHash-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH (VerKeyDSIGN DSIGN) -> Text
forall h a. Hash h a -> Text
hashToTextAsHex Hash ADDRHASH (VerKeyDSIGN DSIGN)
has

type PaymentCredential = Credential 'Payment

type StakeCredential = Credential 'Staking

credKeyHash :: Credential r -> Maybe (KeyHash r)
credKeyHash :: forall (r :: KeyRole). Credential r -> Maybe (KeyHash r)
credKeyHash = \case
  KeyHashObj KeyHash r
hk -> KeyHash r -> Maybe (KeyHash r)
forall a. a -> Maybe a
Just KeyHash r
hk
  ScriptHashObj ScriptHash
_ -> Maybe (KeyHash r)
forall a. Maybe a
Nothing

-- | Convert a KeyHash into a Witness KeyHash. Does nothing for Script credentials.
credKeyHashWitness :: Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness :: forall (r :: KeyRole). Credential r -> Maybe (KeyHash 'Witness)
credKeyHashWitness = Credential 'Witness -> Maybe (KeyHash 'Witness)
forall (r :: KeyRole). Credential r -> Maybe (KeyHash r)
credKeyHash (Credential 'Witness -> Maybe (KeyHash 'Witness))
-> (Credential r -> Credential 'Witness)
-> Credential r
-> Maybe (KeyHash 'Witness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential r -> Credential 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness

-- | Extract ScriptHash from a Credential. Returns Nothing for KeyHashes
credScriptHash :: Credential kr -> Maybe ScriptHash
credScriptHash :: forall (kr :: KeyRole). Credential kr -> Maybe ScriptHash
credScriptHash = \case
  ScriptHashObj ScriptHash
hs -> ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just ScriptHash
hs
  KeyHashObj KeyHash kr
_ -> Maybe ScriptHash
forall a. Maybe a
Nothing

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

instance ToJSON StakeReference

instance NFData StakeReference

instance NoThunks StakeReference

-- | Pointers have been deprecated and aren't used anymore. For this reason we can safely use
-- `Word32` for slots in pointers
newtype SlotNo32 = SlotNo32 Word32
  deriving stock (Int -> SlotNo32 -> ShowS
[SlotNo32] -> ShowS
SlotNo32 -> String
(Int -> SlotNo32 -> ShowS)
-> (SlotNo32 -> String) -> ([SlotNo32] -> ShowS) -> Show SlotNo32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlotNo32 -> ShowS
showsPrec :: Int -> SlotNo32 -> ShowS
$cshow :: SlotNo32 -> String
show :: SlotNo32 -> String
$cshowList :: [SlotNo32] -> ShowS
showList :: [SlotNo32] -> ShowS
Show, (forall x. SlotNo32 -> Rep SlotNo32 x)
-> (forall x. Rep SlotNo32 x -> SlotNo32) -> Generic SlotNo32
forall x. Rep SlotNo32 x -> SlotNo32
forall x. SlotNo32 -> Rep SlotNo32 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotNo32 -> Rep SlotNo32 x
from :: forall x. SlotNo32 -> Rep SlotNo32 x
$cto :: forall x. Rep SlotNo32 x -> SlotNo32
to :: forall x. Rep SlotNo32 x -> SlotNo32
Generic)
  deriving newtype
    (SlotNo32 -> SlotNo32 -> Bool
(SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool) -> Eq SlotNo32
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlotNo32 -> SlotNo32 -> Bool
== :: SlotNo32 -> SlotNo32 -> Bool
$c/= :: SlotNo32 -> SlotNo32 -> Bool
/= :: SlotNo32 -> SlotNo32 -> Bool
Eq, Eq SlotNo32
Eq SlotNo32 =>
(SlotNo32 -> SlotNo32 -> Ordering)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> Bool)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> Ord SlotNo32
SlotNo32 -> SlotNo32 -> Bool
SlotNo32 -> SlotNo32 -> Ordering
SlotNo32 -> SlotNo32 -> SlotNo32
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
$ccompare :: SlotNo32 -> SlotNo32 -> Ordering
compare :: SlotNo32 -> SlotNo32 -> Ordering
$c< :: SlotNo32 -> SlotNo32 -> Bool
< :: SlotNo32 -> SlotNo32 -> Bool
$c<= :: SlotNo32 -> SlotNo32 -> Bool
<= :: SlotNo32 -> SlotNo32 -> Bool
$c> :: SlotNo32 -> SlotNo32 -> Bool
> :: SlotNo32 -> SlotNo32 -> Bool
$c>= :: SlotNo32 -> SlotNo32 -> Bool
>= :: SlotNo32 -> SlotNo32 -> Bool
$cmax :: SlotNo32 -> SlotNo32 -> SlotNo32
max :: SlotNo32 -> SlotNo32 -> SlotNo32
$cmin :: SlotNo32 -> SlotNo32 -> SlotNo32
min :: SlotNo32 -> SlotNo32 -> SlotNo32
Ord, Integer -> SlotNo32
SlotNo32 -> SlotNo32
SlotNo32 -> SlotNo32 -> SlotNo32
(SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32)
-> (SlotNo32 -> SlotNo32)
-> (Integer -> SlotNo32)
-> Num SlotNo32
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SlotNo32 -> SlotNo32 -> SlotNo32
+ :: SlotNo32 -> SlotNo32 -> SlotNo32
$c- :: SlotNo32 -> SlotNo32 -> SlotNo32
- :: SlotNo32 -> SlotNo32 -> SlotNo32
$c* :: SlotNo32 -> SlotNo32 -> SlotNo32
* :: SlotNo32 -> SlotNo32 -> SlotNo32
$cnegate :: SlotNo32 -> SlotNo32
negate :: SlotNo32 -> SlotNo32
$cabs :: SlotNo32 -> SlotNo32
abs :: SlotNo32 -> SlotNo32
$csignum :: SlotNo32 -> SlotNo32
signum :: SlotNo32 -> SlotNo32
$cfromInteger :: Integer -> SlotNo32
fromInteger :: Integer -> SlotNo32
Num, SlotNo32
SlotNo32 -> SlotNo32 -> Bounded SlotNo32
forall a. a -> a -> Bounded a
$cminBound :: SlotNo32
minBound :: SlotNo32
$cmaxBound :: SlotNo32
maxBound :: SlotNo32
Bounded, SlotNo32 -> ()
(SlotNo32 -> ()) -> NFData SlotNo32
forall a. (a -> ()) -> NFData a
$crnf :: SlotNo32 -> ()
rnf :: SlotNo32 -> ()
NFData, Context -> SlotNo32 -> IO (Maybe ThunkInfo)
Proxy SlotNo32 -> String
(Context -> SlotNo32 -> IO (Maybe ThunkInfo))
-> (Context -> SlotNo32 -> IO (Maybe ThunkInfo))
-> (Proxy SlotNo32 -> String)
-> NoThunks SlotNo32
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SlotNo32 -> IO (Maybe ThunkInfo)
noThunks :: Context -> SlotNo32 -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SlotNo32 -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SlotNo32 -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SlotNo32 -> String
showTypeOf :: Proxy SlotNo32 -> String
NoThunks, Typeable SlotNo32
Typeable SlotNo32 =>
(SlotNo32 -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy SlotNo32 -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [SlotNo32] -> Size)
-> EncCBOR SlotNo32
SlotNo32 -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SlotNo32] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy SlotNo32 -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: SlotNo32 -> Encoding
encCBOR :: SlotNo32 -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy SlotNo32 -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy SlotNo32 -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SlotNo32] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [SlotNo32] -> Size
EncCBOR, Typeable SlotNo32
Typeable SlotNo32 =>
(forall s. Decoder s SlotNo32)
-> (forall s. Proxy SlotNo32 -> Decoder s ())
-> (Proxy SlotNo32 -> Text)
-> DecCBOR SlotNo32
Proxy SlotNo32 -> Text
forall s. Decoder s SlotNo32
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy SlotNo32 -> Decoder s ()
$cdecCBOR :: forall s. Decoder s SlotNo32
decCBOR :: forall s. Decoder s SlotNo32
$cdropCBOR :: forall s. Proxy SlotNo32 -> Decoder s ()
dropCBOR :: forall s. Proxy SlotNo32 -> Decoder s ()
$clabel :: Proxy SlotNo32 -> Text
label :: Proxy SlotNo32 -> Text
DecCBOR, Typeable SlotNo32
Typeable SlotNo32 =>
(forall s. Decoder s SlotNo32)
-> (Proxy SlotNo32 -> Text) -> FromCBOR SlotNo32
Proxy SlotNo32 -> Text
forall s. Decoder s SlotNo32
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s SlotNo32
fromCBOR :: forall s. Decoder s SlotNo32
$clabel :: Proxy SlotNo32 -> Text
label :: Proxy SlotNo32 -> Text
FromCBOR, Typeable SlotNo32
Typeable SlotNo32 =>
(SlotNo32 -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy SlotNo32 -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SlotNo32] -> Size)
-> ToCBOR SlotNo32
SlotNo32 -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [SlotNo32] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy SlotNo32 -> 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
$ctoCBOR :: SlotNo32 -> Encoding
toCBOR :: SlotNo32 -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SlotNo32 -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SlotNo32 -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [SlotNo32] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [SlotNo32] -> Size
ToCBOR, Maybe SlotNo32
Value -> Parser [SlotNo32]
Value -> Parser SlotNo32
(Value -> Parser SlotNo32)
-> (Value -> Parser [SlotNo32])
-> Maybe SlotNo32
-> FromJSON SlotNo32
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SlotNo32
parseJSON :: Value -> Parser SlotNo32
$cparseJSONList :: Value -> Parser [SlotNo32]
parseJSONList :: Value -> Parser [SlotNo32]
$comittedField :: Maybe SlotNo32
omittedField :: Maybe SlotNo32
FromJSON, [SlotNo32] -> Value
[SlotNo32] -> Encoding
SlotNo32 -> Bool
SlotNo32 -> Value
SlotNo32 -> Encoding
(SlotNo32 -> Value)
-> (SlotNo32 -> Encoding)
-> ([SlotNo32] -> Value)
-> ([SlotNo32] -> Encoding)
-> (SlotNo32 -> Bool)
-> ToJSON SlotNo32
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SlotNo32 -> Value
toJSON :: SlotNo32 -> Value
$ctoEncoding :: SlotNo32 -> Encoding
toEncoding :: SlotNo32 -> Encoding
$ctoJSONList :: [SlotNo32] -> Value
toJSONList :: [SlotNo32] -> Value
$ctoEncodingList :: [SlotNo32] -> Encoding
toEncodingList :: [SlotNo32] -> Encoding
$comitField :: SlotNo32 -> Bool
omitField :: SlotNo32 -> Bool
ToJSON)

-- | Pointer to a slot number, transaction index and an index in certificate
-- list.
data Ptr = Ptr {-# UNPACK #-} !SlotNo32 {-# UNPACK #-} !TxIx {-# UNPACK #-} !CertIx
  deriving (Ptr -> Ptr -> Bool
(Ptr -> Ptr -> Bool) -> (Ptr -> Ptr -> Bool) -> Eq Ptr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ptr -> Ptr -> Bool
== :: Ptr -> Ptr -> Bool
$c/= :: Ptr -> Ptr -> Bool
/= :: 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
$ccompare :: Ptr -> Ptr -> Ordering
compare :: Ptr -> Ptr -> Ordering
$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
>= :: Ptr -> Ptr -> Bool
$cmax :: Ptr -> Ptr -> Ptr
max :: Ptr -> Ptr -> Ptr
$cmin :: Ptr -> Ptr -> Ptr
min :: Ptr -> Ptr -> 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
$cfrom :: forall x. Ptr -> Rep Ptr x
from :: forall x. Ptr -> Rep Ptr x
$cto :: forall x. Rep Ptr x -> Ptr
to :: forall x. Rep Ptr x -> Ptr
Generic)
  deriving (Typeable Ptr
Typeable Ptr =>
(Ptr -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [Ptr] -> Size)
-> EncCBOR Ptr
Ptr -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: Ptr -> Encoding
encCBOR :: Ptr -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Ptr] -> Size
EncCBOR, Typeable Ptr
Typeable Ptr =>
(forall s. Decoder s Ptr)
-> (forall s. Proxy Ptr -> Decoder s ())
-> (Proxy Ptr -> Text)
-> DecCBOR Ptr
Proxy Ptr -> Text
forall s. Decoder s Ptr
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy Ptr -> Decoder s ()
$cdecCBOR :: forall s. Decoder s Ptr
decCBOR :: forall s. Decoder s Ptr
$cdropCBOR :: forall s. Proxy Ptr -> Decoder s ()
dropCBOR :: forall s. Proxy Ptr -> Decoder s ()
$clabel :: Proxy Ptr -> Text
label :: Proxy Ptr -> Text
DecCBOR) via CBORGroup Ptr

instance NFData Ptr

instance NoThunks Ptr

-- | Convert any invalid `Ptr` to a `Ptr` that contains all zeros for its fields. Any
-- pointer that contains a `SlotNo`, `TxIx` or `CertIx` that is too large to fit into
-- `Word32`, `Word16` and `Word16` respectively is considered to be an invalid
-- `Ptr`. Valid `Ptr`s will be returned unmodified.
--
-- /Note/ - This is in no way related to dangling pointers, with an exception that any
-- invalid `Ptr` is guarateed to be a dangling `Ptr`.
normalizePtr :: Ptr -> Ptr
normalizePtr :: Ptr -> Ptr
normalizePtr Ptr
ptr = Ptr
ptr
{-# DEPRECATED
  normalizePtr
  "Starting with Conway era all Pointers are now normalized and this logic has been moved into the decoder"
  #-}

-- | Construct a valid `Ptr`, while protecting against overflow. Constructs a `Ptr` with
-- all zeros for its fields, whenever either one of them doesn't fit in without overflowing. Any
-- pointer that contains a `SlotNo`, `TxIx` or `CertIx` that is too large to fit into `Word32`,
-- `Word16` and `Word16` respectively is considered to be an invalid `Ptr` and result in all values
-- to be clamped to zero. In case of all valid arguments the `Ptr`s will be constructed with values
-- unmodified.
--
-- /Note/ - This functionality is in no way related to dangling pointers, with an exception that any
-- invalid `Ptr` is guarateed to be a dangling `Ptr`.
mkPtrNormalized :: Word64 -> Word64 -> Word64 -> Ptr
mkPtrNormalized :: Word64 -> Word64 -> Word64 -> Ptr
mkPtrNormalized Word64
slotNo Word64
txIx Word64
certIx =
  Ptr -> Maybe Ptr -> Ptr
forall a. a -> Maybe a -> a
fromMaybe (SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
0) (Word16 -> TxIx
TxIx Word16
0) (Word16 -> CertIx
CertIx Word16
0)) (Maybe Ptr -> Ptr) -> Maybe Ptr -> Ptr
forall a b. (a -> b) -> a -> b
$ do
    Word32
slotNo32 <- Word64 -> Maybe Word32
forall i b (m :: * -> *).
(Integral i, Integral b, Bounded b, MonadFail m) =>
i -> m b
integralToBounded Word64
slotNo
    Word16
txIx16 <- Word64 -> Maybe Word16
forall i b (m :: * -> *).
(Integral i, Integral b, Bounded b, MonadFail m) =>
i -> m b
integralToBounded Word64
txIx
    Word16
certIx16 <- Word64 -> Maybe Word16
forall i b (m :: * -> *).
(Integral i, Integral b, Bounded b, MonadFail m) =>
i -> m b
integralToBounded Word64
certIx
    Ptr -> Maybe Ptr
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr -> Maybe Ptr) -> Ptr -> Maybe Ptr
forall a b. (a -> b) -> a -> b
$ SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (Word32 -> SlotNo32
SlotNo32 Word32
slotNo32) (Word16 -> TxIx
TxIx Word16
txIx16) (Word16 -> CertIx
CertIx Word16
certIx16)

instance ToCBOR Ptr where
  toCBOR :: Ptr -> Encoding
toCBOR (Ptr SlotNo32
slotNo TxIx
txIx CertIx
certIx) = (SlotNo32, TxIx, CertIx) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (SlotNo32
slotNo, TxIx
txIx, CertIx
certIx)

instance FromCBOR Ptr where
  fromCBOR :: forall s. Decoder s Ptr
fromCBOR = do
    (SlotNo32
slotNo, TxIx
txIx, CertIx
certIx) <- Decoder s (SlotNo32, TxIx, CertIx)
forall s. Decoder s (SlotNo32, TxIx, CertIx)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Ptr -> Decoder s Ptr
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr -> Decoder s Ptr) -> Ptr -> Decoder s Ptr
forall a b. (a -> b) -> a -> b
$ SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr SlotNo32
slotNo TxIx
txIx CertIx
certIx

instance ToJSON Ptr where
  toJSON :: Ptr -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Ptr -> [Pair]) -> Ptr -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr -> [Pair]
forall e a. KeyValue e a => Ptr -> [a]
toPtrPair
  toEncoding :: Ptr -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding) -> (Ptr -> Series) -> Ptr -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (Ptr -> [Series]) -> Ptr -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr -> [Series]
forall e a. KeyValue e a => Ptr -> [a]
toPtrPair

instance ToJSONKey Ptr

toPtrPair :: KeyValue e a => Ptr -> [a]
toPtrPair :: forall e a. KeyValue e a => Ptr -> [a]
toPtrPair (Ptr SlotNo32
slotNo TxIx
txIndex CertIx
certIndex) =
  [ Key
"slot" Key -> SlotNo32 -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo32
slotNo
  , Key
"txIndex" Key -> TxIx -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxIx
txIndex
  , Key
"certIndex" Key -> CertIx -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CertIx
certIndex
  ]

instance Show Ptr where
  showsPrec :: Int -> Ptr -> ShowS
showsPrec Int
n (Ptr SlotNo32
slotNo TxIx
txIx CertIx
certIx)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = ShowS
inner
    | Bool
otherwise = (Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
")" String -> ShowS
forall a. [a] -> [a] -> [a]
++)
    where
      inner :: ShowS
inner =
        (String
"Ptr (" String -> ShowS
forall a. [a] -> [a] -> [a]
++)
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo32 -> ShowS
forall a. Show a => a -> ShowS
shows SlotNo32
slotNo
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++)
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIx -> ShowS
forall a. Show a => a -> ShowS
shows TxIx
txIx
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++)
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertIx -> ShowS
forall a. Show a => a -> ShowS
shows CertIx
certIx
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
:)

ptrSlotNo :: Ptr -> SlotNo
ptrSlotNo :: Ptr -> SlotNo
ptrSlotNo (Ptr (SlotNo32 Word32
sn) TxIx
_ CertIx
_) = Word64 -> SlotNo
SlotNo (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Word64 Word32
sn)

ptrTxIx :: Ptr -> TxIx
ptrTxIx :: Ptr -> TxIx
ptrTxIx (Ptr SlotNo32
_ TxIx
txIx CertIx
_) = TxIx
txIx

ptrCertIx :: Ptr -> CertIx
ptrCertIx :: Ptr -> CertIx
ptrCertIx (Ptr SlotNo32
_ TxIx
_ CertIx
cIx) = CertIx
cIx

-- NOTE: Credential serialization is unversioned, because it is needed for node-to-client
-- communication. It would be ok to change it in the future, but that will require change
-- in consensus
instance Typeable kr => EncCBOR (Credential kr)

instance Typeable kr => DecCBOR (Credential kr)

instance Typeable kr => ToCBOR (Credential kr) where
  toCBOR :: Credential kr -> Encoding
toCBOR = \case
    KeyHashObj KeyHash kr
kh -> Word -> Encoding
Plain.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 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash kr
kh
    ScriptHashObj ScriptHash
hs -> Word -> Encoding
Plain.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 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ScriptHash
hs

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

instance EncCBORGroup Ptr where
  encCBORGroup :: Ptr -> Encoding
encCBORGroup (Ptr SlotNo32
sl TxIx
txIx CertIx
certIx) =
    SlotNo32 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SlotNo32
sl
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxIx -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR TxIx
txIx
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertIx -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CertIx
certIx
  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Ptr -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size_ Proxy Ptr
proxy =
    (forall t. EncCBOR t => Proxy t -> Size) -> Proxy SlotNo -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size_ (Ptr -> SlotNo
ptrSlotNo (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. EncCBOR t => Proxy t -> Size) -> Proxy TxIx -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size_ (Ptr -> TxIx
ptrTxIx (Ptr -> TxIx) -> Proxy Ptr -> Proxy TxIx
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. EncCBOR t => Proxy t -> Size) -> Proxy CertIx -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size_ (Ptr -> CertIx
ptrCertIx (Ptr -> CertIx) -> Proxy Ptr -> Proxy CertIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Ptr
proxy)

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

instance DecCBORGroup Ptr where
  decCBORGroup :: forall s. Decoder s Ptr
decCBORGroup = do
    let decPtrStrict :: Decoder s Ptr
decPtrStrict = SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr (SlotNo32 -> TxIx -> CertIx -> Ptr)
-> Decoder s SlotNo32 -> Decoder s (TxIx -> CertIx -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SlotNo32
forall s. Decoder s SlotNo32
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (TxIx -> CertIx -> Ptr)
-> Decoder s TxIx -> Decoder s (CertIx -> Ptr)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s TxIx
forall s. Decoder s TxIx
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (CertIx -> Ptr) -> Decoder s CertIx -> Decoder s Ptr
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s CertIx
forall s. Decoder s CertIx
forall a s. DecCBOR a => Decoder s a
decCBOR
        decPtrNormalized :: Decoder s Ptr
decPtrNormalized = Word64 -> Word64 -> Word64 -> Ptr
mkPtrNormalized (Word64 -> Word64 -> Word64 -> Ptr)
-> Decoder s Word64 -> Decoder s (Word64 -> Word64 -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (Word64 -> Word64 -> Ptr)
-> Decoder s Word64 -> Decoder s (Word64 -> Ptr)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (Word64 -> Ptr) -> Decoder s Word64 -> Decoder s Ptr
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
    Version -> Decoder s Ptr -> Decoder s Ptr -> Decoder s Ptr
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) Decoder s Ptr
forall s. Decoder s Ptr
decPtrStrict Decoder s Ptr
forall s. Decoder s Ptr
decPtrNormalized