{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Crypto.Signing.Redeem.Compact (
  CompactRedeemVerificationKey (..),
  fromCompactRedeemVerificationKey,
  toCompactRedeemVerificationKey,
) where

import Cardano.Crypto.Signing.Redeem.VerificationKey (
  RedeemVerificationKey (..),
  fromAvvmVK,
  fromVerificationKeyToByteString,
  redeemVKB64UrlF,
  redeemVKBuild,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Aeson (
  FromJSON (..),
  FromJSONKey (..),
  ToJSON (..),
  ToJSONKey (..),
  ToJSONKeyFunction (..),
 )
import qualified Data.Aeson.Encoding.Internal as A
import qualified Data.Aeson.Key as A
import Data.Binary.Get (Get, getWord64le, runGet)
import Data.Binary.Put (Put, putWord64le, runPut)
import qualified Data.ByteString.Lazy as BSL (fromStrict, toStrict)
import Formatting (build, formatToString, sformat)
import NoThunks.Class (InspectHeap (..), NoThunks (..))
import Text.JSON.Canonical (
  FromObjectKey (..),
  JSValue (..),
  ToObjectKey (..),
  toJSString,
 )

type CompactRedeemVerificationKey :: Type
data CompactRedeemVerificationKey
  = CompactRedeemVerificationKey
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
      {-# UNPACK #-} !Word64
  deriving (CompactRedeemVerificationKey
-> CompactRedeemVerificationKey -> Bool
(CompactRedeemVerificationKey
 -> CompactRedeemVerificationKey -> Bool)
-> (CompactRedeemVerificationKey
    -> CompactRedeemVerificationKey -> Bool)
-> Eq CompactRedeemVerificationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactRedeemVerificationKey
-> CompactRedeemVerificationKey -> Bool
== :: CompactRedeemVerificationKey
-> CompactRedeemVerificationKey -> Bool
$c/= :: CompactRedeemVerificationKey
-> CompactRedeemVerificationKey -> Bool
/= :: CompactRedeemVerificationKey
-> CompactRedeemVerificationKey -> Bool
Eq, (forall x.
 CompactRedeemVerificationKey -> Rep CompactRedeemVerificationKey x)
-> (forall x.
    Rep CompactRedeemVerificationKey x -> CompactRedeemVerificationKey)
-> Generic CompactRedeemVerificationKey
forall x.
Rep CompactRedeemVerificationKey x -> CompactRedeemVerificationKey
forall x.
CompactRedeemVerificationKey -> Rep CompactRedeemVerificationKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CompactRedeemVerificationKey -> Rep CompactRedeemVerificationKey x
from :: forall x.
CompactRedeemVerificationKey -> Rep CompactRedeemVerificationKey x
$cto :: forall x.
Rep CompactRedeemVerificationKey x -> CompactRedeemVerificationKey
to :: forall x.
Rep CompactRedeemVerificationKey x -> CompactRedeemVerificationKey
Generic, Int -> CompactRedeemVerificationKey -> ShowS
[CompactRedeemVerificationKey] -> ShowS
CompactRedeemVerificationKey -> String
(Int -> CompactRedeemVerificationKey -> ShowS)
-> (CompactRedeemVerificationKey -> String)
-> ([CompactRedeemVerificationKey] -> ShowS)
-> Show CompactRedeemVerificationKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompactRedeemVerificationKey -> ShowS
showsPrec :: Int -> CompactRedeemVerificationKey -> ShowS
$cshow :: CompactRedeemVerificationKey -> String
show :: CompactRedeemVerificationKey -> String
$cshowList :: [CompactRedeemVerificationKey] -> ShowS
showList :: [CompactRedeemVerificationKey] -> ShowS
Show)
  deriving (Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo)
Proxy CompactRedeemVerificationKey -> String
(Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo))
-> (Context
    -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo))
-> (Proxy CompactRedeemVerificationKey -> String)
-> NoThunks CompactRedeemVerificationKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CompactRedeemVerificationKey -> String
showTypeOf :: Proxy CompactRedeemVerificationKey -> String
NoThunks) via InspectHeap CompactRedeemVerificationKey
  deriving anyclass (CompactRedeemVerificationKey -> ()
(CompactRedeemVerificationKey -> ())
-> NFData CompactRedeemVerificationKey
forall a. (a -> ()) -> NFData a
$crnf :: CompactRedeemVerificationKey -> ()
rnf :: CompactRedeemVerificationKey -> ()
NFData)

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

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

instance EncCBOR CompactRedeemVerificationKey where
  encCBOR :: CompactRedeemVerificationKey -> Encoding
