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

module Cardano.Ledger.Keys.WitVKey (
  WitVKey (WitVKey),
  witVKeyBytes,
  witVKeyHash,
  eqWitVKeyRaw,
)
where

import Cardano.Crypto.DSIGN.Class (
  SignedDSIGN,
  decodeSignedDSIGN,
  encodeSignedDSIGN,
 )
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  EncCBOR (..),
  ToCBOR (..),
  annotatorSlice,
  fromPlainDecoder,
 )
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 Cardano.Ledger.MemoBytes (EqRaw (..))
import Control.DeepSeq
import qualified Data.ByteString.Lazy as BSL
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)
wvkSig :: !(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.
  , forall (kr :: KeyRole). WitVKey kr -> ByteString
wvkBytes :: BSL.ByteString
  }
  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)

deriving via
  AllowThunksIn '["wvkBytes", "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, ByteString
wvkBytes :: ByteString
wvkBytes :: forall (kr :: KeyRole). WitVKey kr -> ByteString
wvkBytes} = KeyHash 'Witness
wvkKeyHash forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf ByteString
wvkBytes

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)
wvkSig) WitVKey kr
x WitVKey kr
y

instance Typeable kr => Plain.ToCBOR (WitVKey kr) where
  toCBOR :: WitVKey kr -> Encoding
toCBOR = ByteString -> Encoding
Plain.encodePreEncoded forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). WitVKey kr -> ByteString
wvkBytes

-- | Encodes memoized bytes created upon construction.
instance Typeable kr => EncCBOR (WitVKey kr)

instance Typeable kr => DecCBOR (Annotator (WitVKey kr)) where
  decCBOR :: forall s. Decoder s (Annotator (WitVKey kr))
decCBOR =
    forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice forall a b. (a -> b) -> a -> b
$
      forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall a b. (a -> b) -> a -> b
$
        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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall {r :: KeyRole}.
VKey r
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ByteString
-> WitVKey r
mkWitVKey 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
    where
      mkWitVKey :: VKey r
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> ByteString
-> WitVKey r
mkWitVKey VKey r
k SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig = forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
-> KeyHash 'Witness
-> ByteString
-> WitVKey kr
WitVKeyInternal VKey r
k SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig (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 r
k)
      {-# INLINE mkWitVKey #-}
  {-# INLINE decCBOR #-}

instance Typeable kr => EqRaw (WitVKey kr) where
  eqRaw :: WitVKey kr -> WitVKey kr -> Bool
eqRaw = forall (kr :: KeyRole).
Typeable kr =>
WitVKey kr -> WitVKey kr -> Bool
eqWitVKeyRaw

pattern WitVKey ::
  Typeable kr =>
  VKey kr ->
  SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) ->
  WitVKey kr
pattern $bWitVKey :: forall (kr :: KeyRole).
Typeable kr =>
VKey kr
-> SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody) -> WitVKey kr
$mWitVKey :: forall {r} {kr :: KeyRole}.
Typeable kr =>
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 bytes :: ByteString
bytes =
            forall a. ToCBOR a => a -> ByteString
Plain.serialize forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
Plain.encodeListLen Word
2
                forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
Plain.toCBOR VKey kr
k
                forall a. Semigroup a => a -> a -> a
<> forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s
          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
-> ByteString
-> WitVKey kr
WitVKeyInternal VKey kr
k SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s KeyHash 'Witness
hash ByteString
bytes

{-# 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

-- | Access CBOR encoded representation of the witness. Evaluated lazily
witVKeyBytes :: WitVKey kr -> BSL.ByteString
witVKeyBytes :: forall (kr :: KeyRole). WitVKey kr -> ByteString
witVKeyBytes = forall (kr :: KeyRole). WitVKey kr -> ByteString
wvkBytes

eqWitVKeyRaw :: Typeable kr => WitVKey kr -> WitVKey kr -> Bool
eqWitVKeyRaw :: forall (kr :: KeyRole).
Typeable kr =>
WitVKey kr -> WitVKey kr -> Bool
eqWitVKeyRaw (WitVKey VKey kr
k1 SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s1) (WitVKey VKey kr
k2 SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s2) = VKey kr
k1 forall a. Eq a => a -> a -> Bool
== VKey kr
k2 Bool -> Bool -> Bool
&& SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s1 forall a. Eq a => a -> a -> Bool
== SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
s2