{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Crypto.Signing.Signature
  ( -- * Signature
    Signature (..),
    toCBORXSignature,
    fromCBORXSignature,
    fullSignatureHexF,
    parseFullSignature,

    -- * Signing
    sign,
    signEncoded,
    signRaw,
    safeSign,
    safeSignRaw,

    -- * Verification
    verifySignature,
    verifySignatureDecoded,
    verifySignatureRaw,
  )
where

import Cardano.Binary
  ( Annotated (..),
    Decoded (..),
    Decoder,
    Encoding,
    FromCBOR (..),
    Raw,
    ToCBOR (..),
    serialize',
    serializeEncoding,
  )
import Cardano.Crypto.ProtocolMagic (ProtocolMagicId)
import Cardano.Crypto.Signing.Safe
  ( PassPhrase (..),
    SafeSigner (..),
  )
import Cardano.Crypto.Signing.SigningKey (SigningKey (..))
import Cardano.Crypto.Signing.Tag (SignTag (..), signTag, signTagDecoded)
import Cardano.Crypto.Signing.VerificationKey (VerificationKey (..))
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Prelude
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
import qualified Data.Text.Encoding as T
import Formatting (Format, bprint, formatToString, later, sformat, shown, stext)
import qualified Formatting.Buildable as B
import NoThunks.Class (InspectHeap (..), NoThunks (..))
import Text.JSON.Canonical (JSValue (..), toJSString)
import qualified Text.JSON.Canonical as TJC (FromJSON (..), ToJSON (..))

--------------------------------------------------------------------------------
-- Signature
--------------------------------------------------------------------------------

-- | Wrapper around 'CC.XSignature'
newtype Signature a
  = Signature CC.XSignature
  deriving stock (Signature a -> Signature a -> Bool
(Signature a -> Signature a -> Bool)
-> (Signature a -> Signature a -> Bool) -> Eq (Signature a)
forall a. Signature a -> Signature a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature a -> Signature a -> Bool
$c/= :: forall a. Signature a -> Signature a -> Bool
== :: Signature a -> Signature a -> Bool
$c== :: forall a. Signature a -> Signature a -> Bool
Eq, Eq (Signature a)
Eq (Signature a)
-> (Signature a -> Signature a -> Ordering)
-> (Signature a -> Signature a -> Bool)
-> (Signature a -> Signature a -> Bool)
-> (Signature a -> Signature a -> Bool)
-> (Signature a -> Signature a -> Bool)
-> (Signature a -> Signature a -> Signature a)
-> (Signature a -> Signature a -> Signature a)
-> Ord (Signature a)
Signature a -> Signature a -> Bool
Signature a -> Signature a -> Ordering
Signature a -> Signature a -> Signature a
forall a. Eq (Signature a)
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
forall a. Signature a -> Signature a -> Bool
forall a. Signature a -> Signature a -> Ordering
forall a. Signature a -> Signature a -> Signature a
min :: Signature a -> Signature a -> Signature a
$cmin :: forall a. Signature a -> Signature a -> Signature a
max :: Signature a -> Signature a -> Signature a
$cmax :: forall a. Signature a -> Signature a -> Signature a
>= :: Signature a -> Signature a -> Bool
$c>= :: forall a. Signature a -> Signature a -> Bool
> :: Signature a -> Signature a -> Bool
$c> :: forall a. Signature a -> Signature a -> Bool
<= :: Signature a -> Signature a -> Bool
$c<= :: forall a. Signature a -> Signature a -> Bool
< :: Signature a -> Signature a -> Bool
$c< :: forall a. Signature a -> Signature a -> Bool
compare :: Signature a -> Signature a -> Ordering
$ccompare :: forall a. Signature a -> Signature a -> Ordering
$cp1Ord :: forall a. Eq (Signature a)
Ord, Int -> Signature a -> ShowS
[Signature a] -> ShowS
Signature a -> String
(Int -> Signature a -> ShowS)
-> (Signature a -> String)
-> ([Signature a] -> ShowS)
-> Show (Signature a)
forall a. Int -> Signature a -> ShowS
forall a. [Signature a] -> ShowS
forall a. Signature a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature a] -> ShowS
$cshowList :: forall a. [Signature a] -> ShowS
show :: Signature a -> String
$cshow :: forall a. Signature a -> String
showsPrec :: Int -> Signature a -> ShowS
$cshowsPrec :: forall a. Int -> Signature a -> ShowS
Show, (forall x. Signature a -> Rep (Signature a) x)
-> (forall x. Rep (Signature a) x -> Signature a)
-> Generic (Signature a)
forall x. Rep (Signature a) x -> Signature a
forall x. Signature a -> Rep (Signature a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Signature a) x -> Signature a
forall a x. Signature a -> Rep (Signature a) x
$cto :: forall a x. Rep (Signature a) x -> Signature a
$cfrom :: forall a x. Signature a -> Rep (Signature a) x
Generic)
  deriving anyclass (Signature a -> ()
(Signature a -> ()) -> NFData (Signature a)
forall a. Signature a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Signature a -> ()
$crnf :: forall a. Signature a -> ()
NFData)
  deriving (Context -> Signature a -> IO (Maybe ThunkInfo)
Proxy (Signature a) -> String
(Context -> Signature a -> IO (Maybe ThunkInfo))
-> (Context -> Signature a -> IO (Maybe ThunkInfo))
-> (Proxy (Signature a) -> String)
-> NoThunks (Signature a)
forall a. Context -> Signature a -> IO (Maybe ThunkInfo)
forall a. Proxy (Signature a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Signature a) -> String
$cshowTypeOf :: forall a. Proxy (Signature a) -> String
wNoThunks :: Context -> Signature a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a. Context -> Signature a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Signature a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a. Context -> Signature a -> IO (Maybe ThunkInfo)
NoThunks) via InspectHeap CC.XSignature

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

