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

module Cardano.Crypto.Signing.Redeem.VerificationKey
  ( RedeemVerificationKey (..),
    redeemVKB64F,
    redeemVKB64UrlF,
    redeemVKB64ShortF,
    fromAvvmVK,
    fromVerificationKeyToByteString,
    redeemVKBuild,
  )
where

import Cardano.Binary (FromCBOR, ToCBOR)
import Cardano.Crypto.Orphans ()
import Cardano.Prelude
import Crypto.Error (CryptoFailable (..))
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Data.Aeson
  ( FromJSONKey (..),
    FromJSONKeyFunction (..),
    ToJSONKey (..),
    ToJSONKeyFunction (..),
  )
import qualified Data.Aeson.Encoding.Internal as A (key)
import qualified Data.Aeson.Key as A
import Data.Aeson.TH (defaultOptions, deriveJSON)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.URL as B64URL
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Formatting
  ( Format,
    bprint,
    build,
    fitLeft,
    formatToString,
    later,
    sformat,
    stext,
    (%.),
  )
import qualified Formatting.Buildable as B
import NoThunks.Class (InspectHeap (..), NoThunks (..))
import Text.JSON.Canonical
  ( FromObjectKey (..),
    JSValue (..),
    ToObjectKey (..),
    toJSString,
  )

-- | Wrapper around 'Ed25519.PublicKey'.
newtype RedeemVerificationKey
  = RedeemVerificationKey Ed25519.PublicKey
  deriving (RedeemVerificationKey -> RedeemVerificationKey -> Bool
(RedeemVerificationKey -> RedeemVerificationKey -> Bool)
-> (RedeemVerificationKey -> RedeemVerificationKey -> Bool)
-> Eq RedeemVerificationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RedeemVerificationKey -> RedeemVerificationKey -> Bool
$c/= :: RedeemVerificationKey -> RedeemVerificationKey -> Bool
== :: RedeemVerificationKey -> RedeemVerificationKey -> Bool
$c== :: RedeemVerificationKey -> RedeemVerificationKey -> Bool
Eq, Int -> RedeemVerificationKey -> ShowS
[RedeemVerificationKey] -> ShowS
RedeemVerificationKey -> String
(Int -> RedeemVerificationKey -> ShowS)
-> (RedeemVerificationKey -> String)
-> ([RedeemVerificationKey] -> ShowS)
-> Show RedeemVerificationKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedeemVerificationKey] -> ShowS
$cshowList :: [RedeemVerificationKey] -> ShowS
show :: RedeemVerificationKey -> String
$cshow :: RedeemVerificationKey -> String
showsPrec :: Int -> RedeemVerificationKey -> ShowS
$cshowsPrec :: Int -> RedeemVerificationKey -> ShowS
Show, (forall x. RedeemVerificationKey -> Rep RedeemVerificationKey x)
-> (forall x. Rep RedeemVerificationKey x -> RedeemVerificationKey)
-> Generic RedeemVerificationKey
forall x. Rep RedeemVerificationKey x -> RedeemVerificationKey
forall x. RedeemVerificationKey -> Rep RedeemVerificationKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RedeemVerificationKey x -> RedeemVerificationKey
$cfrom :: forall x. RedeemVerificationKey -> Rep RedeemVerificationKey x
Generic, RedeemVerificationKey -> ()
(RedeemVerificationKey -> ()) -> NFData RedeemVerificationKey
forall a. (a -> ()) -> NFData a
rnf :: RedeemVerificationKey -> ()
$crnf :: RedeemVerificationKey -> ()
NFData, Typeable RedeemVerificationKey
Decoder s RedeemVerificationKey
Typeable RedeemVerificationKey
-> (forall s. Decoder s RedeemVerificationKey)
-> (Proxy RedeemVerificationKey -> Text)
-> FromCBOR RedeemVerificationKey
Proxy RedeemVerificationKey -> Text
forall s. Decoder s RedeemVerificationKey
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy RedeemVerificationKey -> Text
$clabel :: Proxy RedeemVerificationKey -> Text
fromCBOR :: Decoder s RedeemVerificationKey
$cfromCBOR :: forall s. Decoder s RedeemVerificationKey
$cp1FromCBOR :: Typeable RedeemVerificationKey
FromCBOR, Typeable RedeemVerificationKey
Typeable RedeemVerificationKey
-> (RedeemVerificationKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy RedeemVerificationKey -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [RedeemVerificationKey] -> Size)
-> ToCBOR RedeemVerificationKey
RedeemVerificationKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [RedeemVerificationKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy RedeemVerificationKey -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [RedeemVerificationKey] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [RedeemVerificationKey] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy RedeemVerificationKey -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy RedeemVerificationKey -> Size
toCBOR :: RedeemVerificationKey -> Encoding
$ctoCBOR :: RedeemVerificationKey -> Encoding
$cp1ToCBOR :: Typeable RedeemVerificationKey
ToCBOR)
  deriving (Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo)
