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

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

import Cardano.Binary
  ( Decoder,
    Encoding,
    FromCBOR (..),
    ToCBOR (..),
    decodeBytesCanonical,
  )
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Prelude
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'.
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
/= :: VerificationKey -> VerificationKey -> Bool
$c/= :: VerificationKey -> VerificationKey -> Bool
== :: VerificationKey -> VerificationKey -> Bool
$c== :: 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
min :: VerificationKey -> VerificationKey -> VerificationKey
$cmin :: VerificationKey -> VerificationKey -> VerificationKey
max :: VerificationKey -> VerificationKey -> VerificationKey
$cmax :: VerificationKey -> VerificationKey -> VerificationKey
>= :: VerificationKey -> VerificationKey -> Bool
$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
compare :: VerificationKey -> VerificationKey -> Ordering
$ccompare :: VerificationKey -> VerificationKey -> Ordering
$cp1Ord :: Eq 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
showList :: [VerificationKey] -> ShowS
$cshowList :: [VerificationKey] -> ShowS
show :: VerificationKey -> String
$cshow :: VerificationKey -> String
showsPrec :: Int -> VerificationKey -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep VerificationKey x -> VerificationKey
$cfrom :: forall x. VerificationKey -> Rep VerificationKey x
Generic)
  deriving newtype (VerificationKey -> ()
(VerificationKey -> ()) -> NFData VerificationKey
forall a. (a -> ()) -> NFData a
rnf :: VerificationKey -> ()
$crnf :: 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
showTypeOf :: Proxy VerificationKey -> String
$cshowTypeOf :: Proxy VerificationKey -> String
wNoThunks :: Context -> VerificationKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerificationKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerificationKey -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> VerificationKey -> IO (Maybe ThunkInfo)
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 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 (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 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 (f :: * -> *) a. Applicative f => a -> f a
pure (JSValue -> m JSValue)
-> (VerificationKey -> JSValue) -> VerificationKey -> 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)
-> (VerificationKey -> JSString) -> VerificationKey -> 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)
-> (VerificationKey -> String) -> VerificationKey -> 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 (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 XPub
a) = XPub -> Encoding
toCBORXPub XPub
a
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy VerificationKey -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy VerificationKey
_ = Size
66

instance FromCBOR VerificationKey where
  fromCBOR :: Decoder s VerificationKey
fromCBOR = (XPub -> VerificationKey)
-> Decoder s XPub -> Decoder s VerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPub -> VerificationKey
VerificationKey Decoder s XPub
forall s. Decoder s XPub
fromCBORXPub

toCBORXPub :: CC.XPub -> Encoding
toCBORXPub :: XPub -> Encoding
toCBORXPub XPub
a = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (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.
fromCBORXPub :: Decoder s CC.XPub
fromCBORXPub :: Decoder s XPub
fromCBORXPub = Either String XPub -> Decoder s XPub
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either String XPub -> Decoder s XPub)
-> (ByteString -> Either String XPub)
-> ByteString
-> Decoder s XPub
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 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 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 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 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 :: 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 :: 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 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 :: 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

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
/= :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
$c/= :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
== :: VerificationKeyParseError -> VerificationKeyParseError -> Bool
$c== :: 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
showList :: [VerificationKeyParseError] -> ShowS
$cshowList :: [VerificationKeyParseError] -> ShowS
show :: VerificationKeyParseError -> String
$cshow :: VerificationKeyParseError -> String
showsPrec :: Int -> VerificationKeyParseError -> ShowS
$cshowsPrec :: Int -> 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 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 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 (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 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 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 (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 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)