{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Crypto.ProtocolMagic
  ( ProtocolMagicId (..),
    ProtocolMagic,
    AProtocolMagic (..),
    RequiresNetworkMagic (..),
    getProtocolMagic,
    getProtocolMagicId,
  )
where

import Cardano.Binary
  ( Annotated (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeTag,
    encodeTag,
  )
import Cardano.Prelude
import Control.Monad.Fail (fail)
import Data.Aeson ((.:), (.=))
import qualified Data.Aeson as A
import NoThunks.Class (NoThunks)
import Text.JSON.Canonical (FromJSON (..), JSValue (..), ToJSON (..), expected)

-- | Magic number which should differ for different clusters. It's
--   defined here, because it's used for signing. It also used for other
--   things (e. g. it's part of a serialized block).
--
-- mhueschen: As part of CO-353 I am adding `getRequiresNetworkMagic` in
-- order to pipe configuration to functions which must generate & verify
-- Addresses (which now must be aware of `NetworkMagic`).
data AProtocolMagic a = AProtocolMagic
  { AProtocolMagic a -> Annotated ProtocolMagicId a
getAProtocolMagicId :: !(Annotated ProtocolMagicId a),
    AProtocolMagic a -> RequiresNetworkMagic
getRequiresNetworkMagic :: !RequiresNetworkMagic
  }
  deriving (AProtocolMagic a -> AProtocolMagic a -> Bool
(AProtocolMagic a -> AProtocolMagic a -> Bool)
-> (AProtocolMagic a -> AProtocolMagic a -> Bool)
-> Eq (AProtocolMagic a)
forall a. Eq a => AProtocolMagic a -> AProtocolMagic a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AProtocolMagic a -> AProtocolMagic a -> Bool
$c/= :: forall a. Eq a => AProtocolMagic a -> AProtocolMagic a -> Bool
== :: AProtocolMagic a -> AProtocolMagic a -> Bool
$c== :: forall a. Eq a => AProtocolMagic a -> AProtocolMagic a -> Bool
Eq, Int -> AProtocolMagic a -> ShowS
[AProtocolMagic a] -> ShowS
AProtocolMagic a -> String
(Int -> AProtocolMagic a -> ShowS)
-> (AProtocolMagic a -> String)
-> ([AProtocolMagic a] -> ShowS)
-> Show (AProtocolMagic a)
forall a. Show a => Int -> AProtocolMagic a -> ShowS
forall a. Show a => [AProtocolMagic a] -> ShowS
forall a. Show a => AProtocolMagic a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AProtocolMagic a] -> ShowS
$cshowList :: forall a. Show a => [AProtocolMagic a] -> ShowS
show :: AProtocolMagic a -> String
$cshow :: forall a. Show a => AProtocolMagic a -> String
showsPrec :: Int -> AProtocolMagic a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AProtocolMagic a -> ShowS
Show, (forall x. AProtocolMagic a -> Rep (AProtocolMagic a) x)
-> (forall x. Rep (AProtocolMagic a) x -> AProtocolMagic a)
-> Generic (AProtocolMagic a)
forall x. Rep (AProtocolMagic a) x -> AProtocolMagic a
forall x. AProtocolMagic a -> Rep (AProtocolMagic a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AProtocolMagic a) x -> AProtocolMagic a
forall a x. AProtocolMagic a -> Rep (AProtocolMagic a) x
$cto :: forall a x. Rep (AProtocolMagic a) x -> AProtocolMagic a
$cfrom :: forall a x. AProtocolMagic a -> Rep (AProtocolMagic a) x
Generic, AProtocolMagic a -> ()
(AProtocolMagic a -> ()) -> NFData (AProtocolMagic a)
forall a. NFData a => AProtocolMagic a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AProtocolMagic a -> ()
$crnf :: forall a. NFData a => AProtocolMagic a -> ()
NFData, Context -> AProtocolMagic a -> IO (Maybe ThunkInfo)
Proxy (AProtocolMagic a) -> String
(Context -> AProtocolMagic a -> IO (Maybe ThunkInfo))
-> (Context -> AProtocolMagic a -> IO (Maybe ThunkInfo))
-> (Proxy (AProtocolMagic a) -> String)
-> NoThunks (AProtocolMagic a)
forall a.
NoThunks a =>
Context -> AProtocolMagic a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (AProtocolMagic a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (AProtocolMagic a) -> String
$cshowTypeOf :: forall a. NoThunks a => Proxy (AProtocolMagic a) -> String
wNoThunks :: Context -> AProtocolMagic a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> AProtocolMagic a -> IO (Maybe ThunkInfo)
noThunks :: Context -> AProtocolMagic a -> IO (Maybe ThunkInfo)
$cnoThunks :: forall a.
NoThunks a =>
Context -> AProtocolMagic a -> IO (Maybe ThunkInfo)
NoThunks)

type ProtocolMagic = AProtocolMagic ()

newtype ProtocolMagicId = ProtocolMagicId
  { ProtocolMagicId -> Word32
unProtocolMagicId :: Word32
  }
  deriving (Int -> ProtocolMagicId -> ShowS
[ProtocolMagicId] -> ShowS
ProtocolMagicId -> String
(Int -> ProtocolMagicId -> ShowS)
-> (ProtocolMagicId -> String)
-> ([ProtocolMagicId] -> ShowS)
-> Show ProtocolMagicId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolMagicId] -> ShowS
$cshowList :: [ProtocolMagicId] -> ShowS
show :: ProtocolMagicId -> String
$cshow :: ProtocolMagicId -> String
showsPrec :: Int -> ProtocolMagicId -> ShowS
$cshowsPrec :: Int -> ProtocolMagicId -> ShowS
Show, ProtocolMagicId -> ProtocolMagicId -> Bool
(ProtocolMagicId -> ProtocolMagicId -> Bool)
-> (ProtocolMagicId -> ProtocolMagicId -> Bool)
-> Eq ProtocolMagicId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolMagicId -> ProtocolMagicId -> Bool
$c/= :: ProtocolMagicId -> ProtocolMagicId -> Bool
== :: ProtocolMagicId -> ProtocolMagicId -> Bool
$c== :: ProtocolMagicId -> ProtocolMagicId -> Bool
Eq, (forall x. ProtocolMagicId -> Rep ProtocolMagicId x)
-> (forall x. Rep ProtocolMagicId x -> ProtocolMagicId)
-> Generic ProtocolMagicId
forall x. Rep ProtocolMagicId x -> ProtocolMagicId
forall x. ProtocolMagicId -> Rep ProtocolMagicId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolMagicId x -> ProtocolMagicId
$cfrom :: forall x. ProtocolMagicId -> Rep ProtocolMagicId x
Generic)
  deriving newtype (Typeable ProtocolMagicId
Decoder s ProtocolMagicId
Typeable ProtocolMagicId
-> (forall s. Decoder s ProtocolMagicId)
-> (Proxy ProtocolMagicId -> Text)
-> FromCBOR ProtocolMagicId
Proxy ProtocolMagicId -> Text
forall s. Decoder s ProtocolMagicId
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy ProtocolMagicId -> Text
$clabel :: Proxy ProtocolMagicId -> Text
fromCBOR :: Decoder s ProtocolMagicId
$cfromCBOR :: forall s. Decoder s ProtocolMagicId
$cp1FromCBOR :: Typeable ProtocolMagicId
FromCBOR, Typeable ProtocolMagicId
Typeable ProtocolMagicId
-> (ProtocolMagicId -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy ProtocolMagicId -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [ProtocolMagicId] -> Size)
-> ToCBOR ProtocolMagicId
ProtocolMagicId -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ProtocolMagicId] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProtocolMagicId -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ProtocolMagicId] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ProtocolMagicId] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProtocolMagicId -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ProtocolMagicId -> Size
toCBOR :: ProtocolMagicId -> Encoding
$ctoCBOR :: ProtocolMagicId -> Encoding
$cp1ToCBOR :: Typeable ProtocolMagicId
ToCBOR)
  deriving anyclass (ProtocolMagicId -> ()
(ProtocolMagicId -> ()) -> NFData ProtocolMagicId
forall a. (a -> ()) -> NFData a
rnf :: ProtocolMagicId -> ()
$crnf :: ProtocolMagicId -> ()
NFData, Context -> ProtocolMagicId -> IO (Maybe ThunkInfo)
Proxy ProtocolMagicId -> String
(Context -> ProtocolMagicId -> IO (Maybe ThunkInfo))
-> (Context -> ProtocolMagicId -> IO (Maybe ThunkInfo))
-> (Proxy ProtocolMagicId -> String)
-> NoThunks ProtocolMagicId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ProtocolMagicId -> String
$cshowTypeOf :: Proxy ProtocolMagicId -> String
wNoThunks :: Context -> ProtocolMagicId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ProtocolMagicId -> IO (Maybe ThunkInfo)
noThunks :: Context -> ProtocolMagicId -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ProtocolMagicId -> IO (Maybe ThunkInfo)
NoThunks)