Proxy RedeemVerificationKey -> String
(Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo))
-> (Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo))
-> (Proxy RedeemVerificationKey -> String)
-> NoThunks RedeemVerificationKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy RedeemVerificationKey -> String
$cshowTypeOf :: Proxy RedeemVerificationKey -> String
wNoThunks :: Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> RedeemVerificationKey -> IO (Maybe ThunkInfo)
NoThunks) via InspectHeap RedeemVerificationKey

-- Note that normally we would not provide any Ord instances.
-- The crypto libraries encourage using key /hashes/ not keys for
-- things like sets, map etc. However due to a historical mistake the
-- AVVM balances use whole keys, not key hashes. So we compromise here
-- and provide Ord instances so we can use RedeemVerificationKey
-- as the key type in a Data.Map.

instance Ord RedeemVerificationKey where
  RedeemVerificationKey PublicKey
a compare :: RedeemVerificationKey -> RedeemVerificationKey -> Ordering
`compare` RedeemVerificationKey PublicKey
b =
    PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
a ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PublicKey
b :: ByteString)

instance Monad m => ToObjectKey m RedeemVerificationKey where
  toObjectKey :: RedeemVerificationKey -> m JSString
toObjectKey = JSString -> m JSString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSString -> m JSString)
-> (RedeemVerificationKey -> JSString)
-> RedeemVerificationKey
-> m JSString
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)
-> (RedeemVerificationKey -> String)
-> RedeemVerificationKey
-> 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 (RedeemVerificationKey -> String)
-> RedeemVerificationKey -> String
forall a. Format String a -> a
formatToString Format String (RedeemVerificationKey -> String)
forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF

instance MonadError SchemaError m => FromObjectKey m RedeemVerificationKey where
  fromObjectKey :: JSString -> m (Maybe RedeemVerificationKey)
fromObjectKey =
    (RedeemVerificationKey -> Maybe RedeemVerificationKey)
-> m RedeemVerificationKey -> m (Maybe RedeemVerificationKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RedeemVerificationKey -> Maybe RedeemVerificationKey
forall a. a -> Maybe a
Just (m RedeemVerificationKey -> m (Maybe RedeemVerificationKey))
-> (JSString -> m RedeemVerificationKey)
-> JSString
-> m (Maybe RedeemVerificationKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Either Text RedeemVerificationKey)
-> JSValue -> m RedeemVerificationKey
forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString ((AvvmVKError -> Text)
-> Either AvvmVKError RedeemVerificationKey
-> Either Text RedeemVerificationKey
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Format Text (AvvmVKError -> Text) -> AvvmVKError -> Text
forall a. Format Text a -> a
sformat Format Text (AvvmVKError -> Text)
forall a r. Buildable a => Format r (a -> r)
build) (Either AvvmVKError RedeemVerificationKey
 -> Either Text RedeemVerificationKey)
-> (Text -> Either AvvmVKError RedeemVerificationKey)
-> Text
-> Either Text RedeemVerificationKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either AvvmVKError RedeemVerificationKey
fromAvvmVK) (JSValue -> m RedeemVerificationKey)
-> (JSString -> JSValue) -> JSString -> m RedeemVerificationKey
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

