{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Cardano.Api.NetworkId where

import Hydra.Cardano.Api.Prelude

import Data.Aeson (Value (Number, String), object, withObject, (.:), (.=))

-- * Orphans

instance ToJSON NetworkId where
  toJSON :: NetworkId -> Value
toJSON = \case
    NetworkId
Mainnet -> [Pair] -> Value
object [Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Mainnet"]
    Testnet NetworkMagic
magic ->
      [Pair] -> Value
object
        [ Key
"tag" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Testnet"
        , Key
"magic" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Scientific -> Value
Number (Word32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Scientific) -> Word32 -> Scientific
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> Word32
unNetworkMagic NetworkMagic
magic)
        ]

instance FromJSON NetworkId where
  parseJSON :: Value -> Parser NetworkId
parseJSON = String -> (Object -> Parser NetworkId) -> Value -> Parser NetworkId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NetworkId" ((Object -> Parser NetworkId) -> Value -> Parser NetworkId)
-> (Object -> Parser NetworkId) -> Value -> Parser NetworkId
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
tag <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case Text
tag :: Text of
      Text
"Mainnet" -> NetworkId -> Parser NetworkId
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkId
Mainnet
      Text
"Testnet" -> NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId)
-> (Word32 -> NetworkMagic) -> Word32 -> NetworkId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkId) -> Parser Word32 -> Parser NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"magic"
      Text
_ -> String -> Parser NetworkId
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected tag to be Mainnet | Testnet"