instance A.ToJSON ProtocolMagicId where
  toJSON :: ProtocolMagicId -> Value
toJSON = Word32 -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Word32 -> Value)
-> (ProtocolMagicId -> Word32) -> ProtocolMagicId -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolMagicId -> Word32
unProtocolMagicId

instance A.FromJSON ProtocolMagicId where
  parseJSON :: Value -> Parser ProtocolMagicId
parseJSON Value
v = Word32 -> ProtocolMagicId
ProtocolMagicId (Word32 -> ProtocolMagicId)
-> Parser Word32 -> Parser ProtocolMagicId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word32
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v

getProtocolMagicId :: AProtocolMagic a -> ProtocolMagicId
getProtocolMagicId :: AProtocolMagic a -> ProtocolMagicId
getProtocolMagicId = Annotated ProtocolMagicId a -> ProtocolMagicId
forall b a. Annotated b a -> b
unAnnotated (Annotated ProtocolMagicId a -> ProtocolMagicId)
-> (AProtocolMagic a -> Annotated ProtocolMagicId a)
-> AProtocolMagic a
-> ProtocolMagicId
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AProtocolMagic a -> Annotated ProtocolMagicId a
forall a. AProtocolMagic a -> Annotated ProtocolMagicId a
getAProtocolMagicId

