{-# 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
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.
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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactRedeemVerificationKey -> ()
$crnf :: CompactRedeemVerificationKey -> ()
NFData)

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

instance FromCBOR CompactRedeemVerificationKey where
  fromCBOR :: forall s. Decoder s CompactRedeemVerificationKey
fromCBOR = 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) =
    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
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"CompactRedeemVerificationKey" Int
4
    Word64
-> Word64 -> Word64 -> Word64 -> CompactRedeemVerificationKey
CompactRedeemVerificationKey
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR @Word64
      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
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word64
getWord64le
    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
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64le Word64
c
    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) =
  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
        forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut
        forall a b. (a -> b) -> a -> b
$ CompactRedeemVerificationKey -> Put
putCompactRedeemVerificationKey CompactRedeemVerificationKey
compactRvk

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

instance ToJSON CompactRedeemVerificationKey where
  toJSON :: CompactRedeemVerificationKey -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. FromJSON a => Value -> Parser a
parseJSON

instance Monad m => ToObjectKey m CompactRedeemVerificationKey where
  toObjectKey :: CompactRedeemVerificationKey -> m JSString
toObjectKey = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format String a -> a
formatToString forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF 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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just 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)
      forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Format Text a -> a
sformat forall a r. Buildable a => Format r (a -> r)
build) 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)
      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 = forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
ToJSONKeyText CompactRedeemVerificationKey -> Key
render (forall a. Key -> Encoding' a
A.key 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format Text a -> a
sformat forall r. Format r (RedeemVerificationKey -> r)
redeemVKB64UrlF 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey
  fromJSONKeyList :: FromJSONKeyFunction [CompactRedeemVerificationKey]
fromJSONKeyList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSONKey a => FromJSONKeyFunction [a]
fromJSONKeyList