{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.Common.NetworkMagic
  ( NetworkMagic (..),
    makeNetworkMagic,
  )
where

import Cardano.Binary
  ( DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    decodeWord8,
    encodeListLen,
    matchSize,
  )
import Cardano.Crypto.ProtocolMagic
  ( AProtocolMagic (..),
    RequiresNetworkMagic (..),
    getProtocolMagic,
  )
import Cardano.Prelude hiding ((%))
import Data.Aeson (ToJSON)
import Formatting (bprint, build, (%))
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- NetworkMagic
--------------------------------------------------------------------------------

data NetworkMagic
  = NetworkMainOrStage
  | NetworkTestnet {-# UNPACK #-} !Word32
  deriving (Int -> NetworkMagic -> ShowS
[NetworkMagic] -> ShowS
NetworkMagic -> String
(Int -> NetworkMagic -> ShowS)
-> (NetworkMagic -> String)
-> ([NetworkMagic] -> ShowS)
-> Show NetworkMagic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkMagic] -> ShowS
$cshowList :: [NetworkMagic] -> ShowS
show :: NetworkMagic -> String
$cshow :: NetworkMagic -> String
showsPrec :: Int -> NetworkMagic -> ShowS
$cshowsPrec :: Int -> NetworkMagic -> ShowS
Show, NetworkMagic -> NetworkMagic -> Bool
(NetworkMagic -> NetworkMagic -> Bool)
-> (NetworkMagic -> NetworkMagic -> Bool) -> Eq NetworkMagic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkMagic -> NetworkMagic -> Bool
$c/= :: NetworkMagic -> NetworkMagic -> Bool
== :: NetworkMagic -> NetworkMagic -> Bool
$c== :: NetworkMagic -> NetworkMagic -> Bool
Eq, Eq NetworkMagic
Eq NetworkMagic
-> (NetworkMagic -> NetworkMagic -> Ordering)
-> (NetworkMagic -> NetworkMagic -> Bool)
-> (NetworkMagic -> NetworkMagic -> Bool)
-> (NetworkMagic -> NetworkMagic -> Bool)
-> (NetworkMagic -> NetworkMagic -> Bool)
-> (NetworkMagic -> NetworkMagic -> NetworkMagic)
-> (NetworkMagic -> NetworkMagic -> NetworkMagic)
-> Ord NetworkMagic
NetworkMagic -> NetworkMagic -> Bool
NetworkMagic -> NetworkMagic -> Ordering
NetworkMagic -> NetworkMagic -> NetworkMagic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NetworkMagic -> NetworkMagic -> NetworkMagic
$cmin :: NetworkMagic -> NetworkMagic -> NetworkMagic
max :: NetworkMagic -> NetworkMagic -> NetworkMagic
$cmax :: NetworkMagic -> NetworkMagic -> NetworkMagic
>= :: NetworkMagic -> NetworkMagic -> Bool
$c>= :: NetworkMagic -> NetworkMagic -> Bool
> :: NetworkMagic -> NetworkMagic -> Bool
$c> :: NetworkMagic -> NetworkMagic -> Bool
<= :: NetworkMagic -> NetworkMagic -> Bool
$c<= :: NetworkMagic -> NetworkMagic -> Bool
< :: NetworkMagic -> NetworkMagic -> Bool
$c< :: NetworkMagic -> NetworkMagic -> Bool
compare :: NetworkMagic -> NetworkMagic -> Ordering
$ccompare :: NetworkMagic -> NetworkMagic -> Ordering
$cp1Ord :: Eq NetworkMagic
Ord, (forall x. NetworkMagic -> Rep NetworkMagic x)
-> (forall x. Rep NetworkMagic x -> NetworkMagic)
-> Generic NetworkMagic
forall x. Rep NetworkMagic x -> NetworkMagic
forall x. NetworkMagic -> Rep NetworkMagic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NetworkMagic x -> NetworkMagic
$cfrom :: forall x. NetworkMagic -> Rep NetworkMagic x
Generic, NetworkMagic -> ()
(NetworkMagic -> ()) -> NFData NetworkMagic
forall a. (a -> ()) -> NFData a
rnf :: NetworkMagic -> ()
$crnf :: NetworkMagic -> ()
NFData, Context -> NetworkMagic -> IO (Maybe ThunkInfo)
Proxy NetworkMagic -> String
(Context -> NetworkMagic -> IO (Maybe ThunkInfo))
-> (Context -> NetworkMagic -> IO (Maybe ThunkInfo))
-> (Proxy NetworkMagic -> String)
-> NoThunks NetworkMagic
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy NetworkMagic -> String
$cshowTypeOf :: Proxy NetworkMagic -> String
wNoThunks :: Context -> NetworkMagic -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NetworkMagic -> IO (Maybe ThunkInfo)
noThunks :: Context -> NetworkMagic -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> NetworkMagic -> IO (Maybe ThunkInfo)
NoThunks)

instance B.Buildable NetworkMagic where
  build :: NetworkMagic -> Builder
build NetworkMagic
NetworkMainOrStage = Builder
"NetworkMainOrStage"
  build (NetworkTestnet Word32
n) = Format Builder (Word32 -> Builder) -> Word32 -> Builder
forall a. Format Builder a -> a
bprint (Format (Word32 -> Builder) (Word32 -> Builder)
"NetworkTestnet (" Format (Word32 -> Builder) (Word32 -> Builder)
-> Format Builder (Word32 -> Builder)
-> Format Builder (Word32 -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (Word32 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Word32 -> Builder)
-> Format Builder Builder -> Format Builder (Word32 -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder Builder
")") Word32
n

-- Used for debugging purposes only
instance ToJSON NetworkMagic

instance HeapWords NetworkMagic where
  heapWords :: NetworkMagic -> Int
heapWords NetworkMagic
NetworkMainOrStage = Int
0
  heapWords (NetworkTestnet Word32
_) = Int
2

instance ToCBOR NetworkMagic where
  toCBOR :: NetworkMagic -> Encoding
toCBOR = \case
    NetworkMagic
NetworkMainOrStage ->
      Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
0
    NetworkTestnet Word32
n ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word32
n

instance FromCBOR NetworkMagic where
  fromCBOR :: Decoder s NetworkMagic
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"NetworkMagic" Int
1 Int
len Decoder s () -> NetworkMagic -> Decoder s NetworkMagic
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> NetworkMagic
NetworkMainOrStage
      Word8
1 -> Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"NetworkMagic" Int
2 Int
len Decoder s () -> Decoder s NetworkMagic -> Decoder s NetworkMagic
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> NetworkMagic
NetworkTestnet (Word32 -> NetworkMagic)
-> Decoder s Word32 -> Decoder s NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word32
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
_ -> DecoderError -> Decoder s NetworkMagic
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s NetworkMagic)
-> DecoderError -> Decoder s NetworkMagic
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"NetworkMagic" Word8
tag

makeNetworkMagic :: AProtocolMagic a -> NetworkMagic
makeNetworkMagic :: AProtocolMagic a -> NetworkMagic
makeNetworkMagic AProtocolMagic a
pm = case AProtocolMagic a -> RequiresNetworkMagic
forall a. AProtocolMagic a -> RequiresNetworkMagic
getRequiresNetworkMagic AProtocolMagic a
pm of
  RequiresNetworkMagic
RequiresNoMagic -> NetworkMagic
NetworkMainOrStage
  RequiresNetworkMagic
RequiresMagic -> Word32 -> NetworkMagic
NetworkTestnet (AProtocolMagic a -> Word32
forall a. AProtocolMagic a -> Word32
getProtocolMagic AProtocolMagic a
pm)