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

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

import Cardano.Prelude

import qualified Cardano.Crypto.Wallet as CC
import Formatting (bprint, shown)
import Formatting.Buildable (Buildable(..))

import Cardano.Binary (Annotated(..), serialize')
import Cardano.Crypto.Signing.VerificationKey (VerificationKey(..))
import Cardano.Crypto.ProtocolMagic (ProtocolMagicId(..))


-- | 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.
data SignTag
  = SignForTestingOnly
  -- ^ Anything (to be used for testing only)
  | SignTx
  -- ^ Tx:               @TxSigData@
  | SignRedeemTx
  -- ^ Redeem tx:        @TxSigData@
  | SignVssCert
  -- ^ Vss certificate:  @(VssVerificationKey, EpochNumber)@
  | SignUSProposal
  -- ^ Update proposal:  @UpdateProposalToSign@
  | SignCommitment
  -- ^ Commitment:       @(EpochNumber, Commitment)@
  | SignUSVote
  -- ^ US proposal vote: @(UpId, Bool)@
  | SignBlock VerificationKey
  -- ^ 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
  | SignCertificate
  -- ^ Certificate:      @Certificate@
  deriving (SignTag -> SignTag -> Bool
(SignTag -> SignTag -> Bool)
-> (SignTag -> SignTag -> Bool) -> Eq SignTag
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
Eq SignTag
-> (SignTag -> SignTag -> Ordering)
-> (SignTag -> SignTag -> Bool)
-> (SignTag -> SignTag -> Bool)
-> (SignTag -> SignTag -> Bool)
-> (SignTag -> SignTag -> Bool)
-> (SignTag -> SignTag -> SignTag)
-> (SignTag -> SignTag -> SignTag)
-> Ord 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
$cp1Ord :: Eq SignTag
Ord, Int -> SignTag -> ShowS
[SignTag] -> ShowS
SignTag -> String
(Int -> SignTag -> ShowS)
-> (SignTag -> String) -> ([SignTag] -> ShowS) -> Show SignTag
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. SignTag -> Rep SignTag x)
-> (forall x. Rep SignTag x -> SignTag) -> Generic SignTag
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 = Format Builder (SignTag -> Builder) -> SignTag -> Builder
forall a. Format Builder a -> a
bprint Format Builder (SignTag -> Builder)
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 (ByteString -> SignTag -> ByteString)
-> (Annotated ProtocolMagicId ByteString -> ByteString)
-> Annotated ProtocolMagicId ByteString
-> SignTag
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Annotated ProtocolMagicId ByteString -> ByteString
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 (ByteString -> SignTag -> ByteString)
-> (ProtocolMagicId -> ByteString)
-> ProtocolMagicId
-> SignTag
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word32 -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' (Word32 -> ByteString)
-> (ProtocolMagicId -> Word32) -> ProtocolMagicId -> ByteString
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" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignRedeemTx   -> ByteString
"\x02" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignVssCert    -> ByteString
"\x03" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignUSProposal -> ByteString
"\x04" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignCommitment -> ByteString
"\x05" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network
  SignTag
SignUSVote     -> ByteString
"\x06" ByteString -> ByteString -> ByteString
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" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XPub -> ByteString
CC.unXPub XPub
issuerVK ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\x09" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network

  SignTag
SignCertificate -> ByteString
"\x0a" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
network