-- mhueschen: For backwards-compatibility reasons, I redefine this function
-- in terms of the two record accessors.
getProtocolMagic :: AProtocolMagic a -> Word32
getProtocolMagic :: AProtocolMagic a -> Word32
getProtocolMagic = ProtocolMagicId -> Word32
unProtocolMagicId (ProtocolMagicId -> Word32)
-> (AProtocolMagic a -> ProtocolMagicId)
-> AProtocolMagic a
-> Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AProtocolMagic a -> ProtocolMagicId
forall a. AProtocolMagic a -> ProtocolMagicId
getProtocolMagicId

instance A.ToJSON ProtocolMagic where
  toJSON :: ProtocolMagic -> Value
toJSON (AProtocolMagic (Annotated (ProtocolMagicId Word32
ident) ()) RequiresNetworkMagic
rnm) =
    [Pair] -> Value
A.object [Key
"pm" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32
ident, Key
"requiresNetworkMagic" Key -> RequiresNetworkMagic -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RequiresNetworkMagic
rnm]

instance A.FromJSON ProtocolMagic where
  parseJSON :: Value -> Parser ProtocolMagic
parseJSON = String
-> (Object -> Parser ProtocolMagic)
-> Value
-> Parser ProtocolMagic
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ProtocolMagic" ((Object -> Parser ProtocolMagic) -> Value -> Parser ProtocolMagic)
-> (Object -> Parser ProtocolMagic)
-> Value
-> Parser ProtocolMagic
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Annotated ProtocolMagicId ()
-> RequiresNetworkMagic -> ProtocolMagic
forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
AProtocolMagic
      (Annotated ProtocolMagicId ()
 -> RequiresNetworkMagic -> ProtocolMagic)
-> Parser (Annotated ProtocolMagicId ())
-> Parser (RequiresNetworkMagic -> ProtocolMagic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Annotated ProtocolMagicId ())
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pm"
      Parser (RequiresNetworkMagic -> ProtocolMagic)
-> Parser RequiresNetworkMagic -> Parser ProtocolMagic
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser RequiresNetworkMagic
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requiresNetworkMagic"

-- Canonical JSON instances
instance Monad m => ToJSON m ProtocolMagicId where
  toJSON :: ProtocolMagicId -> m JSValue
toJSON (ProtocolMagicId Word32
ident) = Word32 -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
toJSON Word32
ident

instance MonadError SchemaError m => FromJSON m ProtocolMagicId where
  fromJSON :: JSValue -> m ProtocolMagicId
