Crypto.hs

-- | Hydra multi-signature credentials and cryptographic primitives used to sign
-- and verify snapshots (or any messages) within the Hydra protocol.
--
-- We are re-using the 'Key' interface of 'cardano-api' for a consistent
-- representation. For example: Cardano credentials are 'VerificationKey
-- PaymentKey', Hydra credentials are 'VerificationKey HydraKey'.
--
-- Currently 'MultiSignature' interface is only supporting naiive, concatenated
-- multi-signatures and will change when we adopt aggregated multi-signatures
-- including aggregate keys.
module Hydra.Tx.Crypto (
  -- * Cardano Key interface
  Key (..),

  -- * Hydra specifics
  Hash (HydraKeyHash),
  AsType (AsHydraKey),
  module Hydra.Tx.Crypto,
) where

import Hydra.Prelude hiding (Key, show)

import Cardano.Crypto.DSIGN (
  ContextDSIGN,
  Ed25519DSIGN,
  SigDSIGN,
  SignKeyDSIGN,
  VerKeyDSIGN,
  algorithmNameDSIGN,
  deriveVerKeyDSIGN,
  genKeyDSIGN,
  hashVerKeyDSIGN,
  rawDeserialiseSigDSIGN,
  rawDeserialiseSignKeyDSIGN,
  rawDeserialiseVerKeyDSIGN,
  rawSerialiseSigDSIGN,
  rawSerialiseSignKeyDSIGN,
  rawSerialiseVerKeyDSIGN,
  seedSizeDSIGN,
  signDSIGN,
  verifyDSIGN,
 )
import Cardano.Crypto.DSIGN qualified as Crypto
import Cardano.Crypto.Hash (Blake2b_256, SHA256, castHash, hashFromBytes, hashToBytes)
import Cardano.Crypto.Hash qualified as Crypto
import Cardano.Crypto.Hash.Class (HashAlgorithm (digest))
import Cardano.Crypto.Seed (getSeedBytes, mkSeedFromBytes)
import Cardano.Crypto.Util (SignableRepresentation)
import Data.Aeson qualified as Aeson
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.Map qualified as Map
import Hydra.Cardano.Api (
  AsType (AsHash, AsSigningKey, AsVerificationKey),
  HasTextEnvelope (..),
  HasTypeProxy (..),
  Hash,
  Key (..),
  SerialiseAsCBOR,
  SerialiseAsRawBytes (..),
  serialiseToRawBytesHexText,
 )
import Hydra.Contract.HeadState qualified as OnChain
import PlutusLedgerApi.V2 qualified as Plutus
import Test.QuickCheck (vectorOf)
import Test.QuickCheck.Instances.ByteString ()
import Text.Show (Show (..))

-- * Hydra keys

-- | Hydra keys (keyrole) which can be used to 'sign' and 'verify' messages, as
-- well as 'aggregate' multi-signatures.
data HydraKey

instance HasTypeProxy HydraKey where
  data AsType HydraKey = AsHydraKey
  proxyToAsType _ = AsHydraKey

-- | Hashes of Hydra keys
newtype instance Hash HydraKey
  = HydraKeyHash (Crypto.Hash Blake2b_256 (VerificationKey HydraKey))
  deriving stock (Ord, Eq, Show)

instance SerialiseAsRawBytes (Hash HydraKey) where
  serialiseToRawBytes (HydraKeyHash vkh) = hashToBytes vkh

  deserialiseFromRawBytes (AsHash AsHydraKey) bs =
    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraKeyHash) (hashFromBytes bs)