instance FromJSON (Signature w) where
  parseJSON :: Value -> Parser (Signature w)
parseJSON Value
v = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Text
-> (Text -> Parser (Signature w)) -> Parser (Signature w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SignatureParseError (Signature w) -> Parser (Signature w)
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either SignatureParseError (Signature w) -> Parser (Signature w))
-> (Text -> Either SignatureParseError (Signature w))
-> Text
-> Parser (Signature w)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either SignatureParseError (Signature w)
forall a. Text -> Either SignatureParseError (Signature a)
parseFullSignature

instance ToJSON (Signature w) where
  toJSON :: Signature w -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Signature w -> Text) -> Signature w -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (Signature w -> Text) -> Signature w -> Text
forall a. Format Text a -> a
sformat Format Text (Signature w -> Text)
forall r a. Format r (Signature a -> r)
fullSignatureHexF

instance Monad m => TJC.ToJSON m (Signature w) where
  toJSON :: Signature w -> m JSValue
toJSON = JSValue -> m JSValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSValue -> m JSValue)
-> (Signature w -> JSValue) -> Signature w -> m JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSString -> JSValue
JSString (JSString -> JSValue)
-> (Signature w -> JSString) -> Signature w -> JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> JSString
toJSString (String -> JSString)
-> (Signature w -> String) -> Signature w -> JSString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format String (Signature w -> String) -> Signature w -> String
forall a. Format String a -> a
formatToString Format String (Signature w -> String)
forall r a. Format r (Signature a -> r)
fullSignatureHexF

instance (Typeable x, MonadError SchemaError m) => TJC.FromJSON m (Signature x) where
  fromJSON :: JSValue -> m (Signature x)
fromJSON = (Text -> Either SignatureParseError (Signature x))
-> JSValue -> m (Signature x)
forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString Text -> Either SignatureParseError (Signature x)
forall a. Text -> Either SignatureParseError (Signature a)
parseFullSignature