instance ToJSONKey RedeemVerificationKey where
  toJSONKey :: ToJSONKeyFunction RedeemVerificationKey
toJSONKey = (RedeemVerificationKey -> Key)
-> (RedeemVerificationKey -> Encoding' Key)
-> ToJSONKeyFunction RedeemVerificationKey
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText RedeemVerificationKey -> Key
render (Key -> Encoding' Key
forall a. Key -> Encoding' a
A.key (Key -> Encoding' Key)
-> (RedeemVerificationKey -> Key)
-> RedeemVerificationKey
-> Encoding' Key
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RedeemVerificationKey -> Key
render)
    where
      render :: RedeemVerificationKey -> Key
render = Text -> Key
A.fromText (Text -> Key)
-> (RedeemVerificationKey -> Text) -> RedeemVerificationKey -> Key
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (RedeemVerificationKey -> Text)
-> RedeemVerificationKey -> Text
forall a. Format Text a -> a
sformat Format Text (RedeemVerificationKey -> Text)
forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF

instance FromJSONKey RedeemVerificationKey where
  fromJSONKey :: FromJSONKeyFunction RedeemVerificationKey
fromJSONKey =
    (Text -> Parser RedeemVerificationKey)
-> FromJSONKeyFunction RedeemVerificationKey
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser RedeemVerificationKey)
 -> FromJSONKeyFunction RedeemVerificationKey)
-> (Text -> Parser RedeemVerificationKey)
-> FromJSONKeyFunction RedeemVerificationKey
forall a b. (a -> b) -> a -> b
$ Either Text RedeemVerificationKey -> Parser RedeemVerificationKey
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either Text RedeemVerificationKey -> Parser RedeemVerificationKey)
-> (Text -> Either Text RedeemVerificationKey)
-> Text
-> Parser RedeemVerificationKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AvvmVKError -> Text)
-> Either AvvmVKError RedeemVerificationKey
-> Either Text RedeemVerificationKey
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Format Text (AvvmVKError -> Text) -> AvvmVKError -> Text
forall a. Format Text a -> a
sformat Format Text (AvvmVKError -> Text)
forall a r. Buildable a => Format r (a -> r)
build) (Either AvvmVKError RedeemVerificationKey
 -> Either Text RedeemVerificationKey)
-> (Text -> Either AvvmVKError RedeemVerificationKey)
-> Text
-> Either Text RedeemVerificationKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either AvvmVKError RedeemVerificationKey
fromAvvmVK
  fromJSONKeyList :: FromJSONKeyFunction [RedeemVerificationKey]
fromJSONKeyList =
    (Text -> Parser [RedeemVerificationKey])
-> FromJSONKeyFunction [RedeemVerificationKey]
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser [RedeemVerificationKey])
 -> FromJSONKeyFunction [RedeemVerificationKey])
-> (Text -> Parser [RedeemVerificationKey])
-> FromJSONKeyFunction [RedeemVerificationKey]
forall a b. (a -> b) -> a -> b
$
      Either Text [RedeemVerificationKey]
-> Parser [RedeemVerificationKey]
forall e a. Buildable e => Either e a -> Parser a
toAesonError
        (Either Text [RedeemVerificationKey]
 -> Parser [RedeemVerificationKey])
-> (Text -> Either Text [RedeemVerificationKey])
-> Text
-> Parser [RedeemVerificationKey]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (AvvmVKError -> Text)
-> (RedeemVerificationKey -> [RedeemVerificationKey])
-> Either AvvmVKError RedeemVerificationKey
-> Either Text [RedeemVerificationKey]
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Format Text (AvvmVKError -> Text) -> AvvmVKError -> Text
forall a. Format Text a -> a
sformat Format Text (AvvmVKError -> Text)
forall a r. Buildable a => Format r (a -> r)
build) RedeemVerificationKey -> [RedeemVerificationKey]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either AvvmVKError RedeemVerificationKey
 -> Either Text [RedeemVerificationKey])