fromJSON JSValue
v = Word32 -> ProtocolMagicId
ProtocolMagicId (Word32 -> ProtocolMagicId) -> m Word32 -> m ProtocolMagicId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> m Word32
forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
fromJSON JSValue
v

--------------------------------------------------------------------------------
-- RequiresNetworkMagic
--------------------------------------------------------------------------------

-- | Bool-isomorphic flag indicating whether we're on testnet
-- or mainnet/staging.
data RequiresNetworkMagic
  = RequiresNoMagic
  | RequiresMagic
  deriving (Int -> RequiresNetworkMagic -> ShowS
[RequiresNetworkMagic] -> ShowS
RequiresNetworkMagic -> String
(Int -> RequiresNetworkMagic -> ShowS)
-> (RequiresNetworkMagic -> String)
-> ([RequiresNetworkMagic] -> ShowS)
-> Show RequiresNetworkMagic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequiresNetworkMagic] -> ShowS
$cshowList :: [RequiresNetworkMagic] -> ShowS
show :: RequiresNetworkMagic -> String
$cshow :: RequiresNetworkMagic -> String
showsPrec :: Int -> RequiresNetworkMagic -> ShowS
$cshowsPrec :: Int -> RequiresNetworkMagic -> ShowS
Show, RequiresNetworkMagic -> RequiresNetworkMagic -> Bool
(RequiresNetworkMagic -> RequiresNetworkMagic -> Bool)
-> (RequiresNetworkMagic -> RequiresNetworkMagic -> Bool)
-> Eq RequiresNetworkMagic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequiresNetworkMagic -> RequiresNetworkMagic -> Bool
$c/= :: RequiresNetworkMagic -> RequiresNetworkMagic -> Bool
== :: RequiresNetworkMagic -> RequiresNetworkMagic -> Bool
$c== :: RequiresNetworkMagic -> RequiresNetworkMagic -> Bool
Eq, (forall x. RequiresNetworkMagic -> Rep RequiresNetworkMagic x)
-> (forall x. Rep RequiresNetworkMagic x -> RequiresNetworkMagic)
-> Generic RequiresNetworkMagic
forall x. Rep RequiresNetworkMagic x -> RequiresNetworkMagic
forall x. RequiresNetworkMagic -> Rep RequiresNetworkMagic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequiresNetworkMagic x -> RequiresNetworkMagic
$cfrom :: forall x. RequiresNetworkMagic -> Rep RequiresNetworkMagic x
Generic, RequiresNetworkMagic -> ()
(RequiresNetworkMagic -> ()) -> NFData RequiresNetworkMagic
forall a. (a -> ()) -> NFData a
rnf :: RequiresNetworkMagic -> ()
$crnf :: RequiresNetworkMagic -> ()
NFData, Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo)
Proxy RequiresNetworkMagic -> String
(Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo))
-> (Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo))
-> (Proxy RequiresNetworkMagic -> String)
-> NoThunks RequiresNetworkMagic
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy RequiresNetworkMagic -> String
$cshowTypeOf :: Proxy RequiresNetworkMagic -> String
wNoThunks :: Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo)
noThunks :: Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> RequiresNetworkMagic -> IO (Maybe ThunkInfo)
NoThunks)

instance ToCBOR RequiresNetworkMagic where
  toCBOR :: RequiresNetworkMagic -> Encoding
toCBOR = \case
    RequiresNetworkMagic
RequiresNoMagic -> Word -> Encoding
encodeTag Word
0
    RequiresNetworkMagic
RequiresMagic -> Word -> Encoding
encodeTag Word
1

instance FromCBOR RequiresNetworkMagic where
  fromCBOR :: Decoder s RequiresNetworkMagic
fromCBOR =
    Decoder s Word
forall s. Decoder s Word
decodeTag Decoder s Word
-> (Word -> Decoder s RequiresNetworkMagic)
-> Decoder s RequiresNetworkMagic
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word
0 -> RequiresNetworkMagic -> Decoder s RequiresNetworkMagic
forall (m :: * -> *) a. Monad m => a -> m a
return RequiresNetworkMagic
RequiresNoMagic
      Word
1 -> RequiresNetworkMagic -> Decoder s RequiresNetworkMagic
forall (m :: * -> *) a. Monad m => a -> m a
return RequiresNetworkMagic
RequiresMagic
      Word
