-- | 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.V3 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 :: Proxy HydraKey -> AsType HydraKey
proxyToAsType Proxy HydraKey
_ = AsType HydraKey
AsHydraKey

-- | Hashes of Hydra keys
newtype instance Hash HydraKey
  = HydraKeyHash (Crypto.Hash Blake2b_256 (VerificationKey HydraKey))
  deriving stock (Eq (Hash HydraKey)
Eq (Hash HydraKey) =>
(Hash HydraKey -> Hash HydraKey -> Ordering)
-> (Hash HydraKey -> Hash HydraKey -> Bool)
-> (Hash HydraKey -> Hash HydraKey -> Bool)
-> (Hash HydraKey -> Hash HydraKey -> Bool)
-> (Hash HydraKey -> Hash HydraKey -> Bool)
-> (Hash HydraKey -> Hash HydraKey -> Hash HydraKey)
-> (Hash HydraKey -> Hash HydraKey -> Hash HydraKey)
-> Ord (Hash HydraKey)
Hash HydraKey -> Hash HydraKey -> Bool
Hash HydraKey -> Hash HydraKey -> Ordering
Hash HydraKey -> Hash HydraKey -> Hash HydraKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash HydraKey -> Hash HydraKey -> Ordering
compare :: Hash HydraKey -> Hash HydraKey -> Ordering
$c< :: Hash HydraKey -> Hash HydraKey -> Bool
< :: Hash HydraKey -> Hash HydraKey -> Bool
$c<= :: Hash HydraKey -> Hash HydraKey -> Bool
<= :: Hash HydraKey -> Hash HydraKey -> Bool
$c> :: Hash HydraKey -> Hash HydraKey -> Bool
> :: Hash HydraKey -> Hash HydraKey -> Bool
$c>= :: Hash HydraKey -> Hash HydraKey -> Bool
>= :: Hash HydraKey -> Hash HydraKey -> Bool
$cmax :: Hash HydraKey -> Hash HydraKey -> Hash HydraKey
max :: Hash HydraKey -> Hash HydraKey -> Hash HydraKey
$cmin :: Hash HydraKey -> Hash HydraKey -> Hash HydraKey
min :: Hash HydraKey -> Hash HydraKey -> Hash HydraKey
Ord, Hash HydraKey -> Hash HydraKey -> Bool
(Hash HydraKey -> Hash HydraKey -> Bool)
-> (Hash HydraKey -> Hash HydraKey -> Bool) -> Eq (Hash HydraKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash HydraKey -> Hash HydraKey -> Bool
== :: Hash HydraKey -> Hash HydraKey -> Bool
$c/= :: Hash HydraKey -> Hash HydraKey -> Bool
/= :: Hash HydraKey -> Hash HydraKey -> Bool
Eq, Int -> Hash HydraKey -> ShowS
[Hash HydraKey] -> ShowS
Hash HydraKey -> String
(Int -> Hash HydraKey -> ShowS)
-> (Hash HydraKey -> String)
-> ([Hash HydraKey] -> ShowS)
-> Show (Hash HydraKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash HydraKey -> ShowS
showsPrec :: Int -> Hash HydraKey -> ShowS
$cshow :: Hash HydraKey -> String
show :: Hash HydraKey -> String
$cshowList :: [Hash HydraKey] -> ShowS
showList :: [Hash HydraKey] -> ShowS
Show)

instance SerialiseAsRawBytes (Hash HydraKey) where
  serialiseToRawBytes :: Hash HydraKey -> ByteString
serialiseToRawBytes (HydraKeyHash Hash Blake2b_256 (VerificationKey HydraKey)
vkh) = Hash Blake2b_256 (VerificationKey HydraKey) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 (VerificationKey HydraKey)
vkh

  deserialiseFromRawBytes :: AsType (Hash HydraKey)
-> ByteString -> Either SerialiseAsRawBytesError (Hash HydraKey)
deserialiseFromRawBytes (AsHash AsType HydraKey
R:AsTypeHydraKey
AsHydraKey) ByteString
bs =
    Either SerialiseAsRawBytesError (Hash HydraKey)
-> (Hash Blake2b_256 (VerificationKey HydraKey)
    -> Either SerialiseAsRawBytesError (Hash HydraKey))
-> Maybe (Hash Blake2b_256 (VerificationKey HydraKey))
-> Either SerialiseAsRawBytesError (Hash HydraKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either SerialiseAsRawBytesError (Hash HydraKey)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"TODO: SerialiseAsRawBytesError, but constructor not exported") (Hash HydraKey -> Either SerialiseAsRawBytesError (Hash HydraKey)
forall a b. b -> Either a b
Right (Hash HydraKey -> Either SerialiseAsRawBytesError (Hash HydraKey))
-> (Hash Blake2b_256 (VerificationKey HydraKey) -> Hash HydraKey)
-> Hash Blake2b_256 (VerificationKey HydraKey)
-> Either SerialiseAsRawBytesError (Hash HydraKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 (VerificationKey HydraKey) -> Hash HydraKey
HydraKeyHash) (ByteString -> Maybe (Hash Blake2b_256 (VerificationKey HydraKey))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs)

instance Key HydraKey where
  -- Hydra verification key, which can be used to 'verify' signed messages.
  newtype VerificationKey HydraKey
    = HydraVerificationKey (VerKeyDSIGN Ed25519DSIGN)
    deriving stock (VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
(VerificationKey HydraKey -> VerificationKey HydraKey -> Bool)
-> (VerificationKey HydraKey -> VerificationKey HydraKey -> Bool)
-> Eq (VerificationKey HydraKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
== :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
$c/= :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
/= :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
Eq, Int -> VerificationKey HydraKey -> ShowS
[VerificationKey HydraKey] -> ShowS
VerificationKey HydraKey -> String
(Int -> VerificationKey HydraKey -> ShowS)
-> (VerificationKey HydraKey -> String)
-> ([VerificationKey HydraKey] -> ShowS)
-> Show (VerificationKey HydraKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey HydraKey -> ShowS
showsPrec :: Int -> VerificationKey HydraKey -> ShowS
$cshow :: VerificationKey HydraKey -> String
show :: VerificationKey HydraKey -> String
$cshowList :: [VerificationKey HydraKey] -> ShowS
showList :: [VerificationKey HydraKey] -> ShowS
Show, Eq (VerificationKey HydraKey)
Eq (VerificationKey HydraKey) =>
(VerificationKey HydraKey -> VerificationKey HydraKey -> Ordering)
-> (VerificationKey HydraKey -> VerificationKey HydraKey -> Bool)
-> (VerificationKey HydraKey -> VerificationKey HydraKey -> Bool)
-> (VerificationKey HydraKey -> VerificationKey HydraKey -> Bool)
-> (VerificationKey HydraKey -> VerificationKey HydraKey -> Bool)
-> (VerificationKey HydraKey
    -> VerificationKey HydraKey -> VerificationKey HydraKey)
-> (VerificationKey HydraKey
    -> VerificationKey HydraKey -> VerificationKey HydraKey)
-> Ord (VerificationKey HydraKey)
(TypeError ...) => Eq (VerificationKey HydraKey)
(TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
(TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Ordering
(TypeError ...) =>
VerificationKey HydraKey
-> VerificationKey HydraKey -> VerificationKey HydraKey
VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
VerificationKey HydraKey -> VerificationKey HydraKey -> Ordering
VerificationKey HydraKey
-> VerificationKey HydraKey -> VerificationKey HydraKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: (TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Ordering
compare :: VerificationKey HydraKey -> VerificationKey HydraKey -> Ordering
$c< :: (TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
< :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
$c<= :: (TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
<= :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
$c> :: (TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
> :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
$c>= :: (TypeError ...) =>
VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
>= :: VerificationKey HydraKey -> VerificationKey HydraKey -> Bool
$cmax :: (TypeError ...) =>
VerificationKey HydraKey
-> VerificationKey HydraKey -> VerificationKey HydraKey
max :: VerificationKey HydraKey
-> VerificationKey HydraKey -> VerificationKey HydraKey
$cmin :: (TypeError ...) =>
VerificationKey HydraKey
-> VerificationKey HydraKey -> VerificationKey HydraKey
min :: VerificationKey HydraKey
-> VerificationKey HydraKey -> VerificationKey HydraKey
Ord)
    deriving newtype (Typeable (VerificationKey HydraKey)
Typeable (VerificationKey HydraKey) =>
(VerificationKey HydraKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey HydraKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey HydraKey] -> Size)
-> ToCBOR (VerificationKey HydraKey)
VerificationKey HydraKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey HydraKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey HydraKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey HydraKey -> Encoding
toCBOR :: VerificationKey HydraKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey HydraKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey HydraKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey HydraKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey HydraKey] -> Size
ToCBOR, Typeable (VerificationKey HydraKey)
Typeable (VerificationKey HydraKey) =>
(forall s. Decoder s (VerificationKey HydraKey))
-> (Proxy (VerificationKey HydraKey) -> Text)
-> FromCBOR (VerificationKey HydraKey)
Proxy (VerificationKey HydraKey) -> Text
forall s. Decoder s (VerificationKey HydraKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey HydraKey)
fromCBOR :: forall s. Decoder s (VerificationKey HydraKey)
$clabel :: Proxy (VerificationKey HydraKey) -> Text
label :: Proxy (VerificationKey HydraKey) -> Text
FromCBOR)
    deriving anyclass (HasTypeProxy (VerificationKey HydraKey)
AsType (VerificationKey HydraKey)
-> ByteString -> Either DecoderError (VerificationKey HydraKey)
HasTypeProxy (VerificationKey HydraKey) =>
(VerificationKey HydraKey -> ByteString)
-> (AsType (VerificationKey HydraKey)
    -> ByteString -> Either DecoderError (VerificationKey HydraKey))
-> SerialiseAsCBOR (VerificationKey HydraKey)
VerificationKey HydraKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey HydraKey -> ByteString
serialiseToCBOR :: VerificationKey HydraKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey HydraKey)
-> ByteString -> Either DecoderError (VerificationKey HydraKey)
deserialiseFromCBOR :: AsType (VerificationKey HydraKey)
-> ByteString -> Either DecoderError (VerificationKey HydraKey)
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 (SigningKey HydraKey -> SigningKey HydraKey -> Bool
(SigningKey HydraKey -> SigningKey HydraKey -> Bool)
-> (SigningKey HydraKey -> SigningKey HydraKey -> Bool)
-> Eq (SigningKey HydraKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SigningKey HydraKey -> SigningKey HydraKey -> Bool
== :: SigningKey HydraKey -> SigningKey HydraKey -> Bool
$c/= :: SigningKey HydraKey -> SigningKey HydraKey -> Bool
/= :: SigningKey HydraKey -> SigningKey HydraKey -> Bool
Eq, Int -> SigningKey HydraKey -> ShowS
[SigningKey HydraKey] -> ShowS
SigningKey HydraKey -> String
(Int -> SigningKey HydraKey -> ShowS)
-> (SigningKey HydraKey -> String)
-> ([SigningKey HydraKey] -> ShowS)
-> Show (SigningKey HydraKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey HydraKey -> ShowS
showsPrec :: Int -> SigningKey HydraKey -> ShowS
$cshow :: SigningKey HydraKey -> String
show :: SigningKey HydraKey -> String
$cshowList :: [SigningKey HydraKey] -> ShowS
showList :: [SigningKey HydraKey] -> ShowS
Show)
    deriving newtype (Typeable (SigningKey HydraKey)
Typeable (SigningKey HydraKey) =>
(SigningKey HydraKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey HydraKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey HydraKey] -> Size)
-> ToCBOR (SigningKey HydraKey)
SigningKey HydraKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey HydraKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey HydraKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey HydraKey -> Encoding
toCBOR :: SigningKey HydraKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey HydraKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey HydraKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey HydraKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey HydraKey] -> Size
ToCBOR, Typeable (SigningKey HydraKey)
Typeable (SigningKey HydraKey) =>
(forall s. Decoder s (SigningKey HydraKey))
-> (Proxy (SigningKey HydraKey) -> Text)
-> FromCBOR (SigningKey HydraKey)
Proxy (SigningKey HydraKey) -> Text
forall s. Decoder s (SigningKey HydraKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey HydraKey)
fromCBOR :: forall s. Decoder s (SigningKey HydraKey)
$clabel :: Proxy (SigningKey HydraKey) -> Text
label :: Proxy (SigningKey HydraKey) -> Text
FromCBOR)
    deriving anyclass (HasTypeProxy (SigningKey HydraKey)
AsType (SigningKey HydraKey)
-> ByteString -> Either DecoderError (SigningKey HydraKey)
HasTypeProxy (SigningKey HydraKey) =>
(SigningKey HydraKey -> ByteString)
-> (AsType (SigningKey HydraKey)
    -> ByteString -> Either DecoderError (SigningKey HydraKey))
-> SerialiseAsCBOR (SigningKey HydraKey)
SigningKey HydraKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey HydraKey -> ByteString
serialiseToCBOR :: SigningKey HydraKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey HydraKey)
-> ByteString -> Either DecoderError (SigningKey HydraKey)
deserialiseFromCBOR :: AsType (SigningKey HydraKey)
-> ByteString -> Either DecoderError (SigningKey HydraKey)
SerialiseAsCBOR)

  -- Get the 'VerificationKey' for a given 'SigningKey'.
  getVerificationKey :: HasTypeProxy HydraKey =>
SigningKey HydraKey -> VerificationKey HydraKey
getVerificationKey (HydraSigningKey SignKeyDSIGN Ed25519DSIGN
sk) =
    VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey
HydraVerificationKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey)
-> VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
sk

  -- Create a new 'SigningKey' from a 'Seed'. See 'generateSigningKey'
  deterministicSigningKey :: AsType HydraKey -> Seed -> SigningKey HydraKey
deterministicSigningKey AsType HydraKey
R:AsTypeHydraKey
AsHydraKey =
    ByteString -> SigningKey HydraKey
generateSigningKey (ByteString -> SigningKey HydraKey)
-> (Seed -> ByteString) -> Seed -> SigningKey HydraKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> ByteString
getSeedBytes

  -- Get the number of bytes required to seed a signing key with
  -- 'deterministicSigningKey'.
  deterministicSigningKeySeedSize :: AsType HydraKey -> Word
deterministicSigningKeySeedSize AsType HydraKey
R:AsTypeHydraKey
AsHydraKey =
    Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (Proxy Ed25519DSIGN
forall {k} (t :: k). Proxy t
Proxy :: Proxy Ed25519DSIGN)

  -- Get the verification key hash of a 'VerificationKey'. See 'Blake2b_256' for
  -- info on the used hashing algorithm.
  verificationKeyHash :: VerificationKey HydraKey -> Hash HydraKey
verificationKeyHash (HydraVerificationKey VerKeyDSIGN Ed25519DSIGN
vk) =
    Hash Blake2b_256 (VerificationKey HydraKey) -> Hash HydraKey
HydraKeyHash (Hash Blake2b_256 (VerificationKey HydraKey) -> Hash HydraKey)
-> (Hash Blake2b_256 (VerKeyDSIGN Ed25519DSIGN)
    -> Hash Blake2b_256 (VerificationKey HydraKey))
-> Hash Blake2b_256 (VerKeyDSIGN Ed25519DSIGN)
-> Hash HydraKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 (VerKeyDSIGN Ed25519DSIGN)
-> Hash Blake2b_256 (VerificationKey HydraKey)
forall h a b. Hash h a -> Hash h b
castHash (Hash Blake2b_256 (VerKeyDSIGN Ed25519DSIGN) -> Hash HydraKey)
-> Hash Blake2b_256 (VerKeyDSIGN Ed25519DSIGN) -> Hash HydraKey
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN Ed25519DSIGN
-> Hash Blake2b_256 (VerKeyDSIGN Ed25519DSIGN)
forall h.
HashAlgorithm h =>
VerKeyDSIGN Ed25519DSIGN -> Hash h (VerKeyDSIGN Ed25519DSIGN)
forall v h.
(DSIGNAlgorithm v, HashAlgorithm h) =>
VerKeyDSIGN v -> Hash h (VerKeyDSIGN v)
hashVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
vk

instance Arbitrary (SigningKey HydraKey) where
  arbitrary :: Gen (SigningKey HydraKey)
arbitrary = ByteString -> SigningKey HydraKey
generateSigningKey (ByteString -> SigningKey HydraKey)
-> ([Word8] -> ByteString) -> [Word8] -> SigningKey HydraKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> SigningKey HydraKey)
-> Gen [Word8] -> Gen (SigningKey HydraKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

instance SerialiseAsRawBytes (SigningKey HydraKey) where
  serialiseToRawBytes :: SigningKey HydraKey -> ByteString
serialiseToRawBytes (HydraSigningKey SignKeyDSIGN Ed25519DSIGN
sk) =
    SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
sk

  deserialiseFromRawBytes :: AsType (SigningKey HydraKey)
-> ByteString
-> Either SerialiseAsRawBytesError (SigningKey HydraKey)
deserialiseFromRawBytes (AsSigningKey AsType HydraKey
R:AsTypeHydraKey
AsHydraKey) ByteString
bs =
    Either SerialiseAsRawBytesError (SigningKey HydraKey)
-> (SignKeyDSIGN Ed25519DSIGN
    -> Either SerialiseAsRawBytesError (SigningKey HydraKey))
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
-> Either SerialiseAsRawBytesError (SigningKey HydraKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either SerialiseAsRawBytesError (SigningKey HydraKey)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"TODO: SerialiseAsRawBytesError, but constructor not exported") (SigningKey HydraKey
-> Either SerialiseAsRawBytesError (SigningKey HydraKey)
forall a b. b -> Either a b
Right (SigningKey HydraKey
 -> Either SerialiseAsRawBytesError (SigningKey HydraKey))
-> (SignKeyDSIGN Ed25519DSIGN -> SigningKey HydraKey)
-> SignKeyDSIGN Ed25519DSIGN
-> Either SerialiseAsRawBytesError (SigningKey HydraKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN Ed25519DSIGN -> SigningKey HydraKey
HydraSigningKey) (ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
bs)

instance HasTextEnvelope (SigningKey HydraKey) where
  textEnvelopeType :: AsType (SigningKey HydraKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey HydraKey)
_ =
    TextEnvelopeType
"HydraSigningKey_"
      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
algorithmNameDSIGN (Proxy Ed25519DSIGN
forall {k} (t :: k). Proxy t
Proxy :: Proxy Ed25519DSIGN))

instance Arbitrary (VerificationKey HydraKey) where
  arbitrary :: Gen (VerificationKey HydraKey)
arbitrary = SigningKey HydraKey -> VerificationKey HydraKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey HydraKey -> VerificationKey HydraKey)
-> Gen (SigningKey HydraKey) -> Gen (VerificationKey HydraKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SigningKey HydraKey)
forall a. Arbitrary a => Gen a
arbitrary

instance SerialiseAsRawBytes (VerificationKey HydraKey) where
  serialiseToRawBytes :: VerificationKey HydraKey -> ByteString
serialiseToRawBytes (HydraVerificationKey VerKeyDSIGN Ed25519DSIGN
vk) =
    VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
vk

  deserialiseFromRawBytes :: AsType (VerificationKey HydraKey)
-> ByteString
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
deserialiseFromRawBytes (AsVerificationKey AsType HydraKey
R:AsTypeHydraKey
AsHydraKey) ByteString
bs =
    Either SerialiseAsRawBytesError (VerificationKey HydraKey)
-> (VerKeyDSIGN Ed25519DSIGN
    -> Either SerialiseAsRawBytesError (VerificationKey HydraKey))
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"TODO: SerialiseAsRawBytesError, but constructor not exported") (VerificationKey HydraKey
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
forall a b. b -> Either a b
Right (VerificationKey HydraKey
 -> Either SerialiseAsRawBytesError (VerificationKey HydraKey))
-> (VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey)
-> VerKeyDSIGN Ed25519DSIGN
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey
HydraVerificationKey) (ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN ByteString
bs)

instance ToJSON (VerificationKey HydraKey) where
  toJSON :: VerificationKey HydraKey -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (VerificationKey HydraKey -> Text)
-> VerificationKey HydraKey
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey HydraKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
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 :: Value -> Parser (VerificationKey HydraKey)
parseJSON = String
-> (Text -> Parser (VerificationKey HydraKey))
-> Value
-> Parser (VerificationKey HydraKey)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"VerificationKey" ((Text -> Parser (VerificationKey HydraKey))
 -> Value -> Parser (VerificationKey HydraKey))
-> (Text -> Parser (VerificationKey HydraKey))
-> Value
-> Parser (VerificationKey HydraKey)
forall a b. (a -> b) -> a -> b
$ Text -> Parser ByteString
forall (f :: * -> *). MonadFail f => Text -> f ByteString
decodeBase16 (Text -> Parser ByteString)
-> (ByteString -> Parser (VerificationKey HydraKey))
-> Text
-> Parser (VerificationKey HydraKey)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Parser (VerificationKey HydraKey)
deserialiseKey
   where
    deserialiseKey :: ByteString -> Parser (VerificationKey HydraKey)
deserialiseKey =
      Parser (VerificationKey HydraKey)
-> (VerKeyDSIGN Ed25519DSIGN -> Parser (VerificationKey HydraKey))
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Parser (VerificationKey HydraKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (String -> Parser (VerificationKey HydraKey)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unable to deserialize VerificationKey, wrong length")
        (VerificationKey HydraKey -> Parser (VerificationKey HydraKey)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerificationKey HydraKey -> Parser (VerificationKey HydraKey))
-> (VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey)
-> VerKeyDSIGN Ed25519DSIGN
-> Parser (VerificationKey HydraKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VerificationKey HydraKey
HydraVerificationKey)
        (Maybe (VerKeyDSIGN Ed25519DSIGN)
 -> Parser (VerificationKey HydraKey))
-> (ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> ByteString
-> Parser (VerificationKey HydraKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
rawDeserialiseVerKeyDSIGN

instance HasTextEnvelope (VerificationKey HydraKey) where
  textEnvelopeType :: AsType (VerificationKey HydraKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey HydraKey)
_ =
    TextEnvelopeType
"HydraVerificationKey_"
      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
algorithmNameDSIGN (Proxy Ed25519DSIGN
forall {k} (t :: k). Proxy t
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 :: ByteString -> SigningKey HydraKey
generateSigningKey ByteString
seed =
  SignKeyDSIGN Ed25519DSIGN -> SigningKey HydraKey
HydraSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey HydraKey)
-> (Seed -> SignKeyDSIGN Ed25519DSIGN)
-> Seed
-> SigningKey HydraKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SigningKey HydraKey) -> Seed -> SigningKey HydraKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Seed
mkSeedFromBytes ByteString
hashOfSeed
 where
  hashOfSeed :: ByteString
hashOfSeed = Proxy SHA256 -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: * -> *). proxy SHA256 -> ByteString -> ByteString
digest (Proxy SHA256
forall {k} (t :: k). Proxy t
Proxy :: Proxy SHA256) ByteString
seed

-- * Signatures

-- | Signature of 'a', not containing the actual payload.
newtype Signature a = HydraSignature (SigDSIGN Ed25519DSIGN)
  deriving stock (Signature a -> Signature a -> Bool
(Signature a -> Signature a -> Bool)
-> (Signature a -> Signature a -> Bool) -> Eq (Signature a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Signature a -> Signature a -> Bool
$c== :: forall k (a :: k). Signature a -> Signature a -> Bool
== :: Signature a -> Signature a -> Bool
$c/= :: forall k (a :: k). Signature a -> Signature a -> Bool
/= :: Signature a -> Signature a -> Bool
Eq)
  deriving newtype (Typeable (Signature a)
Typeable (Signature a) =>
(Signature a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Signature a) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Signature a] -> Size)
-> ToCBOR (Signature a)
Signature a -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature a] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature a) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall k (a :: k).
(Typeable a, Typeable k) =>
Typeable (Signature a)
forall k (a :: k).
(Typeable a, Typeable k) =>
Signature a -> Encoding
forall k (a :: k).
(Typeable a, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature a] -> Size
forall k (a :: k).
(Typeable a, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature a) -> Size
$ctoCBOR :: forall k (a :: k).
(Typeable a, Typeable k) =>
Signature a -> Encoding
toCBOR :: Signature a -> Encoding
$cencodedSizeExpr :: forall k (a :: k).
(Typeable a, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature a) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature a) -> Size
$cencodedListSizeExpr :: forall k (a :: k).
(Typeable a, Typeable k) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature a] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Signature a] -> Size
ToCBOR, Typeable (Signature a)
Typeable (Signature a) =>
(forall s. Decoder s (Signature a))
-> (Proxy (Signature a) -> Text) -> FromCBOR (Signature a)
Proxy (Signature a) -> Text
forall s. Decoder s (Signature a)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall k (a :: k).
(Typeable a, Typeable k) =>
Typeable (Signature a)
forall k (a :: k).
(Typeable a, Typeable k) =>
Proxy (Signature a) -> Text
forall k (a :: k) s.
(Typeable a, Typeable k) =>
Decoder s (Signature a)
$cfromCBOR :: forall k (a :: k) s.
(Typeable a, Typeable k) =>
Decoder s (Signature a)
fromCBOR :: forall s. Decoder s (Signature a)
$clabel :: forall k (a :: k).
(Typeable a, Typeable k) =>
Proxy (Signature a) -> Text
label :: Proxy (Signature a) -> Text
FromCBOR)

instance Show (Signature a) where
  show :: Signature a -> String
show (HydraSignature SigDSIGN Ed25519DSIGN
sig) =
    String
"HydraSignature " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
hexBytes
   where
    hexBytes :: ByteString
hexBytes = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SigDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN Ed25519DSIGN
sig

instance Hashable (Signature a) where
  hashWithSalt :: Int -> Signature a -> Int
hashWithSalt Int
salt (HydraSignature SigDSIGN Ed25519DSIGN
sig) =
    Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (SigDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN Ed25519DSIGN
sig)

instance (Arbitrary a, SignableRepresentation a) => Arbitrary (Signature a) where
  arbitrary :: Gen (Signature a)
arbitrary = SigningKey HydraKey -> a -> Signature a
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign (SigningKey HydraKey -> a -> Signature a)
-> Gen (SigningKey HydraKey) -> Gen (a -> Signature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SigningKey HydraKey)
forall a. Arbitrary a => Gen a
arbitrary Gen (a -> Signature a) -> Gen a -> Gen (Signature a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
forall a. Arbitrary a => Gen a
arbitrary

instance ToJSON a => ToJSON (Signature a) where
  toJSON :: Signature a -> Value
toJSON (HydraSignature SigDSIGN Ed25519DSIGN
sig) = Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
hexBytes
   where
    hexBytes :: ByteString
hexBytes = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SigDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN Ed25519DSIGN
sig

instance FromJSON a => FromJSON (Signature a) where
  parseJSON :: Value -> Parser (Signature a)
parseJSON = String
-> (Text -> Parser (Signature a)) -> Value -> Parser (Signature a)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Signed" ((Text -> Parser (Signature a)) -> Value -> Parser (Signature a))
-> (Text -> Parser (Signature a)) -> Value -> Parser (Signature a)
forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    ByteString
bs <- Text -> Parser ByteString
forall (f :: * -> *). MonadFail f => Text -> f ByteString
decodeBase16 Text
t
    Parser (Signature a)
-> (SigDSIGN Ed25519DSIGN -> Parser (Signature a))
-> Maybe (SigDSIGN Ed25519DSIGN)
-> Parser (Signature a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (String -> Parser (Signature a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"deserialise signature from bytes failed")
      (Signature a -> Parser (Signature a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature a -> Parser (Signature a))
-> (SigDSIGN Ed25519DSIGN -> Signature a)
-> SigDSIGN Ed25519DSIGN
-> Parser (Signature a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigDSIGN Ed25519DSIGN -> Signature a
forall {k} (a :: k). SigDSIGN Ed25519DSIGN -> Signature a
HydraSignature)
      (Maybe (SigDSIGN Ed25519DSIGN) -> Parser (Signature a))
-> Maybe (SigDSIGN Ed25519DSIGN) -> Parser (Signature a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (SigDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN ByteString
bs

-- | Sign some value 'a' with the provided 'SigningKey'.
sign :: SignableRepresentation a => SigningKey HydraKey -> a -> Signature a
sign :: forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign (HydraSigningKey SignKeyDSIGN Ed25519DSIGN
sk) a
a =
  SigDSIGN Ed25519DSIGN -> Signature a
forall {k} (a :: k). SigDSIGN Ed25519DSIGN -> Signature a
HydraSignature (SigDSIGN Ed25519DSIGN -> Signature a)
-> SigDSIGN Ed25519DSIGN -> Signature a
forall a b. (a -> b) -> a -> b
$ ContextDSIGN Ed25519DSIGN
-> a -> SignKeyDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN
forall a.
(Signable Ed25519DSIGN a, HasCallStack) =>
ContextDSIGN Ed25519DSIGN
-> a -> SignKeyDSIGN Ed25519DSIGN -> SigDSIGN Ed25519DSIGN
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v -> a -> SignKeyDSIGN v -> SigDSIGN v
signDSIGN ()
ContextDSIGN Ed25519DSIGN
ctx a
a SignKeyDSIGN Ed25519DSIGN
sk
 where
  ctx :: ContextDSIGN Ed25519DSIGN
ctx = () :: ContextDSIGN Ed25519DSIGN

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

-- * Multi-signatures

-- | Naiively aggregated multi-signatures.
newtype MultiSignature a = HydraMultiSignature {forall {k} (a :: k). MultiSignature a -> [Signature a]
multiSignature :: [Signature a]}
  deriving stock (MultiSignature a -> MultiSignature a -> Bool
(MultiSignature a -> MultiSignature a -> Bool)
-> (MultiSignature a -> MultiSignature a -> Bool)
-> Eq (MultiSignature a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). MultiSignature a -> MultiSignature a -> Bool
$c== :: forall k (a :: k). MultiSignature a -> MultiSignature a -> Bool
== :: MultiSignature a -> MultiSignature a -> Bool
$c/= :: forall k (a :: k). MultiSignature a -> MultiSignature a -> Bool
/= :: MultiSignature a -> MultiSignature a -> Bool
Eq, Int -> MultiSignature a -> ShowS
[MultiSignature a] -> ShowS
MultiSignature a -> String
(Int -> MultiSignature a -> ShowS)
-> (MultiSignature a -> String)
-> ([MultiSignature a] -> ShowS)
-> Show (MultiSignature a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (a :: k). Int -> MultiSignature a -> ShowS
forall k (a :: k). [MultiSignature a] -> ShowS
forall k (a :: k). MultiSignature a -> String
$cshowsPrec :: forall k (a :: k). Int -> MultiSignature a -> ShowS
showsPrec :: Int -> MultiSignature a -> ShowS
$cshow :: forall k (a :: k). MultiSignature a -> String
show :: MultiSignature a -> String
$cshowList :: forall k (a :: k). [MultiSignature a] -> ShowS
showList :: [MultiSignature a] -> ShowS
Show, (forall x. MultiSignature a -> Rep (MultiSignature a) x)
-> (forall x. Rep (MultiSignature a) x -> MultiSignature a)
-> Generic (MultiSignature a)
forall x. Rep (MultiSignature a) x -> MultiSignature a
forall x. MultiSignature a -> Rep (MultiSignature a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (a :: k) x. Rep (MultiSignature a) x -> MultiSignature a
forall k (a :: k) x. MultiSignature a -> Rep (MultiSignature a) x
$cfrom :: forall k (a :: k) x. MultiSignature a -> Rep (MultiSignature a) x
from :: forall x. MultiSignature a -> Rep (MultiSignature a) x
$cto :: forall k (a :: k) x. Rep (MultiSignature a) x -> MultiSignature a
to :: forall x. Rep (MultiSignature a) x -> MultiSignature a
Generic)
  deriving newtype (NonEmpty (MultiSignature a) -> MultiSignature a
MultiSignature a -> MultiSignature a -> MultiSignature a
(MultiSignature a -> MultiSignature a -> MultiSignature a)
-> (NonEmpty (MultiSignature a) -> MultiSignature a)
-> (forall b.
    Integral b =>
    b -> MultiSignature a -> MultiSignature a)
-> Semigroup (MultiSignature a)
forall b. Integral b => b -> MultiSignature a -> MultiSignature a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall k (a :: k). NonEmpty (MultiSignature a) -> MultiSignature a
forall k (a :: k).
MultiSignature a -> MultiSignature a -> MultiSignature a
forall k (a :: k) b.
Integral b =>
b -> MultiSignature a -> MultiSignature a
$c<> :: forall k (a :: k).
MultiSignature a -> MultiSignature a -> MultiSignature a
<> :: MultiSignature a -> MultiSignature a -> MultiSignature a
$csconcat :: forall k (a :: k). NonEmpty (MultiSignature a) -> MultiSignature a
sconcat :: NonEmpty (MultiSignature a) -> MultiSignature a
$cstimes :: forall k (a :: k) b.
Integral b =>
b -> MultiSignature a -> MultiSignature a
stimes :: forall b. Integral b => b -> MultiSignature a -> MultiSignature a
Semigroup, Semigroup (MultiSignature a)
MultiSignature a
Semigroup (MultiSignature a) =>
MultiSignature a
-> (MultiSignature a -> MultiSignature a -> MultiSignature a)
-> ([MultiSignature a] -> MultiSignature a)
-> Monoid (MultiSignature a)
[MultiSignature a] -> MultiSignature a
MultiSignature a -> MultiSignature a -> MultiSignature a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall k (a :: k). Semigroup (MultiSignature a)
forall k (a :: k). MultiSignature a
forall k (a :: k). [MultiSignature a] -> MultiSignature a
forall k (a :: k).
MultiSignature a -> MultiSignature a -> MultiSignature a
$cmempty :: forall k (a :: k). MultiSignature a
mempty :: MultiSignature a
$cmappend :: forall k (a :: k).
MultiSignature a -> MultiSignature a -> MultiSignature a
mappend :: MultiSignature a -> MultiSignature a -> MultiSignature a
$cmconcat :: forall k (a :: k). [MultiSignature a] -> MultiSignature a
mconcat :: [MultiSignature a] -> MultiSignature a
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 :: Gen (MultiSignature a)
arbitrary = [Signature a] -> MultiSignature a
forall {k} (a :: k). [Signature a] -> MultiSignature a
HydraMultiSignature ([Signature a] -> MultiSignature a)
-> Gen [Signature a] -> Gen (MultiSignature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Signature a]
forall a. Arbitrary a => Gen a
arbitrary

-- | Combine multiple signatures of 'a' into a 'MultiSignature a'.
aggregate :: [Signature a] -> MultiSignature a
aggregate :: forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate = [Signature a] -> MultiSignature a
forall {k} (a :: k). [Signature a] -> MultiSignature a
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 :: forall {k} k (a :: k).
Ord k =>
Map k (Signature a) -> [k] -> MultiSignature a
aggregateInOrder Map k (Signature a)
signatures = [Signature a] -> MultiSignature a
forall {k} (a :: k). [Signature a] -> MultiSignature a
HydraMultiSignature ([Signature a] -> MultiSignature a)
-> ([k] -> [Signature a]) -> [k] -> MultiSignature a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> [Signature a] -> [Signature a])
-> [Signature a] -> [k] -> [Signature a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr k -> [Signature a] -> [Signature a]
appendSignature []
 where
  appendSignature :: k -> [Signature a] -> [Signature a]
appendSignature k
k [Signature a]
sigs =
    case k -> Map k (Signature a) -> Maybe (Signature a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Signature a)
signatures of
      Maybe (Signature a)
Nothing -> [Signature a]
sigs
      Just Signature a
sig -> Signature a
sig Signature a -> [Signature a] -> [Signature a]
forall a. a -> [a] -> [a]
: [Signature a]
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 {Verified -> [VerificationKey HydraKey]
failedKeys :: [VerificationKey HydraKey]}
  | KeyNumberMismatch
  deriving stock (Verified -> Verified -> Bool
(Verified -> Verified -> Bool)
-> (Verified -> Verified -> Bool) -> Eq Verified
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verified -> Verified -> Bool
== :: Verified -> Verified -> Bool
$c/= :: Verified -> Verified -> Bool
/= :: Verified -> Verified -> Bool
Eq, Int -> Verified -> ShowS
[Verified] -> ShowS
Verified -> String
(Int -> Verified -> ShowS)
-> (Verified -> String) -> ([Verified] -> ShowS) -> Show Verified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verified -> ShowS
showsPrec :: Int -> Verified -> ShowS
$cshow :: Verified -> String
show :: Verified -> String
$cshowList :: [Verified] -> ShowS
showList :: [Verified] -> ShowS
Show, (forall x. Verified -> Rep Verified x)
-> (forall x. Rep Verified x -> Verified) -> Generic Verified
forall x. Rep Verified x -> Verified
forall x. Verified -> Rep Verified x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Verified -> Rep Verified x
from :: forall x. Verified -> Rep Verified x
$cto :: forall x. Rep Verified x -> Verified
to :: forall x. Rep Verified x -> Verified
Generic)
  deriving anyclass ([Verified] -> Value
[Verified] -> Encoding
Verified -> Bool
Verified -> Value
Verified -> Encoding
(Verified -> Value)
-> (Verified -> Encoding)
-> ([Verified] -> Value)
-> ([Verified] -> Encoding)
-> (Verified -> Bool)
-> ToJSON Verified
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Verified -> Value
toJSON :: Verified -> Value
$ctoEncoding :: Verified -> Encoding
toEncoding :: Verified -> Encoding
$ctoJSONList :: [Verified] -> Value
toJSONList :: [Verified] -> Value
$ctoEncodingList :: [Verified] -> Encoding
toEncodingList :: [Verified] -> Encoding
$comitField :: Verified -> Bool
omitField :: Verified -> Bool
ToJSON, Maybe Verified
Value -> Parser [Verified]
Value -> Parser Verified
(Value -> Parser Verified)
-> (Value -> Parser [Verified])
-> Maybe Verified
-> FromJSON Verified
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Verified
parseJSON :: Value -> Parser Verified
$cparseJSONList :: Value -> Parser [Verified]
parseJSONList :: Value -> Parser [Verified]
$comittedField :: Maybe Verified
omittedField :: Maybe Verified
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 :: forall a.
SignableRepresentation a =>
[VerificationKey HydraKey] -> MultiSignature a -> a -> Verified
verifyMultiSignature [VerificationKey HydraKey]
vks HydraMultiSignature{[Signature a]
$sel:multiSignature:HydraMultiSignature :: forall {k} (a :: k). MultiSignature a -> [Signature a]
multiSignature :: [Signature a]
multiSignature} a
a
  | [VerificationKey HydraKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VerificationKey HydraKey]
vks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Signature a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Signature a]
multiSignature =
      let verifications :: [(VerificationKey HydraKey, Bool)]
verifications = (VerificationKey HydraKey
 -> Signature a -> (VerificationKey HydraKey, Bool))
-> [VerificationKey HydraKey]
-> [Signature a]
-> [(VerificationKey HydraKey, Bool)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VerificationKey HydraKey
vk Signature a
s -> (VerificationKey HydraKey
vk, VerificationKey HydraKey -> Signature a -> a -> Bool
forall a.
SignableRepresentation a =>
VerificationKey HydraKey -> Signature a -> a -> Bool
verify VerificationKey HydraKey
vk Signature a
s a
a)) [VerificationKey HydraKey]
vks [Signature a]
multiSignature
          failures :: [VerificationKey HydraKey]
failures = (VerificationKey HydraKey, Bool) -> VerificationKey HydraKey
forall a b. (a, b) -> a
fst ((VerificationKey HydraKey, Bool) -> VerificationKey HydraKey)
-> [(VerificationKey HydraKey, Bool)] -> [VerificationKey HydraKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((VerificationKey HydraKey, Bool) -> Bool)
-> [(VerificationKey HydraKey, Bool)]
-> [(VerificationKey HydraKey, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((VerificationKey HydraKey, Bool) -> Bool)
-> (VerificationKey HydraKey, Bool)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationKey HydraKey, Bool) -> Bool
forall a b. (a, b) -> b
snd) [(VerificationKey HydraKey, Bool)]
verifications
       in if [VerificationKey HydraKey] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VerificationKey HydraKey]
failures
            then Verified
Verified
            else [VerificationKey HydraKey] -> Verified
FailedKeys [VerificationKey HydraKey]
failures
  | Bool
otherwise = Verified
KeyNumberMismatch

toPlutusSignatures :: MultiSignature a -> [OnChain.Signature]
toPlutusSignatures :: forall {k} (a :: k). MultiSignature a -> [Signature]
toPlutusSignatures (HydraMultiSignature [Signature a]
sigs) =
  Signature a -> Signature
forall {k} (a :: k). Signature a -> Signature
toPlutusSignature (Signature a -> Signature) -> [Signature a] -> [Signature]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Signature a]
sigs
 where
  toPlutusSignature :: Signature a -> OnChain.Signature
  toPlutusSignature :: forall {k} (a :: k). Signature a -> Signature
toPlutusSignature (HydraSignature SigDSIGN Ed25519DSIGN
sig) =
    ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
Plutus.toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ SigDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SigDSIGN v -> ByteString
rawSerialiseSigDSIGN SigDSIGN Ed25519DSIGN
sig