encCBOR (CompactRedeemVerificationKey Word64
a Word64
b Word64
c Word64
d) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
4
      , forall a. EncCBOR a => a -> Encoding
encCBOR @Word64 Word64
a
      , forall a. EncCBOR a => a -> Encoding
encCBOR @Word64 Word64
b
      , forall a. EncCBOR a => a -> Encoding
encCBOR @Word64 Word64
c
      , forall a. EncCBOR a => a -> Encoding
encCBOR @Word64 Word64
d
      ]

instance DecCBOR CompactRedeemVerificationKey where
  decCBOR :: forall s. Decoder s CompactRedeemVerificationKey
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CompactRedeemVerificationKey" Int
4
    Word64
-> Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey
CompactRedeemVerificationKey
      (Word64
 -> Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey)
-> Decoder s Word64
-> Decoder
     s (Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64
      Decoder
  s (Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey)
-> Decoder s Word64
-> Decoder s (Word64 -> Word64 -> CompactRedeemVerificationKey)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64
      Decoder s (Word64 -> Word64 -> CompactRedeemVerificationKey)
-> Decoder s Word64
-> Decoder s (Word64 -> CompactRedeemVerificationKey)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64
      Decoder s (Word64 -> CompactRedeemVerificationKey)
-> Decoder s Word64 -> Decoder s CompactRedeemVerificationKey
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64

getCompactRedeemVerificationKey :: Get CompactRedeemVerificationKey
getCompactRedeemVerificationKey :: Get CompactRedeemVerificationKey
getCompactRedeemVerificationKey =
  Word64
-> Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey
CompactRedeemVerificationKey
    (Word64
 -> Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey)
-> Get Word64
-> Get (Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
    Get (Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey)
-> Get Word64
-> Get (Word64 -> Word64 -> CompactRedeemVerificationKey)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    Get (Word64 -> Word64 -> CompactRedeemVerificationKey)
-> Get Word64 -> Get (Word64 -> CompactRedeemVerificationKey)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    Get (Word64 -> CompactRedeemVerificationKey)
-> Get Word64 -> Get CompactRedeemVerificationKey
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le

putCompactRedeemVerificationKey :: CompactRedeemVerificationKey -> Put
putCompactRedeemVerificationKey :: CompactRedeemVerificationKey -> Put
putCompactRedeemVerificationKey (CompactRedeemVerificationKey Word64
a Word64
b Word64
c Word64
d) =
  Word64 -> Put
putWord64le Word64
a
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
b
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
c
    Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
d

toCompactRedeemVerificationKey ::
  RedeemVerificationKey ->
  CompactRedeemVerificationKey
toCompactRedeemVerificationKey :: RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey (RedeemVerificationKey PublicKey
pk) =
  Get CompactRedeemVerificationKey
-> ByteString -> CompactRedeemVerificationKey
forall a. Get a -> ByteString -> a
runGet Get CompactRedeemVerificationKey
getCompactRedeemVerificationKey (ByteString -> ByteString
BSL.fromStrict ByteString
bs)
  where
    bs :: ByteString
    bs :: ByteString
bs = PublicKey -> ByteString
fromVerificationKeyToByteString PublicKey
pk

fromCompactRedeemVerificationKey ::
  CompactRedeemVerificationKey ->
  RedeemVerificationKey
fromCompactRedeemVerificationKey :: CompactRedeemVerificationKey -> RedeemVerificationKey
fromCompactRedeemVerificationKey CompactRedeemVerificationKey
compactRvk =
  ByteString -> RedeemVerificationKey
redeemVKBuild ByteString
bs
  where
    bs :: ByteString
    bs :: ByteString
bs =
      ByteString -> ByteString
BSL.toStrict
        (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut
        (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ CompactRedeemVerificationKey -> Put
putCompactRedeemVerificationKey CompactRedeemVerificationKey
compactRvk

instance Ord CompactRedeemVerificationKey where
  compare :: CompactRedeemVerificationKey
-> CompactRedeemVerificationKey -> Ordering
compare = RedeemVerificationKey -> RedeemVerificationKey -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (RedeemVerificationKey -> RedeemVerificationKey -> Ordering)
-> (CompactRedeemVerificationKey -> RedeemVerificationKey)
-> CompactRedeemVerificationKey
-> CompactRedeemVerificationKey
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` CompactRedeemVerificationKey -> RedeemVerificationKey
fromCompactRedeemVerificationKey

instance ToJSON CompactRedeemVerificationKey where
  toJSON :: CompactRedeemVerificationKey -> Value
toJSON = RedeemVerificationKey -> Value
forall a. ToJSON a => a -> Value
toJSON (RedeemVerificationKey -> Value)
-> (CompactRedeemVerificationKey -> RedeemVerificationKey)
-> CompactRedeemVerificationKey
-> 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
. CompactRedeemVerificationKey -> RedeemVerificationKey
fromCompactRedeemVerificationKey

instance FromJSON CompactRedeemVerificationKey where
  parseJSON :: Value -> Parser CompactRedeemVerificationKey
parseJSON = (RedeemVerificationKey -> CompactRedeemVerificationKey)
-> Parser RedeemVerificationKey
-> Parser CompactRedeemVerificationKey
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey (Parser RedeemVerificationKey
 -> Parser CompactRedeemVerificationKey)
-> (Value -> Parser RedeemVerificationKey)
-> Value
-> Parser CompactRedeemVerificationKey
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
. Value -> Parser RedeemVerificationKey
forall a. FromJSON a => Value -> Parser a
parseJSON

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

instance MonadError SchemaError m => FromObjectKey m CompactRedeemVerificationKey where
  fromObjectKey :: JSString -> m (Maybe CompactRedeemVerificationKey)
fromObjectKey =
    (RedeemVerificationKey -> Maybe CompactRedeemVerificationKey)
-> m RedeemVerificationKey
-> m (Maybe CompactRedeemVerificationKey)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CompactRedeemVerificationKey -> Maybe CompactRedeemVerificationKey
forall a. a -> Maybe a
Just (CompactRedeemVerificationKey
 -> Maybe CompactRedeemVerificationKey)
-> (RedeemVerificationKey -> CompactRedeemVerificationKey)
-> RedeemVerificationKey
-> Maybe CompactRedeemVerificationKey
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
. RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey)
      (m RedeemVerificationKey -> m (Maybe CompactRedeemVerificationKey))
-> (JSString -> m RedeemVerificationKey)
-> JSString
-> m (Maybe CompactRedeemVerificationKey)
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 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 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 (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 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 AvvmVKError RedeemVerificationKey
fromAvvmVK)
      (JSValue -> m RedeemVerificationKey)
-> (JSString -> JSValue) -> JSString -> m RedeemVerificationKey
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

instance ToJSONKey CompactRedeemVerificationKey where
  toJSONKey :: ToJSONKeyFunction CompactRedeemVerificationKey
toJSONKey = (CompactRedeemVerificationKey -> Key)
-> (CompactRedeemVerificationKey -> Encoding' Key)
-> ToJSONKeyFunction CompactRedeemVerificationKey
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText CompactRedeemVerificationKey -> Key
render (Key -> Encoding' Key
forall a. Key -> Encoding' a
A.key (Key -> Encoding' Key)
-> (CompactRedeemVerificationKey -> Key)
-> CompactRedeemVerificationKey
-> Encoding' Key
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
. CompactRedeemVerificationKey -> Key
render)
    where
      render :: CompactRedeemVerificationKey -> Key
render = Text -> Key
A.fromText (Text -> Key)
-> (CompactRedeemVerificationKey -> Text)
-> CompactRedeemVerificationKey
-> Key
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 (RedeemVerificationKey -> Text)
-> RedeemVerificationKey -> Text
forall a. Format Text a -> a
sformat Format Text (RedeemVerificationKey -> Text)
forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF (RedeemVerificationKey -> Text)
-> (CompactRedeemVerificationKey -> RedeemVerificationKey)
-> CompactRedeemVerificationKey
-> Text
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
. CompactRedeemVerificationKey -> RedeemVerificationKey
fromCompactRedeemVerificationKey

instance FromJSONKey CompactRedeemVerificationKey where
  fromJSONKey :: FromJSONKeyFunction CompactRedeemVerificationKey
fromJSONKey = RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey (RedeemVerificationKey -> CompactRedeemVerificationKey)
-> FromJSONKeyFunction RedeemVerificationKey
-> FromJSONKeyFunction CompactRedeemVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromJSONKeyFunction RedeemVerificationKey
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey
  fromJSONKeyList :: FromJSONKeyFunction [CompactRedeemVerificationKey]
fromJSONKeyList = (RedeemVerificationKey -> CompactRedeemVerificationKey)
-> [RedeemVerificationKey] -> [CompactRedeemVerificationKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey ([RedeemVerificationKey] -> [CompactRedeemVerificationKey])
-> FromJSONKeyFunction [RedeemVerificationKey]
-> FromJSONKeyFunction [CompactRedeemVerificationKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromJSONKeyFunction [RedeemVerificationKey]
forall a. FromJSONKey a => FromJSONKeyFunction [a]
fromJSONKeyList