instance Key HydraKey where
  -- Hydra verification key, which can be used to 'verify' signed messages.
  newtype VerificationKey HydraKey
    = HydraVerificationKey (VerKeyDSIGN Ed25519DSIGN)
    deriving stock (Eq, Show, Ord)
    deriving newtype (ToCBOR, FromCBOR)
    deriving anyclass (SerialiseAsCBOR)

  -- Hydra signing key which can be used to 'sign' messages and 'aggregate'
  -- multi-signatures or 'deriveVerificationKey'.
  --
  -- REVIEW: Maybe rewrite Show instance to /not/ expose secret, eg. 8 bytes
  -- from the hash of the key? Although both, cardano-api and
  -- cardano-crypto-class are both deriving this and thus showing secret key
  -- material as well.
  newtype SigningKey HydraKey
    = HydraSigningKey (SignKeyDSIGN Ed25519DSIGN)
    deriving stock (Eq, Show)
    deriving newtype (ToCBOR, FromCBOR)
    deriving anyclass (SerialiseAsCBOR)

  -- Get the 'VerificationKey' for a given 'SigningKey'.
  getVerificationKey (HydraSigningKey sk) =
    HydraVerificationKey $ deriveVerKeyDSIGN sk

  -- Create a new 'SigningKey' from a 'Seed'. See 'generateSigningKey'
  deterministicSigningKey AsHydraKey =
    generateSigningKey . getSeedBytes

  -- Get the number of bytes required to seed a signing key with
  -- 'deterministicSigningKey'.
  deterministicSigningKeySeedSize AsHydraKey =
    seedSizeDSIGN (Proxy :: Proxy Ed25519DSIGN)

  -- Get the verification key hash of a 'VerificationKey'. See 'Blake2b_256' for
  -- info on the used hashing algorithm.
  verificationKeyHash (HydraVerificationKey vk) =
    HydraKeyHash . castHash $ hashVerKeyDSIGN vk

instance Arbitrary (SigningKey HydraKey) where
  arbitrary = generateSigningKey . BS.pack <$> vectorOf 32 arbitrary

instance SerialiseAsRawBytes (SigningKey HydraKey) where
  serialiseToRawBytes (HydraSigningKey sk) =
    rawSerialiseSignKeyDSIGN sk

  deserialiseFromRawBytes (AsSigningKey AsHydraKey) bs =
    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraSigningKey) (rawDeserialiseSignKeyDSIGN bs)

instance HasTextEnvelope (SigningKey HydraKey) where
  textEnvelopeType _ =
    "HydraSigningKey_"
      <> fromString (algorithmNameDSIGN (Proxy :: Proxy Ed25519DSIGN))

instance Arbitrary (VerificationKey HydraKey) where
  arbitrary = getVerificationKey <$> arbitrary

instance SerialiseAsRawBytes (VerificationKey HydraKey) where
  serialiseToRawBytes (HydraVerificationKey vk) =
    rawSerialiseVerKeyDSIGN vk

  deserialiseFromRawBytes (AsVerificationKey AsHydraKey) bs =
    maybe (error "TODO: SerialiseAsRawBytesError, but constructor not exported") (Right . HydraVerificationKey) (rawDeserialiseVerKeyDSIGN bs)

instance ToJSON (VerificationKey HydraKey) where
  toJSON = toJSON . serialiseToRawBytesHexText

-- TODO: It would be nice(r) to have a bech32 representation for verification
-- keys BUT cardano-api decided to not expose the class internals which makes it
-- impossible to define new instances for that class :upside-down-smiling-face:
--
-- instance SerialiseAsBech32 VerificationKey where
--  bech32PrefixFor = const "hydra_vk"
--  bech32PrefixesPermitted _ = ["hydra_vk"]

instance FromJSON (VerificationKey HydraKey) where
  parseJSON = Aeson.withText "VerificationKey" $ decodeBase16 >=> deserialiseKey
   where
    deserialiseKey =
      maybe
        (fail "unable to deserialize VerificationKey, wrong length")
        (pure . HydraVerificationKey)
        . rawDeserialiseVerKeyDSIGN

instance HasTextEnvelope (VerificationKey HydraKey) where
  textEnvelopeType _ =
    "HydraVerificationKey_"
      <> fromString (algorithmNameDSIGN (Proxy :: Proxy Ed25519DSIGN))

-- | Create a new 'SigningKey' from a 'ByteString' seed. The created keys are
-- not random and insecure, so don't use this in production code!
generateSigningKey :: ByteString -> SigningKey HydraKey
generateSigningKey seed =
  HydraSigningKey . genKeyDSIGN $ mkSeedFromBytes hashOfSeed
 where
  hashOfSeed = digest (Proxy :: Proxy SHA256) seed

-- * Signatures

-- | Signature of 'a', not containing the actual payload.
newtype Signature a = HydraSignature (SigDSIGN Ed25519DSIGN)
  deriving stock (Eq)
  deriving newtype (ToCBOR, FromCBOR)

instance Show (Signature a) where
  show (HydraSignature sig) =
    "HydraSignature " <> show hexBytes
   where
    hexBytes = Base16.encode $ rawSerialiseSigDSIGN sig

instance Hashable (Signature a) where
  hashWithSalt salt (HydraSignature sig) =
    hashWithSalt salt (rawSerialiseSigDSIGN sig)