-- | Formatter for 'Signature' to show it in hex.
fullSignatureHexF :: Format r (Signature a -> r)
fullSignatureHexF :: Format r (Signature a -> r)
fullSignatureHexF =
  (Signature a -> Builder) -> Format r (Signature a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((Signature a -> Builder) -> Format r (Signature a -> r))
-> (Signature a -> Builder) -> Format r (Signature a -> r)
forall a b. (a -> b) -> a -> b
$ \(Signature XSignature
x) -> ByteString -> Builder
base16Builder (ByteString -> Builder)
-> (XSignature -> ByteString) -> XSignature -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. XSignature -> ByteString
CC.unXSignature (XSignature -> Builder) -> XSignature -> Builder
forall a b. (a -> b) -> a -> b
$ XSignature
x

data SignatureParseError
  = SignatureParseBase16Error ByteString
  | SignatureParseXSignatureError Text
  deriving (SignatureParseError -> SignatureParseError -> Bool
(SignatureParseError -> SignatureParseError -> Bool)
-> (SignatureParseError -> SignatureParseError -> Bool)
-> Eq SignatureParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureParseError -> SignatureParseError -> Bool
$c/= :: SignatureParseError -> SignatureParseError -> Bool
== :: SignatureParseError -> SignatureParseError -> Bool
$c== :: SignatureParseError -> SignatureParseError -> Bool
Eq, Int -> SignatureParseError -> ShowS
[SignatureParseError] -> ShowS
SignatureParseError -> String
(Int -> SignatureParseError -> ShowS)
-> (SignatureParseError -> String)
-> ([SignatureParseError] -> ShowS)
-> Show SignatureParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureParseError] -> ShowS
$cshowList :: [SignatureParseError] -> ShowS
show :: SignatureParseError -> String
$cshow :: SignatureParseError -> String
showsPrec :: Int -> SignatureParseError -> ShowS
$cshowsPrec :: Int -> SignatureParseError -> ShowS
Show)

instance B.Buildable SignatureParseError where
  build :: SignatureParseError -> Builder
build = \case
    SignatureParseBase16Error ByteString
bs ->
      Format Builder (ByteString -> Builder) -> ByteString -> Builder
forall a. Format Builder a -> a
bprint
        (Format (ByteString -> Builder) (ByteString -> Builder)
"Failed to parse base 16 while parsing Signature.\n Error: " Format (ByteString -> Builder) (ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
-> Format Builder (ByteString -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (ByteString -> Builder)
forall a r. Show a => Format r (a -> r)
shown)
        ByteString
bs
    SignatureParseXSignatureError Text
err ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint
        ( Format (Text -> Builder) (Text -> Builder)
"Failed to construct XSignature while parsing Signature.\n Error: "
            Format (Text -> Builder) (Text -> Builder)
-> Format Builder (Text -> Builder)
-> Format Builder (Text -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Text -> Builder)
forall r. Format r (Text -> r)
stext
        )
        Text
err

-- | Parse 'Signature' from base16 encoded string.
parseFullSignature :: Text -> Either SignatureParseError (Signature a)
parseFullSignature :: Text -> Either SignatureParseError (Signature a)
parseFullSignature Text
s = do
  let bs :: ByteString
bs = Text -> ByteString
T.encodeUtf8 Text
s
  ByteString
b <- (String -> SignatureParseError)
-> Either String ByteString
-> Either SignatureParseError ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SignatureParseError -> String -> SignatureParseError
forall a b. a -> b -> a
const (ByteString -> SignatureParseError
SignatureParseBase16Error ByteString
bs)) (Either String ByteString -> Either SignatureParseError ByteString)
-> Either String ByteString
-> Either SignatureParseError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B16.decode ByteString
bs
  XSignature -> Signature a
forall a. XSignature -> Signature a
Signature (XSignature -> Signature a)
-> Either SignatureParseError XSignature
-> Either SignatureParseError (Signature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> SignatureParseError)
-> Either String XSignature
-> Either SignatureParseError XSignature
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SignatureParseError
SignatureParseXSignatureError (Text -> SignatureParseError)
-> (String -> Text) -> String -> SignatureParseError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertText a b => a -> b
toS) (ByteString -> Either String XSignature
CC.xsignature ByteString
b)

toCBORXSignature :: CC.XSignature -> Encoding
toCBORXSignature :: XSignature -> Encoding
toCBORXSignature XSignature
a = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ XSignature -> ByteString
CC.unXSignature XSignature
a

