{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneKindSignatures #-}

module Cardano.Crypto.Signing.Tag (
  SignTag (..),
  signTag,
  signTagDecoded,
)
where

import Cardano.Crypto.ProtocolMagic (ProtocolMagicId (..))
import Cardano.Crypto.Signing.VerificationKey (VerificationKey (..))
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Ledger.Binary (Annotated (..), byronProtVer, serialize')
import Cardano.Prelude
import Formatting (bprint, shown)
import Formatting.Buildable (Buildable (..))

-- | To protect against replay attacks (i.e. when an attacker intercepts a
--   signed piece of data and later sends it again), we add a tag to all data
--   that we sign. This ensures that even if some bytestring can be deserialized
--   into two different types of messages (A and B), the attacker can't take
--   message A and send it as message B.
--
--   We also automatically add the network tag ('protocolMagic') whenever it
--   makes sense, to ensure that things intended for testnet won't work for
--   mainnet.
type SignTag :: Type
data SignTag
  = -- | Anything (to be used for testing only)
    SignForTestingOnly
  | -- | Tx:               @TxSigData@
    SignTx
  | -- | Redeem tx:        @TxSigData@
    SignRedeemTx
  | -- | Vss certificate:  @(VssVerificationKey, EpochNumber)@
    SignVssCert
  | -- | Update proposal:  @UpdateProposalToSign@
    SignUSProposal
  | -- | Commitment:       @(EpochNumber, Commitment)@
    SignCommitment
  | -- | US proposal vote: @(UpId, Bool)@
    SignUSVote
  | -- | Block header:     @ToSign@
    --
    --   This constructor takes the 'VerificationKey' of the delegation
    --   certificate issuer, which is prepended to the signature as part of the
    --   sign tag
    SignBlock VerificationKey
  | -- | Certificate:      @Certificate@
    SignCertificate
  deriving (SignTag -> SignTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignTag -> SignTag -> Bool
$c/= :: SignTag -> SignTag -> Bool
== :: SignTag -> SignTag -> Bool
$c== :: SignTag -> SignTag -> Bool
Eq, Eq SignTag
SignTag -> SignTag -> Bool
SignTag -> SignTag -> Ordering
SignTag -> SignTag -> SignTag
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
min :: SignTag -> SignTag -> SignTag
$cmin :: SignTag -> SignTag -> SignTag
max :: SignTag -> SignTag -> SignTag
$cmax :: SignTag -> SignTag -> SignTag
>= :: SignTag -> SignTag -> Bool
$c>= :: SignTag -> SignTag -> Bool
> :: SignTag -> SignTag -> Bool
$c> :: SignTag -> SignTag -> Bool
<= :: SignTag -> SignTag -> Bool
$c<= :: SignTag -> SignTag -> Bool
< :: SignTag -> SignTag -> Bool
$c< :: SignTag -> SignTag -> Bool
compare :: SignTag -> SignTag -> Ordering
$ccompare :: SignTag -> SignTag -> Ordering
Ord, Int -> SignTag -> ShowS
[SignTag] -> ShowS
SignTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignTag] -> ShowS
$cshowList :: [SignTag] -> ShowS
show :: SignTag -> String
$cshow :: SignTag -> String
showsPrec :: Int -> SignTag -> ShowS
$cshowsPrec :: Int -> SignTag -> ShowS
Show, forall x. Rep SignTag x -> SignTag
forall x. SignTag -> Rep SignTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignTag x -> SignTag
$cfrom :: forall x. SignTag -> Rep SignTag x
Generic)

-- TODO: it would be nice if we couldn't use 'SignTag' with wrong
-- types. Maybe something with GADTs and data families?

instance Buildable SignTag where
  build :: SignTag -> Builder
build = forall a. Format Builder a -> a
bprint forall a r. Show a => Format r (a -> r)
shown

-- | Get magic bytes corresponding to a 'SignTag', taking `ProtocolMagic` bytes
--   from the annotation
signTagDecoded :: Annotated ProtocolMagicId ByteString -> SignTag -> ByteString
signTagDecoded :: Annotated ProtocolMagicId ByteString -> SignTag -> ByteString
signTagDecoded = ByteString -> SignTag -> ByteString
signTagRaw forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. Annotated b a -> a
annotation

-- | Get magic bytes corresponding to a 'SignTag'. Guaranteed to be different
--   (and begin with a different byte) for different tags.
signTag :: ProtocolMagicId -> SignTag -> ByteString
signTag :: ProtocolMagicId -> SignTag -> ByteString
signTag = ByteString -> SignTag -> ByteString
signTagRaw 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolMagicId -> Word32
unProtocolMagicId

signTagRaw :: ByteString -> SignTag -> ByteString
signTagRaw :: ByteString -> SignTag -> ByteString
signTagRaw ByteString
network = \case
  SignTag
SignForTestingOnly -> ByteString
"\x00"
  SignTag
SignTx -> ByteString
"\x01" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignRedeemTx -> ByteString
"\x02" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignVssCert -> ByteString
"\x03" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignUSProposal -> ByteString
"\x04" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignCommitment -> ByteString
"\x05" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignUSVote -> ByteString
"\x06" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  -- "\x07" was used for SignMainBlock, but was never used in mainnet
  -- "\x08" was used for SignMainBlockLight, but was never used in mainnet

  -- This tag includes the prefix that was previously added in @proxySign@,
  -- allowing us to unify the two signing functions
  SignBlock (VerificationKey XPub
issuerVK) ->
    ByteString
"01" forall a. Semigroup a => a -> a -> a
<> XPub -> ByteString
CC.unXPub XPub
issuerVK forall a. Semigroup a => a -> a -> a
<> ByteString
"\x09" forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignCertificate -> ByteString
"\x0a" forall a. Semigroup a => a -> a -> a
<> ByteString
network