{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Bcc.Node.Orphans () where

import           Bcc.Prelude
import           Prelude (fail)

import           Bcc.Api.Orphans ()

import           Data.Aeson.Types
import qualified Data.Text as Text

import           Bcc.BM.Data.Tracer (TracingVerbosity (..))
import qualified Bcc.Chain.Update as Update
import           Bcc.Ledger.Crypto (StandardCrypto)
import qualified Sophie.Spec.Ledger.CompactAddr as Sophie

instance FromJSON TracingVerbosity where
  parseJSON :: Value -> Parser TracingVerbosity
parseJSON (String Text
str) = case Text
str of
    Text
"MinimalVerbosity" -> TracingVerbosity -> Parser TracingVerbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure TracingVerbosity
MinimalVerbosity
    Text
"MaximalVerbosity" -> TracingVerbosity -> Parser TracingVerbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure TracingVerbosity
MaximalVerbosity
    Text
"NormalVerbosity" -> TracingVerbosity -> Parser TracingVerbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure TracingVerbosity
NormalVerbosity
    Text
err -> String -> Parser TracingVerbosity
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TracingVerbosity)
-> String -> Parser TracingVerbosity
forall a b. (a -> b) -> a -> b
$ String
"Parsing of TracingVerbosity failed, "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
err String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not a valid TracingVerbosity"
  parseJSON Value
invalid  = String -> Parser TracingVerbosity
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TracingVerbosity)
-> String -> Parser TracingVerbosity
forall a b. (a -> b) -> a -> b
$ String
"Parsing of TracingVerbosity failed due to type mismatch. "
                           String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Encountered: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Value
invalid

deriving instance Show TracingVerbosity

instance ToJSON (Sophie.CompactAddr StandardCrypto) where
  toJSON :: CompactAddr StandardCrypto -> Value
toJSON = Addr StandardCrypto -> Value
forall a. ToJSON a => a -> Value
toJSON (Addr StandardCrypto -> Value)
-> (CompactAddr StandardCrypto -> Addr StandardCrypto)
-> CompactAddr StandardCrypto
-> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CompactAddr StandardCrypto -> Addr StandardCrypto
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
Sophie.decompactAddr

--Not currently needed, but if we do need it, this is the general instance.
--instance (ToJSON a, Ledger.Compactible a) => ToJSON (Ledger.CompactForm a) where
--  toJSON = toJSON  . Ledger.fromCompact

instance FromJSON Update.ApplicationName where
  parseJSON :: Value -> Parser ApplicationName
parseJSON (String Text
x) = ApplicationName -> Parser ApplicationName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApplicationName -> Parser ApplicationName)
-> ApplicationName -> Parser ApplicationName
forall a b. (a -> b) -> a -> b
$ Text -> ApplicationName
Update.ApplicationName Text
x
  parseJSON Value
invalid  =
    String -> Parser ApplicationName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ApplicationName)
-> String -> Parser ApplicationName
forall a b. (a -> b) -> a -> b
$ String
"Parsing of application name failed due to type mismatch. "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Encountered: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Value
invalid