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

module Cardano.Ledger.Credential
  ( Credential (KeyHashObj, ScriptHashObj),
    GenesisCredential (..),
    PaymentCredential,
    Ptr (Ptr),
    ptrSlotNo,
    ptrTxIx,
    ptrCertIx,
    StakeCredential,
    StakeReference (..),
  )
where

import Cardano.Binary
  ( FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
  )
import Cardano.Ledger.BaseTypes
  ( CertIx (..),
    TxIx (..),
    invalidKey,
  )
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Keys
  ( HasKeyRole (..),
    KeyHash,
    KeyRole (..),
  )
import Cardano.Ledger.Serialization
  ( CBORGroup (..),
    FromCBORGroup (..),
    ToCBORGroup (..),
    decodeRecordSum,
  )
import Cardano.Ledger.Slot (SlotNo (..))
import Control.DeepSeq (NFData)
import Data.Aeson
  ( FromJSON (..),
    FromJSONKey,
    ToJSON (..),
    ToJSONKey,
    (.:),
    (.=),
  )
import qualified Data.Aeson as Aeson
-- import Data.Bits (Bits (shiftL, shiftR, (.|.)))
import Data.Foldable (asum)
import Data.Typeable (Typeable)
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Quiet (Quiet (Quiet))

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

instance NoThunks (Credential kr crypto)

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

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

instance CC.Crypto crypto => ToJSONKey (Credential kr crypto)

instance CC.Crypto crypto => FromJSONKey (Credential kr crypto)

type PaymentCredential crypto = Credential 'Payment crypto

type StakeCredential crypto = Credential 'Staking crypto

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

instance NoThunks (StakeReference crypto)

-- TODO: implement this optimization:
-- We expect that `SlotNo` will fit into `Word32` for a very long time,
-- because we can assume that the rate at which it is incremented isn't going to
-- increase in the near future. Therefore with current rate we should be fine for
-- another 134 years. I suggest to remove this optimization in about a
-- hundred years or thereabouts, so around a year 2122 would be good.
--
-- Compaction works in a following manner. Total 8 bytes: first 4 bytes are for
-- SlotNo (s0-s3), followed by 2 bytes for CertIx (c0-c1) and 2 more bytes for TxIx (t0-t1).
--
-- @@@
--
-- ┏━━┯━━┯━━┯━━┯━━┯━━┯━━┯━━┓
-- ┃s3 s2 s1 s0┊c1 c0┊t1 t0┃
-- ┗━━┷━━┷━━┷━━┷━━┷━━┷━━┷━━┛
--
-- @@@
-- newtype Ptr = PtrCompact Word64

-- | Pointer to a slot number, transaction index and an index in certificate
-- list.
data Ptr = Ptr !SlotNo !TxIx !CertIx
  deriving (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 Show Ptr where
  showsPrec :: Int -> Ptr -> ShowS
showsPrec Int
n (Ptr SlotNo
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
. SlotNo -> ShowS
forall a. Show a => a -> ShowS
shows SlotNo
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]
:)

{- TODO: Uncomment this once Mainnet is ready for Ptr optimization.

-- | With this pattern synonym we can recover actual values from compacted version of `Ptr`.
pattern Ptr :: SlotNo -> TxIx -> CertIx -> Ptr
pattern Ptr slotNo txIx certIx <-
  (viewPtr -> (slotNo, txIx, certIx))

{-# COMPLETE Ptr #-}

-- | `Ptr` relies on compact representation for memory efficiency and therefore
-- it will return `Nothing` if `SlotNo` takes up more than 32 bits, which is
-- totally fine for at least another 100 years.
mkPtr :: SlotNo -> TxIx -> CertIx -> Maybe Ptr
mkPtr (SlotNo slotNo) (TxIx txIx) (CertIx certIx)
  | slotNo > fromIntegral (maxBound :: Word32) = Nothing
  | otherwise =
      Just
        $! PtrCompact
          ( (slotNo `shiftL` 32) .|. (fromIntegral txIx `shiftL` 16)
              .|. fromIntegral certIx
          )

viewPtr :: Ptr -> (SlotNo, TxIx, CertIx)
viewPtr (PtrCompact ptr) =
  (SlotNo (ptr `shiftR` 32), TxIx (fromIntegral (ptr `shiftR` 16)), CertIx (fromIntegral ptr))
-}

ptrSlotNo :: Ptr -> SlotNo
ptrSlotNo :: Ptr -> SlotNo
ptrSlotNo (Ptr SlotNo
sn TxIx
_ CertIx
_) = SlotNo
sn

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

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

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

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

instance ToCBORGroup Ptr where
  toCBORGroup :: Ptr -> Encoding
toCBORGroup (Ptr SlotNo
sl TxIx
txIx CertIx
certIx) =
    SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNo
sl
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxIx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxIx
txIx
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertIx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CertIx
certIx
  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
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. ToCBOR t => Proxy t -> Size) -> Proxy TxIx -> 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 -> 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. ToCBOR t => Proxy t -> Size) -> Proxy CertIx -> 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 -> 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 FromCBORGroup Ptr where
  fromCBORGroup :: Decoder s Ptr
fromCBORGroup = do
    SlotNo
slotNo <- Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
    TxIx
txIx <- Decoder s TxIx
forall a s. FromCBOR a => Decoder s a
fromCBOR
    CertIx
certIx <- Decoder s CertIx
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Ptr -> Decoder s Ptr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr -> Decoder s Ptr) -> Ptr -> Decoder s Ptr
forall a b. (a -> b) -> a -> b
$ SlotNo -> TxIx -> CertIx -> Ptr
Ptr SlotNo
slotNo TxIx
txIx CertIx
certIx

-- case mkPtr slotNo txIx certIx of
--   Nothing -> fail $ "SlotNo is too far into the future: " ++ show slotNo
--   Just ptr -> pure ptr

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

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

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

instance CC.Crypto crypto => ToCBOR (GenesisCredential crypto) where
  toCBOR :: GenesisCredential crypto -> Encoding
toCBOR (GenesisCredential KeyHash 'Genesis crypto
kh) = KeyHash 'Genesis crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'Genesis crypto
kh