{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Copyright: © 2018-2022 IOHK
-- License: Apache-2.0
--
-- Provides the 'ProtocolMagic' type and related constants.
--
module Cardano.Wallet.Primitive.Types.ProtocolMagic
    ( ProtocolMagic (..)
    , mainnetMagic
    , testnetMagic
    ) where

import Prelude

import Control.DeepSeq
    ( NFData (..) )
import Data.Aeson
    ( FromJSON (..), ToJSON (..) )
import Data.Int
    ( Int32 )
import Data.Proxy
    ( Proxy (..) )
import Data.Text.Class
    ( FromText (..), ToText (..) )
import GHC.Generics
    ( Generic )
import GHC.TypeLits
    ( KnownNat, natVal )
import Numeric.Natural
    ( Natural )

import qualified Data.Text as T

-- | Magic constant associated with a given network.
--
newtype ProtocolMagic = ProtocolMagic { ProtocolMagic -> Int32
getProtocolMagic :: Int32 }
    deriving ((forall x. ProtocolMagic -> Rep ProtocolMagic x)
-> (forall x. Rep ProtocolMagic x -> ProtocolMagic)
-> Generic ProtocolMagic
forall x. Rep ProtocolMagic x -> ProtocolMagic
forall x. ProtocolMagic -> Rep ProtocolMagic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolMagic x -> ProtocolMagic
$cfrom :: forall x. ProtocolMagic -> Rep ProtocolMagic x
Generic, Int -> ProtocolMagic -> ShowS
[ProtocolMagic] -> ShowS
ProtocolMagic -> String
(Int -> ProtocolMagic -> ShowS)
-> (ProtocolMagic -> String)
-> ([ProtocolMagic] -> ShowS)
-> Show ProtocolMagic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolMagic] -> ShowS
$cshowList :: [ProtocolMagic] -> ShowS
show :: ProtocolMagic -> String
$cshow :: ProtocolMagic -> String
showsPrec :: Int -> ProtocolMagic -> ShowS
$cshowsPrec :: Int -> ProtocolMagic -> ShowS
Show, ProtocolMagic -> ProtocolMagic -> Bool
(ProtocolMagic -> ProtocolMagic -> Bool)
-> (ProtocolMagic -> ProtocolMagic -> Bool) -> Eq ProtocolMagic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolMagic -> ProtocolMagic -> Bool
$c/= :: ProtocolMagic -> ProtocolMagic -> Bool
== :: ProtocolMagic -> ProtocolMagic -> Bool
$c== :: ProtocolMagic -> ProtocolMagic -> Bool
Eq, ProtocolMagic -> ()
(ProtocolMagic -> ()) -> NFData ProtocolMagic
forall a. (a -> ()) -> NFData a
rnf :: ProtocolMagic -> ()
$crnf :: ProtocolMagic -> ()
NFData, Value -> Parser [ProtocolMagic]
Value -> Parser ProtocolMagic
(Value -> Parser ProtocolMagic)
-> (Value -> Parser [ProtocolMagic]) -> FromJSON ProtocolMagic
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ProtocolMagic]
$cparseJSONList :: Value -> Parser [ProtocolMagic]
parseJSON :: Value -> Parser ProtocolMagic
$cparseJSON :: Value -> Parser ProtocolMagic
FromJSON, [ProtocolMagic] -> Encoding
[ProtocolMagic] -> Value
ProtocolMagic -> Encoding
ProtocolMagic -> Value
(ProtocolMagic -> Value)
-> (ProtocolMagic -> Encoding)
-> ([ProtocolMagic] -> Value)
-> ([ProtocolMagic] -> Encoding)
-> ToJSON ProtocolMagic
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProtocolMagic] -> Encoding
$ctoEncodingList :: [ProtocolMagic] -> Encoding
toJSONList :: [ProtocolMagic] -> Value
$ctoJSONList :: [ProtocolMagic] -> Value
toEncoding :: ProtocolMagic -> Encoding
$ctoEncoding :: ProtocolMagic -> Encoding
toJSON :: ProtocolMagic -> Value
$ctoJSON :: ProtocolMagic -> Value
ToJSON)

instance ToText ProtocolMagic where
    toText :: ProtocolMagic -> Text
toText (ProtocolMagic Int32
pm) = String -> Text
T.pack (Int32 -> String
forall a. Show a => a -> String
show Int32
pm)

instance FromText ProtocolMagic where
    fromText :: Text -> Either TextDecodingError ProtocolMagic
fromText = (Natural -> ProtocolMagic)
-> Either TextDecodingError Natural
-> Either TextDecodingError ProtocolMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32 -> ProtocolMagic
ProtocolMagic (Int32 -> ProtocolMagic)
-> (Natural -> Int32) -> Natural -> ProtocolMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. (Integral Natural, Num b) => Natural -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural) (Either TextDecodingError Natural
 -> Either TextDecodingError ProtocolMagic)
-> (Text -> Either TextDecodingError Natural)
-> Text
-> Either TextDecodingError ProtocolMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError Natural
forall a. FromText a => Text -> Either TextDecodingError a
fromText

-- | Hard-coded protocol magic for the Byron MainNet
mainnetMagic :: ProtocolMagic
mainnetMagic :: ProtocolMagic
mainnetMagic =  Int32 -> ProtocolMagic
ProtocolMagic Int32
764824073

-- | Derive testnet magic from a type-level Nat
testnetMagic :: forall pm. KnownNat pm => ProtocolMagic
testnetMagic :: ProtocolMagic
testnetMagic = Int32 -> ProtocolMagic
ProtocolMagic (Int32 -> ProtocolMagic) -> Int32 -> ProtocolMagic
forall a b. (a -> b) -> a -> b
$ Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> Integer -> Int32
forall a b. (a -> b) -> a -> b
$ Proxy pm -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy pm -> Integer) -> Proxy pm -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy pm
forall k (t :: k). Proxy t
Proxy @pm