{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}

module Cardano.Crypto.Signing.Redeem.Signature (
  RedeemSignature (..),
  redeemSign,
  redeemSignRaw,
  verifyRedeemSig,
  verifyRedeemSigDecoded,
  verifyRedeemSigRaw,
)
where

import Cardano.Crypto.Orphans ()
import Cardano.Crypto.ProtocolMagic (ProtocolMagicId)
import Cardano.Crypto.Raw (Raw (..))
import Cardano.Crypto.Signing.Redeem.SigningKey (RedeemSigningKey (..))
import Cardano.Crypto.Signing.Redeem.VerificationKey (RedeemVerificationKey (..))
import Cardano.Crypto.Signing.Tag (SignTag, signTag, signTagDecoded)
import Cardano.Ledger.Binary (
  Annotated,
  DecCBOR,
  Decoded (..),
  EncCBOR,
  FromCBOR (..),
  ToCBOR (..),
  byronProtVer,
  fromByronCBOR,
  serialize',
  toByronCBOR,
 )
import Cardano.Prelude
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.Aeson.TH (defaultOptions, deriveJSON)
import Data.Coerce (coerce)
import qualified Formatting.Buildable as B (Buildable (..))

-- | Wrapper around 'Ed25519.Signature'
type RedeemSignature :: Type -> Type
newtype RedeemSignature a
  = RedeemSignature Ed25519.Signature
  deriving (RedeemSignature a -> RedeemSignature a -> Bool
forall a. RedeemSignature a -> RedeemSignature a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedeemSignature a -> RedeemSignature a -> Bool
$c/= :: forall a. RedeemSignature a -> RedeemSignature a -> Bool
== :: RedeemSignature a -> RedeemSignature a -> Bool
$c== :: forall a. RedeemSignature a -> RedeemSignature a -> Bool
Eq, Int -> RedeemSignature a -> ShowS
forall a. Int -> RedeemSignature a -> ShowS
forall a. [RedeemSignature a] -> ShowS
forall a. RedeemSignature a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedeemSignature a] -> ShowS
$cshowList :: forall a. [RedeemSignature a] -> ShowS
show :: RedeemSignature a -> String
$cshow :: forall a. RedeemSignature a -> String
showsPrec :: Int -> RedeemSignature a -> ShowS
$cshowsPrec :: forall a. Int -> RedeemSignature a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RedeemSignature a) x -> RedeemSignature a
forall a x. RedeemSignature a -> Rep (RedeemSignature a) x
$cto :: forall a x. Rep (RedeemSignature a) x -> RedeemSignature a
$cfrom :: forall a x. RedeemSignature a -> Rep (RedeemSignature a) x
Generic, RedeemSignature a -> ()
forall a. RedeemSignature a -> ()
forall a. (a -> ()) -> NFData a
rnf :: RedeemSignature a -> ()
$crnf :: forall a. RedeemSignature a -> ()
NFData, Proxy (RedeemSignature a) -> Text
forall s. Decoder s (RedeemSignature a)
forall {a}. Typeable a => Typeable (RedeemSignature a)
forall a. Typeable a => Proxy (RedeemSignature a) -> Text
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall a s. Typeable a => Decoder s (RedeemSignature a)
forall a s. Typeable a => Proxy (RedeemSignature a) -> Decoder s ()
forall s. Proxy (RedeemSignature a) -> Decoder s ()
label :: Proxy (RedeemSignature a) -> Text
$clabel :: forall a. Typeable a => Proxy (RedeemSignature a) -> Text
dropCBOR :: forall s. Proxy (RedeemSignature a) -> Decoder s ()
$cdropCBOR :: forall a s. Typeable a => Proxy (RedeemSignature a) -> Decoder s ()
decCBOR :: forall s. Decoder s (RedeemSignature a)
$cdecCBOR :: forall a s. Typeable a => Decoder s (RedeemSignature a)
DecCBOR, RedeemSignature a -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [RedeemSignature a] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (RedeemSignature a) -> Size
forall {a}. Typeable a => Typeable (RedeemSignature a)
forall a. Typeable a => RedeemSignature a -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall a.
Typeable a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [RedeemSignature a] -> Size
forall a.
Typeable a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (RedeemSignature a) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [RedeemSignature a] -> Size
$cencodedListSizeExpr :: forall a.
Typeable a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [RedeemSignature a] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (RedeemSignature a) -> Size
$cencodedSizeExpr :: forall a.
Typeable a =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (RedeemSignature a) -> Size
encCBOR :: RedeemSignature a -> Encoding
$cencCBOR :: forall a. Typeable a => RedeemSignature a -> Encoding
EncCBOR)