fromCBORXSignature :: Decoder s CC.XSignature
fromCBORXSignature :: Decoder s XSignature
fromCBORXSignature = Either String XSignature -> Decoder s XSignature
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either String XSignature -> Decoder s XSignature)
-> (ByteString -> Either String XSignature)
-> ByteString
-> Decoder s XSignature
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either String XSignature
CC.xsignature (ByteString -> Decoder s XSignature)
-> Decoder s ByteString -> Decoder s XSignature
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Typeable a => ToCBOR (Signature a) where
  toCBOR :: Signature a -> Encoding
toCBOR (Signature XSignature
a) = XSignature -> Encoding
toCBORXSignature XSignature
a
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Signature a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy (Signature a)
_ = Size
66

instance Typeable a => FromCBOR (Signature a) where
  fromCBOR :: Decoder s (Signature a)
fromCBOR = (XSignature -> Signature a)
-> Decoder s XSignature -> Decoder s (Signature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XSignature -> Signature a
forall a. XSignature -> Signature a
Signature Decoder s XSignature
forall s. Decoder s XSignature
fromCBORXSignature

--------------------------------------------------------------------------------
-- Signing
--------------------------------------------------------------------------------

-- | Encode something with 'ToCBOR' and sign it
sign ::
  ToCBOR a =>
  ProtocolMagicId ->
  -- | See docs for 'SignTag'
  SignTag ->
  SigningKey ->
  a ->
  Signature a
sign :: ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm SignTag
tag SigningKey
sk = ProtocolMagicId -> SignTag -> SigningKey -> Encoding -> Signature a
forall a.
ProtocolMagicId -> SignTag -> SigningKey -> Encoding -> Signature a
signEncoded ProtocolMagicId
pm SignTag
tag SigningKey
sk (Encoding -> Signature a) -> (a -> Encoding) -> a -> Signature a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

-- | Like 'sign' but without the 'ToCBOR' constraint
signEncoded ::
  ProtocolMagicId -> SignTag -> SigningKey -> Encoding -> Signature a
signEncoded :: ProtocolMagicId -> SignTag -> SigningKey -> Encoding -> Signature a
signEncoded ProtocolMagicId
pm SignTag
tag SigningKey
sk = Signature Raw -> Signature a
coerce (Signature Raw -> Signature a)
-> (Encoding -> Signature Raw) -> Encoding -> Signature a
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 -> SigningKey -> ByteString -> Signature Raw
signRaw ProtocolMagicId
pm (SignTag -> Maybe SignTag
forall a. a -> Maybe a
Just SignTag
tag) SigningKey
sk (ByteString -> Signature Raw)
-> (Encoding -> ByteString) -> Encoding -> Signature Raw
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Encoding -> ByteString) -> Encoding -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoding -> ByteString
serializeEncoding

-- | Sign a 'Raw' bytestring
signRaw ::
  ProtocolMagicId ->
  -- | See docs for 'SignTag'. Unlike in 'sign', we allow no tag to be provided
  --   just in case you need to sign /exactly/ the bytestring you provided.
  Maybe SignTag ->
  SigningKey ->
  ByteString ->
  Signature Raw
signRaw :: ProtocolMagicId
-> Maybe SignTag -> SigningKey -> ByteString -> Signature Raw
signRaw ProtocolMagicId
pm Maybe SignTag
mTag (SigningKey XPrv
sk) ByteString
x =
  XSignature -> Signature Raw
forall a. XSignature -> Signature a
Signature
    (ScrubbedBytes -> XPrv -> ByteString -> XSignature
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
CC.sign (ScrubbedBytes
forall a. Monoid a => a
mempty :: ScrubbedBytes) XPrv
sk (ByteString
tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x))
  where
    tag :: ByteString
tag = ByteString
-> (SignTag -> ByteString) -> Maybe SignTag -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (ProtocolMagicId -> SignTag -> ByteString
signTag ProtocolMagicId
pm) Maybe SignTag
mTag

safeSign ::
  ToCBOR a => ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign :: ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign ProtocolMagicId
