{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Crypto.Signing.VerificationKey (
  VerificationKey (..),
  formatFullVerificationKey,
  fullVerificationKeyF,
  fullVerificationKeyHexF,
  shortVerificationKeyHexF,
  parseFullVerificationKey,
) where

import qualified Cardano.Crypto.Wallet as CC
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  Encoding,
  FromCBOR (..),
  ToCBOR (..),
  decodeBytesCanonical,
  fromByronCBOR,
  toByronCBOR,
  toCborError,
 )
import Cardano.Prelude hiding (toCborError)
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder
import Formatting (
  Format,
  bprint,
  fitLeft,
  formatToString,
  later,
  sformat,
  stext,
  (%.),
 )
import Formatting.Buildable (Buildable (..))
import NoThunks.Class (InspectHeap (..), NoThunks (..))
import Text.JSON.Canonical (JSValue (..), toJSString)
import qualified Text.JSON.Canonical as TJC (FromJSON (..), ToJSON (..))

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

instance ToJSON VerificationKey where
  toJSON :: VerificationKey -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (VerificationKey -> Text) -> VerificationKey -> 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 (VerificationKey -> Text) -> VerificationKey -> Text
forall a. Format Text a -> a
sformat Format Text (VerificationKey -> Text)
forall r. Format r (VerificationKey -> r)
fullVerificationKeyF

instance FromJSON VerificationKey where
  parseJSON :: Value -> Parser VerificationKey
parseJSON Value
v = Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Text
-> (Text -> Parser VerificationKey) -> Parser VerificationKey
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either VerificationKeyParseError VerificationKey
-> Parser VerificationKey
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either VerificationKeyParseError VerificationKey
 -> Parser VerificationKey)
-> (Text -> Either VerificationKeyParseError VerificationKey)
-> Text
-> Parser VerificationKey
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 VerificationKeyParseError VerificationKey
parseFullVerificationKey

instance Monad m => TJC.ToJSON m VerificationKey where
  toJSON :: VerificationKey -> m JSValue
toJSON = JSValue -> m JSValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSValue -> m JSValue)
-> (VerificationKey -> JSValue) -> VerificationKey -> 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)
-> (VerificationKey -> JSString) -> VerificationKey -> 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)
-> (VerificationKey -> String) -> VerificationKey -> 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 (VerificationKey -> String)
-> VerificationKey -> String
forall a. Format String a -> a
formatToString Format String (VerificationKey -> String)
forall r. Format r (VerificationKey -> r)
fullVerificationKeyF

instance MonadError SchemaError m => TJC.FromJSON m VerificationKey where
  fromJSON :: JSValue -> m VerificationKey
fromJSON = (Text -> Either VerificationKeyParseError VerificationKey)
-> JSValue -> m VerificationKey
forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString Text -> Either VerificationKeyParseError VerificationKey
parseFullVerificationKey

instance ToCBOR VerificationKey where
  toCBOR :: VerificationKey -> Encoding
toCBOR = VerificationKey -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR VerificationKey where
  fromCBOR :: forall s. Decoder s VerificationKey
fromCBOR = Decoder s VerificationKey
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR VerificationKey where
  encCBOR :: VerificationKey -> Encoding
encCBOR (VerificationKey XPub
a) = XPub -> Encoding
encCBORXPub XPub
a
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy VerificationKey -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
_ Proxy VerificationKey
_ = Size
66

instance DecCBOR VerificationKey where
  decCBOR :: forall s. Decoder s VerificationKey
decCBOR = (XPub -> VerificationKey)
-> Decoder s XPub -> Decoder s VerificationKey
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPub -> VerificationKey
VerificationKey Decoder s XPub
forall s. Decoder s XPub
decCBORXPub

encCBORXPub :: CC.XPub -> Encoding
encCBORXPub :: XPub -> Encoding
encCBORXPub XPub
a = ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (ByteString -> Encoding) -> ByteString -> Encoding
forall a b. (a -> b) -> a -> b
$ XPub -> ByteString
CC.unXPub XPub
a

-- | We enforce canonical CBOR encodings for `VerificationKey`s, because we serialize
--   them before hashing to get `KeyHash`es.
decCBORXPub :: Decoder s CC.XPub
decCBORXPub :: forall s. Decoder s XPub
decCBORXPub = Either String XPub -> Decoder s XPub
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either String XPub -> Decoder s XPub)
-> (ByteString -> Either String XPub)
-> ByteString
-> Decoder s XPub
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 XPub
CC.xpub (ByteString -> Decoder s XPub)
-> Decoder s ByteString -> Decoder s XPub
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s ByteString
forall s. Decoder s ByteString
decodeBytesCanonical

instance Buildable VerificationKey where
  build :: VerificationKey -> Builder
