{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Cardano.Api.VerificationKey where

import Hydra.Cardano.Api.Prelude

-- * Orphans

-- XXX: This is quite specific to payment keys

instance ToJSON (VerificationKey PaymentKey) where
  toJSON :: VerificationKey PaymentKey -> Value
toJSON = TextEnvelope -> Value
forall a. ToJSON a => a -> Value
toJSON (TextEnvelope -> Value)
-> (VerificationKey PaymentKey -> TextEnvelope)
-> VerificationKey PaymentKey
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TextEnvelopeDescr
-> VerificationKey PaymentKey -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing

instance FromJSON (VerificationKey PaymentKey) where
  parseJSON :: Value -> Parser (VerificationKey PaymentKey)
parseJSON Value
v = do
    TextEnvelope
env <- Value -> Parser TextEnvelope
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case AsType (VerificationKey PaymentKey)
-> TextEnvelope
-> Either TextEnvelopeError (VerificationKey PaymentKey)
forall a.
HasTextEnvelope a =>
AsType a -> TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope (AsType PaymentKey -> AsType (VerificationKey PaymentKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType PaymentKey
AsPaymentKey) TextEnvelope
env of
      Left TextEnvelopeError
e -> String -> Parser (VerificationKey PaymentKey)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (VerificationKey PaymentKey))
-> String -> Parser (VerificationKey PaymentKey)
forall a b. (a -> b) -> a -> b
$ TextEnvelopeError -> String
forall a. Show a => a -> String
show TextEnvelopeError
e
      Right VerificationKey PaymentKey
a -> VerificationKey PaymentKey -> Parser (VerificationKey PaymentKey)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationKey PaymentKey
a