instance (Arbitrary a, SignableRepresentation a) => Arbitrary (Signature a) where
  arbitrary = sign <$> arbitrary <*> arbitrary

instance ToJSON a => ToJSON (Signature a) where
  toJSON (HydraSignature sig) = Aeson.String $ decodeUtf8 hexBytes
   where
    hexBytes = Base16.encode $ rawSerialiseSigDSIGN sig

instance FromJSON a => FromJSON (Signature a) where
  parseJSON = Aeson.withText "Signed" $ \t -> do
    bs <- decodeBase16 t
    maybe
      (fail "deserialise signature from bytes failed")
      (pure . HydraSignature)
      $ rawDeserialiseSigDSIGN bs

-- | Sign some value 'a' with the provided 'SigningKey'.
sign :: SignableRepresentation a => SigningKey HydraKey -> a -> Signature a
sign (HydraSigningKey sk) a =
  HydraSignature $ signDSIGN ctx a sk
 where
  ctx = () :: ContextDSIGN Ed25519DSIGN

-- | Verify a given 'Signature a' and value 'a' using provided 'VerificationKey'.
verify ::
  SignableRepresentation a =>
  VerificationKey HydraKey ->
  Signature a ->
  a ->
  Bool
verify (HydraVerificationKey vk) (HydraSignature sig) a =
  case verifyDSIGN ctx vk a sig of
    Right () -> True
    -- NOTE: Current implementation does not yield multiple Left cases, so no need
    -- to distinguish in our interface
    Left _ -> False
 where
  ctx = () :: ContextDSIGN Ed25519DSIGN

-- * Multi-signatures

-- | Naiively aggregated multi-signatures.
newtype MultiSignature a = HydraMultiSignature {multiSignature :: [Signature a]}
  deriving stock (Eq, Show, Generic)
  deriving newtype (Semigroup, Monoid)

deriving anyclass instance ToJSON a => ToJSON (MultiSignature a)
deriving anyclass instance FromJSON a => FromJSON (MultiSignature a)

instance (Arbitrary a, SignableRepresentation a) => Arbitrary (MultiSignature a) where
  arbitrary = HydraMultiSignature <$> arbitrary

-- | Combine multiple signatures of 'a' into a 'MultiSignature a'.
aggregate :: [Signature a] -> MultiSignature a
aggregate = HydraMultiSignature

-- | Like aggregate, but use order of given list of keys instead.
-- FIXME(AB): This function exists solely because the order of signatures
-- matters on-chain, and it should match the order of parties as declared in the
-- initTx. This should disappear once we use a proper multisignature scheme
aggregateInOrder :: Ord k => Map k (Signature a) -> [k] -> MultiSignature a
aggregateInOrder signatures = HydraMultiSignature . foldr appendSignature []
 where
  appendSignature k sigs =
    case Map.lookup k signatures of
      Nothing -> sigs
      Just sig -> sig : sigs

-- | A result type for multisigs verification providing some information
-- in case of failure.
--
-- This type is of course structurally equivalent to `Maybe [VerificationKey HydraKey]` but it's much more explicit.
data Verified
  = Verified
  | FailedKeys {failedKeys :: [VerificationKey HydraKey]}
  | KeyNumberMismatch
  deriving stock (Eq, Show, Generic)
  deriving anyclass (ToJSON, FromJSON)

-- | Verify a given 'MultiSignature a' and value 'a' provided a list of
-- 'VerificationKey'.
--
-- Note that order of keys is relevant and that length of signature and
-- multisignature list needs to be the same.
verifyMultiSignature ::
  SignableRepresentation a =>
  [VerificationKey HydraKey] ->
  MultiSignature a ->
  a ->
  Verified
verifyMultiSignature vks HydraMultiSignature{multiSignature} a
  | length vks == length multiSignature =
      let verifications = zipWith (\vk s -> (vk, verify vk s a)) vks multiSignature
          failures = fst <$> filter (not . snd) verifications
       in if null failures
            then Verified
            else FailedKeys failures
  | otherwise = KeyNumberMismatch

toPlutusSignatures :: MultiSignature a -> [OnChain.Signature]
toPlutusSignatures (HydraMultiSignature sigs) =
  toPlutusSignature <$> sigs
 where
  toPlutusSignature :: Signature a -> OnChain.Signature
  toPlutusSignature (HydraSignature sig) =
    Plutus.toBuiltin $ rawSerialiseSigDSIGN sig