build = Format Builder (VerificationKey -> Builder)
-> VerificationKey -> Builder
forall a. Format Builder a -> a
bprint (Format (VerificationKey -> Builder) (VerificationKey -> Builder)
"pub:" Format (VerificationKey -> Builder) (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> Builder)
-> Format Builder (VerificationKey -> 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 (VerificationKey -> Builder)
forall r. Format r (VerificationKey -> r)
shortVerificationKeyHexF)

-- | 'Builder' for 'VerificationKey' to show it in base64 encoded form.
formatFullVerificationKey :: VerificationKey -> Builder
formatFullVerificationKey :: VerificationKey -> Builder
formatFullVerificationKey (VerificationKey XPub
vk) =
  String -> Builder
Builder.fromString (String -> Builder) -> (XPub -> String) -> XPub -> 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
. ByteString -> String
BS.unpack (ByteString -> String) -> (XPub -> ByteString) -> XPub -> String
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
B64.encode (ByteString -> ByteString)
-> (XPub -> ByteString) -> XPub -> 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
. XPub -> ByteString
CC.unXPub (XPub -> Builder) -> XPub -> Builder
forall a b. (a -> b) -> a -> b
$ XPub
vk

-- | Formatter for 'VerificationKey' to show it in base64.
fullVerificationKeyF :: Format r (VerificationKey -> r)
fullVerificationKeyF :: forall r. Format r (VerificationKey -> r)
fullVerificationKeyF = (VerificationKey -> Builder) -> Format r (VerificationKey -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later VerificationKey -> Builder
formatFullVerificationKey

-- | Formatter for 'VerificationKey' to show it in hex.
fullVerificationKeyHexF :: Format r (VerificationKey -> r)
fullVerificationKeyHexF :: forall r. Format r (VerificationKey -> r)
fullVerificationKeyHexF = (VerificationKey -> Builder) -> Format r (VerificationKey -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((VerificationKey -> Builder) -> Format r (VerificationKey -> r))
-> (VerificationKey -> Builder) -> Format r (VerificationKey -> r)
forall a b. (a -> b) -> a -> b
$ \(VerificationKey XPub
x) -> ByteString -> Builder
base16Builder (ByteString -> Builder) -> (XPub -> ByteString) -> XPub -> 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
. XPub -> ByteString
CC.unXPub (XPub -> Builder) -> XPub -> Builder
forall a b. (a -> b) -> a -> b
$ XPub
x

-- | Formatter for 'VerificationKey' to show it in hex, but only first 8 chars.
shortVerificationKeyHexF :: Format r (VerificationKey -> r)
shortVerificationKeyHexF :: forall r. Format r (VerificationKey -> r)
shortVerificationKeyHexF = Int -> Format r (Builder -> r)
forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
8 Format r (Builder -> r)
-> Format r (VerificationKey -> r)
-> Format r (VerificationKey -> r)
forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
%. Format r (VerificationKey -> r)
forall r. Format r (VerificationKey -> r)
fullVerificationKeyHexF

type VerificationKeyParseError :: Type
data VerificationKeyParseError
  = VerificationKeyParseBase64Error Text
  | VerificationKeyParseXPubError Text
  deriving (VerificationKeyParseError -> VerificationKeyParseError -> Bool
(VerificationKeyParseError -> VerificationKeyParseError -> Bool)
-> (VerificationKeyParseError -> VerificationKeyParseError -> Bool)
-> Eq VerificationKeyParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
== :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
$c/= :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
/= :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
Eq, Int -> VerificationKeyParseError -> ShowS
[VerificationKeyParseError] -> ShowS
VerificationKeyParseError -> String
(Int -> VerificationKeyParseError -> ShowS)
-> (VerificationKeyParseError -> String)
-> ([VerificationKeyParseError] -> ShowS)
-> Show VerificationKeyParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKeyParseError -> ShowS
showsPrec :: Int -> VerificationKeyParseError -> ShowS
$cshow :: VerificationKeyParseError -> String
show :: VerificationKeyParseError -> String
$cshowList :: [VerificationKeyParseError] -> ShowS
showList :: [VerificationKeyParseError] -> ShowS
Show)

instance Buildable VerificationKeyParseError where
  build :: VerificationKeyParseError -> Builder
build = \case
    VerificationKeyParseBase64Error Text
err ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint
        (Format (Text -> Builder) (Text -> Builder)
"Failed to decode base 64 while parsing VerificationKey.\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
    VerificationKeyParseXPubError Text
err ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint
        (Format (Text -> Builder) (Text -> Builder)
"Failed to construct XPub while parsing VerificationKey.\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 'VerificationKey' from base64 encoded string
parseFullVerificationKey :: Text -> Either VerificationKeyParseError VerificationKey
parseFullVerificationKey :: Text -> Either VerificationKeyParseError VerificationKey
parseFullVerificationKey Text
s = do
  ByteString
b <- (String -> VerificationKeyParseError)
-> Either String ByteString
-> Either VerificationKeyParseError 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 (Text -> VerificationKeyParseError
VerificationKeyParseBase64Error (Text -> VerificationKeyParseError)
-> (String -> Text) -> String -> VerificationKeyParseError
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
Text.pack) (Either String ByteString
 -> Either VerificationKeyParseError ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either VerificationKeyParseError 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
. ByteString -> Either String ByteString
B64.decode (ByteString -> Either VerificationKeyParseError ByteString)
-> ByteString -> Either VerificationKeyParseError ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
s
  XPub -> VerificationKey
VerificationKey (XPub -> VerificationKey)
-> Either VerificationKeyParseError XPub
-> Either VerificationKeyParseError VerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> VerificationKeyParseError)
-> Either String XPub -> Either VerificationKeyParseError XPub
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 -> VerificationKeyParseError
VerificationKeyParseXPubError (Text -> VerificationKeyParseError)
-> (String -> Text) -> String -> VerificationKeyParseError
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
Text.pack) (ByteString -> Either String XPub
CC.xpub ByteString
b)