{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Ledger.Keys.WitVKey (
  WitVKey (WitVKey),
  witVKeyHash,
  wvkSig,
) where

import Cardano.Crypto.DSIGN.Class (
  SignedDSIGN,
  decodeSignedDSIGN,
  encodeSignedDSIGN,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Hashes (
  EraIndependentTxBody,
  HASH,
  Hash,
  KeyHash (..),
  hashKey,
  hashTxBodySignature,
 )
import Cardano.Ledger.Keys.Internal (DSIGN, KeyRole (..), VKey, asWitness)
import Control.DeepSeq
import Data.Ord (comparing)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))

-- | Proof/Witness that a transaction is authorized by the given key holder.
data WitVKey kr = WitVKeyInternal
  { forall (kr :: KeyRole). WitVKey kr -> VKey kr
wvkKey :: !(VKey kr)
  , forall (kr :: KeyRole).
WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature :: !(SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
  , forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash :: KeyHash 'Witness
  -- ^ Hash of the witness vkey. We store this here to avoid repeated hashing
  --   when used in ordering.
  }
  deriving ((forall x. WitVKey kr -> Rep (WitVKey kr) x)
-> (forall x. Rep (WitVKey kr) x -> WitVKey kr)
-> Generic (WitVKey kr)
forall x. Rep (WitVKey kr) x -> WitVKey kr
forall x. WitVKey kr -> Rep (WitVKey kr) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kr :: KeyRole) x. Rep (WitVKey kr) x -> WitVKey kr
forall (kr :: KeyRole) x. WitVKey kr -> Rep (WitVKey kr) x
$cfrom :: forall (kr :: KeyRole) x. WitVKey kr -> Rep (WitVKey kr) x
from :: forall x. WitVKey kr -> Rep (WitVKey kr) x
$cto :: forall (kr :: KeyRole) x. Rep (WitVKey kr) x -> WitVKey kr
to :: forall x. Rep (WitVKey kr) x -> WitVKey kr
Generic, Int -> WitVKey kr -> ShowS
[WitVKey kr] -> ShowS
WitVKey kr -> String
(Int -> WitVKey kr -> ShowS)
-> (WitVKey kr -> String)
-> ([WitVKey kr] -> ShowS)
-> Show (WitVKey kr)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (kr :: KeyRole). Int -> WitVKey kr -> ShowS
forall (kr :: KeyRole). [WitVKey kr] -> ShowS
forall (kr :: KeyRole). WitVKey kr -> String
$cshowsPrec :: forall (kr :: KeyRole). Int -> WitVKey kr -> ShowS
showsPrec :: Int -> WitVKey kr -> ShowS
$cshow :: forall (kr :: KeyRole). WitVKey kr -> String
show :: WitVKey kr -> String
$cshowList :: forall (kr :: KeyRole). [WitVKey kr] -> ShowS
showList :: [WitVKey kr] -> ShowS
Show, WitVKey kr -> WitVKey kr -> Bool
(WitVKey kr -> WitVKey kr -> Bool)
-> (WitVKey kr -> WitVKey kr -> Bool) -> Eq (WitVKey kr)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kr :: KeyRole). WitVKey kr -> WitVKey kr -> Bool
$c== :: forall (kr :: KeyRole). WitVKey kr -> WitVKey kr -> Bool
== :: WitVKey kr -> WitVKey kr -> Bool
$c/= :: forall (kr :: KeyRole). WitVKey kr -> WitVKey kr -> Bool
/= :: WitVKey kr -> WitVKey kr -> Bool
Eq)

