{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} module Cardano.Crypto.Signing.Redeem.Compact ( CompactRedeemVerificationKey(..) , fromCompactRedeemVerificationKey , toCompactRedeemVerificationKey ) where import Cardano.Prelude import Data.Aeson ( FromJSON(..) , FromJSONKey(..) , ToJSON(..) , ToJSONKey(..) , ToJSONKeyFunction(..) ) import qualified Data.Aeson.Encoding 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 (NoThunks (..), InspectHeap (..)) import Text.JSON.Canonical (FromObjectKey(..), JSValue(..), ToObjectKey(..), toJSString) import Cardano.Crypto.Signing.Redeem.VerificationKey ( RedeemVerificationKey (..) , fromAvvmVK , fromVerificationKeyToByteString , redeemVKB64UrlF , redeemVKBuild ) 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 /= :: CompactRedeemVerificationKey -> CompactRedeemVerificationKey -> Bool $c/= :: CompactRedeemVerificationKey -> CompactRedeemVerificationKey -> Bool == :: CompactRedeemVerificationKey -> CompactRedeemVerificationKey -> Bool $c== :: 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 $cto :: forall x. Rep CompactRedeemVerificationKey x -> CompactRedeemVerificationKey $cfrom :: forall x. CompactRedeemVerificationKey -> Rep CompactRedeemVerificationKey x 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 showList :: [CompactRedeemVerificationKey] -> ShowS $cshowList :: [CompactRedeemVerificationKey] -> ShowS show :: CompactRedeemVerificationKey -> String $cshow :: CompactRedeemVerificationKey -> String showsPrec :: Int -> CompactRedeemVerificationKey -> ShowS $cshowsPrec :: Int -> 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 showTypeOf :: Proxy CompactRedeemVerificationKey -> String $cshowTypeOf :: Proxy CompactRedeemVerificationKey -> String wNoThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo) $cwNoThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo) noThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo) $cnoThunks :: Context -> CompactRedeemVerificationKey -> IO (Maybe ThunkInfo) NoThunks via InspectHeap CompactRedeemVerificationKey deriving anyclass CompactRedeemVerificationKey -> () (CompactRedeemVerificationKey -> ()) -> NFData CompactRedeemVerificationKey forall a. (a -> ()) -> NFData a rnf :: CompactRedeemVerificationKey -> () $crnf :: CompactRedeemVerificationKey -> () NFData 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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Get Word64 getWord64le Get (Word64 -> CompactRedeemVerificationKey) -> Get Word64 -> Get CompactRedeemVerificationKey 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Word64 -> Put putWord64le Word64 b Put -> Put -> Put forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Word64 -> Put putWord64le Word64 c Put -> Put -> Put 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 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 (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 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 (f :: * -> *) a. Applicative f => a -> f a pure (JSString -> m JSString) -> (CompactRedeemVerificationKey -> JSString) -> CompactRedeemVerificationKey -> 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) -> (CompactRedeemVerificationKey -> String) -> CompactRedeemVerificationKey -> 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 (RedeemVerificationKey -> String) -> (CompactRedeemVerificationKey -> RedeemVerificationKey) -> CompactRedeemVerificationKey -> String 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 (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 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 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 CompactRedeemVerificationKey where toJSONKey :: ToJSONKeyFunction CompactRedeemVerificationKey toJSONKey = (CompactRedeemVerificationKey -> Text) -> (CompactRedeemVerificationKey -> Encoding' Text) -> ToJSONKeyFunction CompactRedeemVerificationKey forall a. (a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a ToJSONKeyText CompactRedeemVerificationKey -> Text render (Text -> Encoding' Text forall a. Text -> Encoding' a A.text (Text -> Encoding' Text) -> (CompactRedeemVerificationKey -> Text) -> CompactRedeemVerificationKey -> Encoding' Text forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . CompactRedeemVerificationKey -> Text render) where render :: CompactRedeemVerificationKey -> Text render = 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 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