{-# 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 (
  decodeSignedDSIGN,
  encodeSignedDSIGN,
 )
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  EncCBOR (..),
  ToCBOR (..),
  annotatorSlice,
  fromPlainDecoder,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Crypto
import Cardano.Ledger.Hashes (EraIndependentTxBody)
import Cardano.Ledger.Keys.Internal (
  Hash,
  KeyHash (..),
  KeyRole (..),
  SignedDSIGN,
  VKey,
  asWitness,
  hashKey,
  hashSignature,
 )
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 c = WitVKeyInternal
  { forall (kr :: KeyRole) c. WitVKey kr c -> VKey kr c
wvkKey :: !(VKey kr c)
  , forall (kr :: KeyRole) c.
WitVKey kr c -> SignedDSIGN c (Hash c EraIndependentTxBody)
wvkSig :: !(SignedDSIGN c (Hash c EraIndependentTxBody))
  , forall (kr :: KeyRole) c. WitVKey kr c -> KeyHash 'Witness c
wvkKeyHash :: KeyHash 'Witness c
  -- ^ Hash of the witness vkey. We store this here to avoid repeated hashing
  --   when used in ordering.
  , forall (kr :: KeyRole) c. WitVKey kr c -> ByteString
wvkBytes :: BSL.ByteString
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kr :: KeyRole) c x. Rep (WitVKey kr c) x -> WitVKey kr c
forall (kr :: KeyRole) c x. WitVKey kr c -> Rep (WitVKey kr c) x
$cto :: forall (kr :: KeyRole) c x. Rep (WitVKey kr c) x -> WitVKey kr c
$cfrom :: forall (kr :: KeyRole) c x. WitVKey kr c -> Rep (WitVKey kr c) x
Generic)

deriving instance Crypto c => Show (WitVKey kr c)

deriving instance Crypto c => Eq (WitVKey kr c)

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

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

instance (Typeable kr, Crypto c) => Ord (WitVKey kr c) where
  compare :: WitVKey kr c -> WitVKey kr c -> Ordering
compare WitVKey kr c
x WitVKey kr c
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) c. WitVKey kr c -> KeyHash 'Witness c
wvkKeyHash WitVKey kr c
x WitVKey kr c
y forall a. Semigroup a => a -> a -> a
<> forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall c h.
Crypto c =>
SignedDSIGN c (Hash c h) -> Hash c (SignedDSIGN c (Hash c h))
hashSignature @c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c.
WitVKey kr c -> SignedDSIGN c (Hash c EraIndependentTxBody)
wvkSig) WitVKey kr c
x WitVKey kr c
y

instance (Typeable kr, Crypto c) => Plain.ToCBOR (WitVKey kr c) where
  toCBOR :: WitVKey kr c -> 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) c. WitVKey kr c -> ByteString
wvkBytes

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

instance (Typeable kr, Crypto c) => DecCBOR (Annotator (WitVKey kr c)) where
  decCBOR :: forall s. Decoder s (Annotator (WitVKey kr c))
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 {c} {r :: KeyRole}.
Crypto c =>
VKey r c
-> SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
-> ByteString
-> WitVKey r c
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 c
-> SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
-> ByteString
-> WitVKey r c
mkWitVKey VKey r c
k SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
sig = forall (kr :: KeyRole) c.
VKey kr c
-> SignedDSIGN c (Hash c EraIndependentTxBody)
-> KeyHash 'Witness c
-> ByteString
-> WitVKey kr c
WitVKeyInternal VKey r c
k SignedDSIGN (DSIGN c) (Hash (HASH c) EraIndependentTxBody)
sig (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey r c
k)
      {-# INLINE mkWitVKey #-}
  {-# INLINE decCBOR #-}

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

pattern WitVKey ::
  (Typeable kr, Crypto c) =>
  VKey kr c ->
  SignedDSIGN c (Hash c EraIndependentTxBody) ->
  WitVKey kr c
pattern $bWitVKey :: forall (kr :: KeyRole) c.
(Typeable kr, Crypto c) =>
VKey kr c
-> SignedDSIGN c (Hash c EraIndependentTxBody) -> WitVKey kr c
$mWitVKey :: forall {r} {kr :: KeyRole} {c}.
(Typeable kr, Crypto c) =>
WitVKey kr c
-> (VKey kr c -> SignedDSIGN c (Hash c EraIndependentTxBody) -> r)
-> ((# #) -> r)
-> r
WitVKey k s <-
  WitVKeyInternal k s _ _
  where
    WitVKey VKey kr c
k SignedDSIGN c (Hash c 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 c
k
                forall a. Semigroup a => a -> a -> a
<> forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN c (Hash c EraIndependentTxBody)
s
          hash :: KeyHash 'Witness c
hash = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey VKey kr c
k
       in forall (kr :: KeyRole) c.
VKey kr c
-> SignedDSIGN c (Hash c EraIndependentTxBody)
-> KeyHash 'Witness c
-> ByteString
-> WitVKey kr c
WitVKeyInternal VKey kr c
k SignedDSIGN c (Hash c EraIndependentTxBody)
s KeyHash 'Witness c
hash ByteString
bytes

{-# COMPLETE WitVKey #-}

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

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

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