tag -> String -> Decoder s RequiresNetworkMagic
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s RequiresNetworkMagic)
-> String -> Decoder s RequiresNetworkMagic
forall a b. (a -> b) -> a -> b
$ String
"RequiresNetworkMagic: unknown tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
tag

-- Aeson JSON instances
-- N.B @RequiresNetworkMagic@'s ToJSON & FromJSON instances do not round-trip.
-- They should only be used from a parent instance which handles the
-- `requiresNetworkMagic` key.
instance A.ToJSON RequiresNetworkMagic where
  toJSON :: RequiresNetworkMagic -> Value
toJSON RequiresNetworkMagic
RequiresNoMagic = Text -> Value
A.String Text
"RequiresNoMagic"
  toJSON RequiresNetworkMagic
RequiresMagic = Text -> Value
A.String Text
"RequiresMagic"

instance A.FromJSON RequiresNetworkMagic where
  parseJSON :: Value -> Parser RequiresNetworkMagic
parseJSON =
    String
-> (Text -> Parser RequiresNetworkMagic)
-> Value
-> Parser RequiresNetworkMagic
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"requiresNetworkMagic" ((Text -> Parser RequiresNetworkMagic)
 -> Value -> Parser RequiresNetworkMagic)
-> (Text -> Parser RequiresNetworkMagic)
-> Value
-> Parser RequiresNetworkMagic
forall a b. (a -> b) -> a -> b
$
      Either Text RequiresNetworkMagic -> Parser RequiresNetworkMagic
forall e a. Buildable e => Either e a -> Parser a
toAesonError (Either Text RequiresNetworkMagic -> Parser RequiresNetworkMagic)
-> (Text -> Either Text RequiresNetworkMagic)
-> Text
-> Parser RequiresNetworkMagic
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. \case
        Text
"RequiresNoMagic" -> RequiresNetworkMagic -> Either Text RequiresNetworkMagic
forall a b. b -> Either a b
Right RequiresNetworkMagic
RequiresNoMagic
        Text
"RequiresMagic" -> RequiresNetworkMagic -> Either Text RequiresNetworkMagic
forall a b. b -> Either a b
Right RequiresNetworkMagic
RequiresMagic
        Text
"NMMustBeNothing" -> RequiresNetworkMagic -> Either Text RequiresNetworkMagic
forall a b. b -> Either a b
Right RequiresNetworkMagic
RequiresNoMagic
        Text
"NMMustBeJust" -> RequiresNetworkMagic -> Either Text RequiresNetworkMagic
forall a b. b -> Either a b
Right RequiresNetworkMagic
RequiresMagic
        Text
other ->
          Text -> Either Text RequiresNetworkMagic
forall a b. a -> Either a b
Left
            ( Text
"invalid value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
other
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", acceptable values are RequiresNoMagic | RequiresMagic"
            )

-- Canonical JSON instances
instance Monad m => ToJSON m RequiresNetworkMagic where
  toJSON :: RequiresNetworkMagic -> m JSValue
toJSON RequiresNetworkMagic
RequiresNoMagic = JSValue -> m JSValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSString -> JSValue
JSString JSString
"RequiresNoMagic")
  toJSON RequiresNetworkMagic
RequiresMagic = JSValue -> m JSValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSString -> JSValue
JSString JSString
"RequiresMagic")

instance MonadError SchemaError m => FromJSON m RequiresNetworkMagic where
  fromJSON :: JSValue -> m RequiresNetworkMagic
fromJSON = \case
    JSString JSString
"RequiresNoMagic" -> RequiresNetworkMagic -> m RequiresNetworkMagic
forall (f :: * -> *) a. Applicative f => a -> f a
pure RequiresNetworkMagic
RequiresNoMagic
    JSString JSString
"RequiresMagic" -> RequiresNetworkMagic -> m RequiresNetworkMagic
forall (f :: * -> *) a. Applicative f => a -> f a
pure RequiresNetworkMagic
RequiresMagic
    JSValue
other ->
      String -> Maybe String -> m RequiresNetworkMagic
forall (m :: * -> *) a.
ReportSchemaErrors m =>
String -> Maybe String -> m a
expected String
"RequiresNoMagic | RequiresMagic" (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ JSValue -> String
forall a b. (Show a, ConvertText String b) => a -> b
show JSValue
other)