pm SignTag
t SafeSigner
ss = Signature Raw -> Signature a
coerce (Signature Raw -> Signature a)
-> (a -> Signature Raw) -> a -> Signature a
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 -> SafeSigner -> ByteString -> Signature Raw
safeSignRaw ProtocolMagicId
pm (SignTag -> Maybe SignTag
forall a. a -> Maybe a
Just SignTag
t) SafeSigner
ss (ByteString -> Signature Raw)
-> (a -> ByteString) -> a -> Signature Raw
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'

safeSignRaw ::
  ProtocolMagicId ->
  Maybe SignTag ->
  SafeSigner ->
  ByteString ->
  Signature Raw
safeSignRaw :: ProtocolMagicId
-> Maybe SignTag -> SafeSigner -> ByteString -> Signature Raw
safeSignRaw ProtocolMagicId
pm Maybe SignTag
mbTag (SafeSigner (SigningKey XPrv
sk) (PassPhrase ScrubbedBytes
pp)) ByteString
x =
  XSignature -> Signature Raw
forall a. XSignature -> Signature a
Signature (ScrubbedBytes -> XPrv -> ByteString -> XSignature
forall passPhrase msg.
(ByteArrayAccess passPhrase, ByteArrayAccess msg) =>
passPhrase -> XPrv -> msg -> XSignature
CC.sign ScrubbedBytes
pp XPrv
sk (ByteString
tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x))
  where
    tag :: ByteString
tag = ByteString
-> (SignTag -> ByteString) -> Maybe SignTag -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (ProtocolMagicId -> SignTag -> ByteString
signTag ProtocolMagicId
pm) Maybe SignTag
mbTag

--------------------------------------------------------------------------------
-- Verification
--------------------------------------------------------------------------------

-- | Verify a signature
verifySignature ::
  (a -> Encoding) ->
  ProtocolMagicId ->
  SignTag ->
  VerificationKey ->
  a ->
  Signature a ->
  Bool
verifySignature :: (a -> Encoding)
-> ProtocolMagicId
-> SignTag
-> VerificationKey
-> a
-> Signature a
-> Bool
verifySignature a -> Encoding
toEnc ProtocolMagicId
pm SignTag
tag VerificationKey
vk a
x Signature a
sig =
  VerificationKey -> ByteString -> Signature Raw -> Bool
verifySignatureRaw VerificationKey
vk (ProtocolMagicId -> SignTag -> ByteString
signTag ProtocolMagicId
pm SignTag
tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Encoding -> ByteString) -> Encoding -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Encoding
toEnc a
x)) (Signature a -> Signature Raw
coerce Signature a
sig)

-- | Verify a signature
verifySignatureDecoded ::
  Decoded t =>
  Annotated ProtocolMagicId ByteString ->
  SignTag ->
  VerificationKey ->
  t ->
  Signature (BaseType t) ->
  Bool
verifySignatureDecoded :: Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> t
-> Signature (BaseType t)
-> Bool
verifySignatureDecoded Annotated ProtocolMagicId ByteString
pm SignTag
tag VerificationKey
vk t
x Signature (BaseType t)
sig =
  VerificationKey -> ByteString -> Signature Raw -> Bool
verifySignatureRaw VerificationKey
vk (Annotated ProtocolMagicId ByteString -> SignTag -> ByteString
signTagDecoded Annotated ProtocolMagicId ByteString
pm SignTag
tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> t -> ByteString
forall t. Decoded t => t -> ByteString
recoverBytes t
x) (Signature (BaseType t) -> Signature Raw
coerce Signature (BaseType t)
sig)

-- | Verify 'Raw' signature
verifySignatureRaw ::
  VerificationKey ->
  ByteString ->
  Signature Raw ->
  Bool
verifySignatureRaw :: VerificationKey -> ByteString -> Signature Raw -> Bool
verifySignatureRaw (VerificationKey XPub
k) ByteString
x (Signature XSignature
sig) = XPub -> ByteString -> XSignature -> Bool
forall msg.
ByteArrayAccess msg =>
XPub -> msg -> XSignature -> Bool
CC.verify XPub
k ByteString
x XSignature
sig