{-# LANGUAGE OverloadedStrings #-}

module Cardano.Api.NetworkId.Extra where

import Cardano.Api (NetworkId (..), NetworkMagic (..))
import Data.Aeson (FromJSON, ToJSON, Value (String), parseJSON, toJSON, withText)
import Data.Text qualified as Text
import Data.Text.Read qualified as Text

-- | Wrapper for 'NetworkId' to prevent the creation of orphan instances.
newtype NetworkIdWrapper = NetworkIdWrapper { NetworkIdWrapper -> NetworkId
unNetworkIdWrapper :: NetworkId }
    deriving (Int -> NetworkIdWrapper -> ShowS
[NetworkIdWrapper] -> ShowS
NetworkIdWrapper -> String
(Int -> NetworkIdWrapper -> ShowS)
-> (NetworkIdWrapper -> String)
-> ([NetworkIdWrapper] -> ShowS)
-> Show NetworkIdWrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkIdWrapper] -> ShowS
$cshowList :: [NetworkIdWrapper] -> ShowS
show :: NetworkIdWrapper -> String
$cshow :: NetworkIdWrapper -> String
showsPrec :: Int -> NetworkIdWrapper -> ShowS
$cshowsPrec :: Int -> NetworkIdWrapper -> ShowS
Show, NetworkIdWrapper -> NetworkIdWrapper -> Bool
(NetworkIdWrapper -> NetworkIdWrapper -> Bool)
-> (NetworkIdWrapper -> NetworkIdWrapper -> Bool)
-> Eq NetworkIdWrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkIdWrapper -> NetworkIdWrapper -> Bool
$c/= :: NetworkIdWrapper -> NetworkIdWrapper -> Bool
== :: NetworkIdWrapper -> NetworkIdWrapper -> Bool
$c== :: NetworkIdWrapper -> NetworkIdWrapper -> Bool
Eq)

-- | A network ID for use in testing.
testnetNetworkId :: NetworkIdWrapper
testnetNetworkId :: NetworkIdWrapper
testnetNetworkId = NetworkId -> NetworkIdWrapper
NetworkIdWrapper (NetworkId -> NetworkIdWrapper) -> NetworkId -> NetworkIdWrapper
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
1

-- | Custom 'FromJSON' instance for 'NetworkId' needed for allowing a user to
-- specify it in the 'Cardano.Node.Types.MockServerConfig'.
--
-- This instance parses 'NetworkId' as a string value. An empty string
-- refers to the Mainnet. A number encoded as a string refers to the
-- 'NetworkMagic' of the Testnet.
--
-- Here are some examples:
--
-- >>> decode "\"\"" :: Maybe NetworkId
-- Just Mainnet
--
-- >>> decode "\"1\"" :: Maybe NetworkId
-- Just (Testnet (NetworkMagic 1)))
--
-- >>> decode "\"1a\"" :: Maybe NetworkId
-- Nothing
--
-- >>> decode "\"other\"" :: Maybe NetworkId
-- Nothing
instance FromJSON NetworkIdWrapper where
    parseJSON :: Value -> Parser NetworkIdWrapper
parseJSON =
        let f :: Text -> f NetworkIdWrapper
f Text
s = case Text
s of
                Text
"" -> NetworkIdWrapper -> f NetworkIdWrapper
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NetworkIdWrapper -> f NetworkIdWrapper)
-> NetworkIdWrapper -> f NetworkIdWrapper
forall a b. (a -> b) -> a -> b
$ NetworkId -> NetworkIdWrapper
NetworkIdWrapper NetworkId
Mainnet
                Text
n -> do
                    case Reader Word32
forall a. Integral a => Reader a
Text.decimal Text
n of
                      Left String
errMsg    -> String -> f NetworkIdWrapper
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f NetworkIdWrapper) -> String -> f NetworkIdWrapper
forall a b. (a -> b) -> a -> b
$ String
"parsing NetworkId failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
errMsg
                      Right (Word32
n', Text
"") -> NetworkIdWrapper -> f NetworkIdWrapper
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NetworkIdWrapper -> f NetworkIdWrapper)
-> NetworkIdWrapper -> f NetworkIdWrapper
forall a b. (a -> b) -> a -> b
$ NetworkId -> NetworkIdWrapper
NetworkIdWrapper (NetworkId -> NetworkIdWrapper) -> NetworkId -> NetworkIdWrapper
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> NetworkId
Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
NetworkMagic Word32
n'
                      Right (Word32, Text)
_        -> String -> f NetworkIdWrapper
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parsing NetworkId failed: the String value should contain only numbers"
         in String
-> (Text -> Parser NetworkIdWrapper)
-> Value
-> Parser NetworkIdWrapper
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NetworkId" Text -> Parser NetworkIdWrapper
forall (f :: * -> *). MonadFail f => Text -> f NetworkIdWrapper
f

instance ToJSON NetworkIdWrapper where
    toJSON :: NetworkIdWrapper -> Value
toJSON (NetworkIdWrapper NetworkId
Mainnet)                    = Text -> Value
String Text
""
    toJSON (NetworkIdWrapper (Testnet (NetworkMagic Word32
n))) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
n