-> (Text -> Either AvvmVKError RedeemVerificationKey)
-> Text
-> Either Text [RedeemVerificationKey]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either AvvmVKError RedeemVerificationKey
fromAvvmVK

instance B.Buildable RedeemVerificationKey where
  build :: RedeemVerificationKey -> Builder
build = Format Builder (RedeemVerificationKey -> Builder)
-> RedeemVerificationKey -> Builder
forall a. Format Builder a -> a
bprint (Format
  (RedeemVerificationKey -> Builder)
  (RedeemVerificationKey -> Builder)
"redeem_vk:" Format
  (RedeemVerificationKey -> Builder)
  (RedeemVerificationKey -> Builder)
-> Format Builder (RedeemVerificationKey -> Builder)
-> Format Builder (RedeemVerificationKey -> 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 (RedeemVerificationKey -> Builder)
forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64F)

fromVerificationKeyToByteString :: Ed25519.PublicKey -> BS.ByteString
fromVerificationKeyToByteString :: PublicKey -> ByteString
fromVerificationKeyToByteString = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert

redeemVKB64F :: Format r (RedeemVerificationKey -> r)
redeemVKB64F :: Format r (RedeemVerificationKey -> r)
redeemVKB64F = (RedeemVerificationKey -> Builder)
-> Format r (RedeemVerificationKey -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((RedeemVerificationKey -> Builder)
 -> Format r (RedeemVerificationKey -> r))
-> (RedeemVerificationKey -> Builder)
-> Format r (RedeemVerificationKey -> r)
forall a b. (a -> b) -> a -> b
$ \(RedeemVerificationKey PublicKey
vk) ->
  String -> Builder
forall p. Buildable p => p -> Builder
B.build (String -> Builder)
-> (ByteString -> String) -> ByteString -> 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
Char8.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> 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 -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
fromVerificationKeyToByteString PublicKey
vk

-- | Base64url Format for 'RedeemVerificationKey'.
redeemVKB64UrlF :: Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF :: Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF = (RedeemVerificationKey -> Builder)
-> Format r (RedeemVerificationKey -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((RedeemVerificationKey -> Builder)
 -> Format r (RedeemVerificationKey -> r))
-> (RedeemVerificationKey -> Builder)
-> Format r (RedeemVerificationKey -> r)
forall a b. (a -> b) -> a -> b
$ \(RedeemVerificationKey PublicKey
vk) ->
  String -> Builder
forall p. Buildable p => p -> Builder
B.build (String -> Builder)
-> (ByteString -> String) -> ByteString -> 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
Char8.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> 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
B64URL.encode (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
fromVerificationKeyToByteString PublicKey
vk

redeemVKB64ShortF :: Format r (RedeemVerificationKey -> r)
redeemVKB64ShortF :: Format r (RedeemVerificationKey -> r)
redeemVKB64ShortF = Int -> Format r (Builder -> r)
forall a r. Buildable a => Int -> Format r (a -> r)
fitLeft Int
8 Format r (Builder -> r)
-> Format r (RedeemVerificationKey -> r)
-> Format r (RedeemVerificationKey -> r)
forall r r' a.
Format r (Builder -> r') -> Format r' a -> Format r a
%. Format r (RedeemVerificationKey -> r)
forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64F

-- | Read the text into a redeeming verification key. The key should be in
--   AVVM format which is base64(url). This function must be inverse of
--   redeemVKB64UrlF formatter.
fromAvvmVK :: Text -> Either AvvmVKError RedeemVerificationKey
fromAvvmVK :: Text -> Either AvvmVKError RedeemVerificationKey
fromAvvmVK Text
addrText = do
  let base64rify :: Text -> Text
base64rify = Text -> Text -> Text -> Text
T.replace Text
"-" Text
"+" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> Text -> Text
T.replace Text
"_" Text
"/"
  let parsedM :: Either String ByteString
parsedM = ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
T.encodeUtf8 (Text -> Either String ByteString)
-> Text -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
base64rify Text
addrText
  ByteString
addrParsed <- case Either String ByteString
parsedM of
    Left String
_ -> AvvmVKError -> Either AvvmVKError ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AvvmVKError -> Either AvvmVKError ByteString)
-> AvvmVKError -> Either AvvmVKError ByteString
forall a b. (a -> b) -> a -> b
$ Text -> AvvmVKError
ApeAddressFormat Text
addrText
    Right ByteString
a -> ByteString -> Either AvvmVKError ByteString
forall a b. b -> Either a b
Right ByteString
a
  let len :: Int
len = ByteString -> Int
BS.length ByteString
addrParsed
  (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32) Bool -> AvvmVKError -> Either AvvmVKError ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Int -> AvvmVKError
ApeAddressLength Int
len
  RedeemVerificationKey -> Either AvvmVKError RedeemVerificationKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RedeemVerificationKey -> Either AvvmVKError RedeemVerificationKey)
-> RedeemVerificationKey
-> Either AvvmVKError RedeemVerificationKey
forall a b. (a -> b) -> a -> b
$ ByteString -> RedeemVerificationKey
redeemVKBuild ByteString
addrParsed

-- | Creates a verification key from 32 byte bytestring, fails with 'error' otherwise
redeemVKBuild :: ByteString -> RedeemVerificationKey
redeemVKBuild :: ByteString -> RedeemVerificationKey
redeemVKBuild ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 =
      Text -> RedeemVerificationKey
forall a. HasCallStack => Text -> a
panic (Text -> RedeemVerificationKey) -> Text -> RedeemVerificationKey
forall a b. (a -> b) -> a -> b
$
        Text
"consRedeemVK: failed to form vk, wrong bs length: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (ByteString -> Int
BS.length ByteString
bs)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", when should be 32"
  | Bool
otherwise =
      case Bytes -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
bs :: BA.Bytes) of
        CryptoPassed PublicKey
r -> PublicKey -> RedeemVerificationKey
RedeemVerificationKey PublicKey
r
        CryptoFailed CryptoError
e ->
          Text -> RedeemVerificationKey
forall a. HasCallStack => Text -> a
panic (Text -> RedeemVerificationKey) -> Text -> RedeemVerificationKey
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend
              Text
"Cardano.Crypto.Signing.Types.Redeem.hs consRedeemVK failed because "
              (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CryptoError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show CryptoError
e)

data AvvmVKError
  = ApeAddressFormat Text
  | ApeAddressLength Int
  deriving (Int -> AvvmVKError -> ShowS
[AvvmVKError] -> ShowS
AvvmVKError -> String
(Int -> AvvmVKError -> ShowS)
-> (AvvmVKError -> String)
-> ([AvvmVKError] -> ShowS)
-> Show AvvmVKError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AvvmVKError] -> ShowS
$cshowList :: [AvvmVKError] -> ShowS
show :: AvvmVKError -> String
$cshow :: AvvmVKError -> String
showsPrec :: Int -> AvvmVKError -> ShowS
$cshowsPrec :: Int -> AvvmVKError -> ShowS
Show)

instance B.Buildable AvvmVKError where
  build :: AvvmVKError -> Builder
build = \case
    ApeAddressFormat Text
addrText ->
      Format Builder (Text -> Builder) -> Text -> Builder
forall a. Format Builder a -> a
bprint (Format (Text -> Builder) (Text -> Builder)
"Address " 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 Format Builder (Text -> Builder)
-> Format Builder 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 Builder
" is not base64(url) format") Text
addrText
    ApeAddressLength Int
len ->
      Format Builder (Int -> Builder) -> Int -> Builder
forall a. Format Builder a -> a
bprint
        (Format (Int -> Builder) (Int -> Builder)
"Address length is " Format (Int -> Builder) (Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> 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 (Int -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Int -> Builder)
-> Format Builder Builder -> Format Builder (Int -> 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 Builder
", expected 32, can't be redeeming vk")
        Int
len

deriveJSON defaultOptions ''RedeemVerificationKey