wvkSig :: WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSig :: forall (kr :: KeyRole).
WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSig = WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
forall (kr :: KeyRole).
WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature
{-# DEPRECATED wvkSig "In favor of `wvkSignature`" #-}

deriving via
  AllowThunksIn '["wvkKeyHash"] (WitVKey kr)
  instance
    Typeable kr => NoThunks (WitVKey kr)

instance NFData (WitVKey kr) where
  rnf :: WitVKey kr -> ()
rnf WitVKeyInternal {KeyHash 'Witness
wvkKeyHash :: forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash :: KeyHash 'Witness
wvkKeyHash} = KeyHash 'Witness
wvkKeyHash KeyHash 'Witness -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance Typeable kr => Ord (WitVKey kr) where
  compare :: WitVKey kr -> WitVKey kr -> Ordering
compare WitVKey kr
x WitVKey kr
y =
    -- It is advised against comparison on keys and signatures directly,
    -- therefore we use hashes of verification keys and signatures for
    -- implementing this Ord instance. Note that we do not need to memoize the
    -- hash of a signature, like it is done with the hash of a key, because Ord
    -- instance is only used for Sets of WitVKeys and it would be a mistake to
    -- have two WitVKeys in a same Set for different transactions. Therefore
    -- comparison on signatures is unlikely to happen and is only needed for
    -- compliance with Ord laws.
    (WitVKey kr -> KeyHash 'Witness)
-> WitVKey kr -> WitVKey kr -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing WitVKey kr -> KeyHash 'Witness
forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash WitVKey kr
x WitVKey kr
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (WitVKey kr
 -> Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)))
-> WitVKey kr -> WitVKey kr -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
hashTxBodySignature (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
 -> Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)))
-> (WitVKey kr
    -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
-> WitVKey kr
-> Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
forall (kr :: KeyRole).
WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature) WitVKey kr
x WitVKey kr
y

instance Typeable kr => Plain.ToCBOR (WitVKey kr) where
  toCBOR :: WitVKey kr -> Encoding
toCBOR WitVKeyInternal {VKey kr
wvkKey :: forall (kr :: KeyRole). WitVKey kr -> VKey kr
wvkKey :: VKey kr
wvkKey, SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature :: forall (kr :: KeyRole).
WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature} =
    Word -> Encoding
Plain.encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VKey kr -> Encoding
forall a. ToCBOR a => a -> Encoding
Plain.toCBOR VKey kr
wvkKey
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> Encoding
forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature

instance Typeable kr => Plain.FromCBOR (WitVKey kr) where
  fromCBOR :: forall s. Decoder s (WitVKey kr)
fromCBOR =
    Text
-> (WitVKey kr -> Int)
-> Decoder s (WitVKey kr)
-> Decoder s (WitVKey kr)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
Plain.decodeRecordNamed Text
"WitVKey" (Int -> WitVKey kr -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (WitVKey kr) -> Decoder s (WitVKey kr))
-> Decoder s (WitVKey kr) -> Decoder s (WitVKey kr)
forall a b. (a -> b) -> a -> b
$
      VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
WitVKey (VKey kr
 -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
 -> WitVKey kr)
-> Decoder s (VKey kr)
-> Decoder
     s
     (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VKey kr)
forall s. Decoder s (VKey kr)
forall a s. FromCBOR a => Decoder s a
Plain.fromCBOR Decoder
  s
  (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr)
-> Decoder s (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
-> Decoder s (WitVKey kr)
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 (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
decodeSignedDSIGN

instance Typeable kr => EncCBOR (WitVKey kr)

instance Typeable kr => DecCBOR (WitVKey kr)

pattern WitVKey ::
  VKey kr ->
  SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) ->
  WitVKey kr
pattern $mWitVKey :: forall {r} {kr :: KeyRole}.
WitVKey kr
-> (VKey kr
    -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> r)
-> ((# #) -> r)
-> r
$bWitVKey :: forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
WitVKey k s <-
  WitVKeyInternal k s _
  where
    WitVKey VKey kr
k SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s =
      let hash :: KeyHash 'Witness
hash = KeyHash kr -> KeyHash 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyHash kr -> KeyHash 'Witness) -> KeyHash kr -> KeyHash 'Witness
forall a b. (a -> b) -> a -> b
$ VKey kr -> KeyHash kr
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey kr
k
       in VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> KeyHash 'Witness
-> WitVKey kr
forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> KeyHash 'Witness
-> WitVKey kr
WitVKeyInternal VKey kr
k SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s KeyHash 'Witness
hash

{-# COMPLETE WitVKey #-}

-- | Access computed hash. Evaluated lazily
witVKeyHash :: WitVKey kr -> KeyHash 'Witness
witVKeyHash :: forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
witVKeyHash = WitVKey kr -> KeyHash 'Witness
forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash