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

module Cardano.Crypto.Signing.Signature (
  -- * Signature
  Signature (..),
  encCBORXSignature,
  decCBORXSignature,
  fullSignatureHexF,
  parseFullSignature,

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

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

import Cardano.Crypto.ProtocolMagic (ProtocolMagicId)
import Cardano.Crypto.Raw (Raw (..))
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.Ledger.Binary (
  Annotated (..),
  DecCBOR (..),
  Decoded (..),
  Decoder,
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  ToCBOR (..),
  byronProtVer,
  fromByronCBOR,
  serialize,
  serialize',
  toByronCBOR,
  toCborError,
 )
import Cardano.Prelude hiding (toCborError)
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
$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
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
$ccompare :: forall a. Signature a -> Signature a -> Ordering
compare :: Signature a -> Signature a -> Ordering
$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
>= :: Signature a -> Signature a -> Bool
$cmax :: forall a. Signature a -> Signature a -> Signature a
max :: Signature a -> Signature a -> Signature a
$cmin :: forall a. Signature a -> Signature a -> Signature a
min :: Signature a -> Signature a -> 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
$cshowsPrec :: forall a. Int -> Signature a -> ShowS
showsPrec :: Int -> Signature a -> ShowS
$cshow :: forall a. Signature a -> String
show :: Signature a -> String
$cshowList :: forall a. [Signature a] -> ShowS
showList :: [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
$cfrom :: forall a x. Signature a -> Rep (Signature a) x
from :: forall x. Signature a -> Rep (Signature a) x
$cto :: forall a x. Rep (Signature a) x -> Signature a
to :: forall x. Rep (Signature a) x -> Signature a
Generic)
  deriving anyclass (Signature a -> ()
(Signature a -> ()) -> NFData (Signature a)
forall a. Signature a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. Signature a -> ()
rnf :: 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
$cnoThunks :: forall a. Context -> Signature a -> IO (Maybe ThunkInfo)
noThunks :: Context -> Signature a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a. Context -> Signature a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Signature a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. Proxy (Signature a) -> String
showTypeOf :: Proxy (Signature a) -> String
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 a b. Parser a -> (a -> Parser b) -> Parser b
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSValue -> m JSValue)
-> (Signature w -> JSValue) -> Signature w -> m JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 :: forall r a. 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 b c a. (b -> c) -> (a -> b) -> a -> c
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
$c== :: SignatureParseError -> SignatureParseError -> Bool
== :: SignatureParseError -> SignatureParseError -> Bool
$c/= :: SignatureParseError -> SignatureParseError -> Bool
/= :: 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
$cshowsPrec :: Int -> SignatureParseError -> ShowS
showsPrec :: Int -> SignatureParseError -> ShowS
$cshow :: SignatureParseError -> String
show :: SignatureParseError -> String
$cshowList :: [SignatureParseError] -> ShowS
showList :: [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 b c a. Format b c -> Format a b -> Format a c
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 b c a. Format b c -> Format a b -> Format a c
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 :: forall a. 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 a b c. (a -> b) -> Either a c -> Either b c
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 a b c. (a -> b) -> Either a c -> Either b c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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)

encCBORXSignature :: CC.XSignature -> Encoding
encCBORXSignature :: XSignature -> Encoding
encCBORXSignature XSignature
a = ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ XSignature -> ByteString
CC.unXSignature XSignature
a

decCBORXSignature :: Decoder s CC.XSignature
decCBORXSignature :: forall s. Decoder s XSignature
decCBORXSignature = Either String XSignature -> Decoder s XSignature
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either String XSignature -> Decoder s XSignature)
-> (ByteString -> Either String XSignature)
-> ByteString
-> Decoder s XSignature
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR

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

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

instance Typeable a => EncCBOR (Signature a) where
  encCBOR :: Signature a -> Encoding
encCBOR (Signature XSignature
a) = XSignature -> Encoding
encCBORXSignature XSignature
a
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Signature a) -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy (Signature a)
_ = Size
66

instance Typeable a => DecCBOR (Signature a) where
  decCBOR :: forall s. Decoder s (Signature a)
decCBOR = (XSignature -> Signature a)
-> Decoder s XSignature -> Decoder s (Signature a)
forall a b. (a -> b) -> Decoder s a -> Decoder s b
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
decCBORXSignature

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

-- | Encode something with 'EncCBOR' and sign it
sign ::
  EncCBOR a =>
  ProtocolMagicId ->
  -- | See docs for 'SignTag'
  SignTag ->
  SigningKey ->
  a ->
  Signature a
sign :: forall a.
EncCBOR a =>
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 b c a. (b -> c) -> (a -> b) -> a -> c
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. EncCBOR a => a -> Encoding
encCBOR

-- | Like 'sign' but without the 'EncCBOR' constraint
signEncoded ::
  ProtocolMagicId -> SignTag -> SigningKey -> Encoding -> Signature a
signEncoded :: forall a.
ProtocolMagicId -> SignTag -> SigningKey -> Encoding -> Signature a
signEncoded ProtocolMagicId
pm SignTag
tag SigningKey
sk =
  Signature Raw -> Signature a
forall a b. Coercible a b => a -> b
coerce (Signature Raw -> Signature a)
-> (Encoding -> Signature Raw) -> Encoding -> Signature a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer

-- | 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 ::
  EncCBOR a => ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign :: forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign ProtocolMagicId
pm SignTag
t SafeSigner
ss = Signature Raw -> Signature a
forall a b. Coercible a b => a -> b
coerce (Signature Raw -> Signature a)
-> (a -> Signature Raw) -> a -> Signature a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Version -> a -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer

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 :: forall a.
(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 (Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Encoding
toEnc a
x))
    (Signature a -> Signature Raw
forall a b. Coercible a b => a -> b
coerce Signature a
sig)

-- | Verify a signature
verifySignatureDecoded ::
  Decoded t =>
  Annotated ProtocolMagicId ByteString ->
  SignTag ->
  VerificationKey ->
  t ->
  Signature (BaseType t) ->
  Bool
verifySignatureDecoded :: forall t.
Decoded t =>
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
forall a b. Coercible a b => a -> b
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