{-# 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 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
$cto :: forall (kr :: KeyRole) x. Rep (WitVKey kr) x -> WitVKey kr
$cfrom :: forall (kr :: KeyRole) x. WitVKey kr -> Rep (WitVKey kr) x
Generic, Int -> WitVKey kr -> ShowS
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
showList :: [WitVKey kr] -> ShowS
$cshowList :: forall (kr :: KeyRole). [WitVKey kr] -> ShowS
show :: WitVKey kr -> String
$cshow :: forall (kr :: KeyRole). WitVKey kr -> String
showsPrec :: Int -> WitVKey kr -> ShowS
$cshowsPrec :: forall (kr :: KeyRole). Int -> WitVKey kr -> ShowS
Show, WitVKey kr -> WitVKey kr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall (kr :: KeyRole). 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 = 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 :: KeyHash 'Witness
wvkKeyHash :: forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash} = KeyHash 'Witness
wvkKeyHash seq :: 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.
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash WitVKey kr
x WitVKey kr
y forall a. Semigroup a => a -> a -> a
<> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> Hash HASH (SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody))
hashTxBodySignature forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: VKey kr
wvkKey :: forall (kr :: KeyRole). WitVKey kr -> VKey kr
wvkKey, SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature :: forall (kr :: KeyRole).
WitVKey kr -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
wvkSignature} =
    Word -> Encoding
Plain.encodeListLen Word
2
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
Plain.toCBOR VKey kr
wvkKey
      forall a. Semigroup a => a -> a -> a
<> 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 =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
Plain.decodeRecordNamed Text
"WitVKey" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$
      forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
WitVKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. FromCBOR a => Decoder s a
Plain.fromCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 $bWitVKey :: forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
$mWitVKey :: forall {r} {kr :: KeyRole}.
WitVKey kr
-> (VKey kr
    -> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> r)
-> ((# #) -> r)
-> r
WitVKey k s <-
  WitVKeyInternal k s _
  where
    WitVKey VKey kr
k SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s =
      let hash :: KeyHash 'Witness
hash = forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey kr
k
       in 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 = forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
wvkKeyHash