instance EncCBOR a => ToCBOR (RedeemSignature a) where
  toCBOR :: RedeemSignature a -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance DecCBOR a => FromCBOR (RedeemSignature a) where
  fromCBOR :: forall s. Decoder s (RedeemSignature a)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Note that there is deliberately no Ord instance. The crypto libraries
-- encourage using key /hashes/ not keys for things like sets, map etc.

instance B.Buildable (RedeemSignature a) where
  build :: RedeemSignature a -> Builder
build RedeemSignature a
_ = Builder
"<redeem signature>"

deriveJSON defaultOptions ''RedeemSignature

-- | Encode something with 'EncCBOR' and sign it
redeemSign ::
  EncCBOR a =>
  ProtocolMagicId ->
  SignTag ->
  RedeemSigningKey ->
  a ->
  RedeemSignature a
redeemSign :: forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign ProtocolMagicId
pm SignTag
tag RedeemSigningKey
k = coerce :: forall a b. Coercible a b => a -> b
coerce forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolMagicId
-> Maybe SignTag
-> RedeemSigningKey
-> ByteString
-> RedeemSignature Raw
redeemSignRaw ProtocolMagicId
pm (forall a. a -> Maybe a
Just SignTag
tag) RedeemSigningKey
k forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer

-- | Alias for constructor
redeemSignRaw ::
  ProtocolMagicId ->
  Maybe SignTag ->
  RedeemSigningKey ->
  ByteString ->
  RedeemSignature Raw
redeemSignRaw :: ProtocolMagicId
-> Maybe SignTag
-> RedeemSigningKey
-> ByteString
-> RedeemSignature Raw
redeemSignRaw ProtocolMagicId
pm Maybe SignTag
mbTag (RedeemSigningKey SecretKey
k) ByteString
x =
  forall a. Signature -> RedeemSignature a
RedeemSignature forall a b. (a -> b) -> a -> b
$ forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
k (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
k) forall a b. (a -> b) -> a -> b
$ ByteString
tag forall a. Semigroup a => a -> a -> a
<> ByteString
x
  where
    tag :: ByteString
tag = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (ProtocolMagicId -> SignTag -> ByteString
signTag ProtocolMagicId
pm) Maybe SignTag
mbTag

-- | Verify a redeem signature
verifyRedeemSig ::
  EncCBOR a =>
  ProtocolMagicId ->
  SignTag ->
  RedeemVerificationKey ->
  a ->
  RedeemSignature a ->
  Bool
verifyRedeemSig :: forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag
-> RedeemVerificationKey
-> a
-> RedeemSignature a
-> Bool
verifyRedeemSig ProtocolMagicId
pm SignTag
tag RedeemVerificationKey
k a
x RedeemSignature a
s =
  RedeemVerificationKey -> ByteString -> RedeemSignature Raw -> Bool
verifyRedeemSigRaw RedeemVerificationKey
k (ProtocolMagicId -> SignTag -> ByteString
signTag ProtocolMagicId
pm SignTag
tag forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => Version -> a -> ByteString
serialize' forall a. Bounded a => a
minBound a
x) (coerce :: forall a b. Coercible a b => a -> b
coerce RedeemSignature a
s)

verifyRedeemSigDecoded ::
  Decoded t =>
  Annotated ProtocolMagicId ByteString ->
  SignTag ->
  RedeemVerificationKey ->
  t ->
  RedeemSignature (BaseType t) ->
  Bool
verifyRedeemSigDecoded :: forall t.
Decoded t =>
Annotated ProtocolMagicId ByteString
-> SignTag
-> RedeemVerificationKey
-> t
-> RedeemSignature (BaseType t)
-> Bool
verifyRedeemSigDecoded Annotated ProtocolMagicId ByteString
pm SignTag
tag RedeemVerificationKey
k t
x RedeemSignature (BaseType t)
s =
  RedeemVerificationKey -> ByteString -> RedeemSignature Raw -> Bool
verifyRedeemSigRaw RedeemVerificationKey
k (Annotated ProtocolMagicId ByteString -> SignTag -> ByteString
signTagDecoded Annotated ProtocolMagicId ByteString
pm SignTag
tag forall a. Semigroup a => a -> a -> a
<> forall t. Decoded t => t -> ByteString
recoverBytes t
x) (coerce :: forall a b. Coercible a b => a -> b
coerce RedeemSignature (BaseType t)
s)

-- | Verify raw 'ByteString'
verifyRedeemSigRaw ::
  RedeemVerificationKey ->
  ByteString ->
  RedeemSignature Raw ->
  Bool
verifyRedeemSigRaw :: RedeemVerificationKey -> ByteString -> RedeemSignature Raw -> Bool
verifyRedeemSigRaw (RedeemVerificationKey PublicKey
k) ByteString
x (RedeemSignature Signature
s) =
  forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
k ByteString
x Signature
s