simulation: Add To/FromJSON for P2P

simulation/src/P2P.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
@@ -7,6 +8,7 @@ module P2P where
 import Control.Monad (when)
 import Control.Monad.Class.MonadTime.SI (DiffTime)
 import Control.Monad.ST (ST)
+import Data.Aeson.Types (FromJSON, ToJSON (..), defaultOptions, genericToEncoding)
 import Data.Array.ST as Array (
   Ix (range),
   MArray (newArray),
@@ -21,17 +23,22 @@ import qualified Data.KdMap.Static as KdMap
 import Data.List (mapAccumL, sort, unfoldr)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import GHC.Generics (Generic)
+import SimTypes (NodeId (..), Point (..), WorldShape (..))
 import System.Random (StdGen)
 import qualified System.Random as Random
 
-import SimTypes (NodeId (..), Point (..), WorldShape (..))
-
 data P2PTopography = P2PTopography
   { p2pNodes :: !(Map NodeId Point)
   , p2pLinks :: !(Map (NodeId, NodeId) Latency)
   , p2pWorldShape :: !WorldShape
   }
-  deriving (Show)
+  deriving (Show, Generic)
+
+instance ToJSON P2PTopography where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON P2PTopography
 
 type Latency =
   -- | Double rather than DiffTime for efficiency
@@ -41,13 +48,19 @@ data P2PTopographyCharacteristics = P2PTopographyCharacteristics
   { p2pWorldShape :: !WorldShape
   -- ^ Size of the world (in seconds): (Circumference, pole-to-pole)
   , -- \^ Number of nodes, e.g. 100, 1000, 10,000
+
     p2pNumNodes :: Int
   -- ^ Per-node upstream links picked as close peers, e.g. 5 of 10 total
   , p2pNodeLinksClose :: Int
   -- ^ Per-node upstream links picked as random peers, e.g. 5 of 10 total
   , p2pNodeLinksRandom :: Int
   }
-  deriving (Show)
+  deriving (Show, Generic)
+
+instance ToJSON P2PTopographyCharacteristics where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON P2PTopographyCharacteristics
 
 -- | Strategy for creating an arbitrary P2P network:
 --

simulation/src/PraosProtocol/ExamplesPraosP2P.hs

@@ -9,14 +9,12 @@
 
 module PraosProtocol.ExamplesPraosP2P where
 
+import ChanDriver
 import Data.Aeson
 import qualified Data.ByteString.Char8 as BS8
+import Data.Coerce (coerce)
 import Data.Functor.Contravariant (Contravariant (contramap))
 import qualified Data.Map.Strict as Map
-import System.Random (StdGen, mkStdGen)
-
-import ChanDriver
-import Data.Coerce (coerce)
 import GHC.Generics
 import Network.TypedProtocol
 import P2P (P2PTopography (p2pNodes), P2PTopographyCharacteristics (..), genArbitraryP2PTopography)
@@ -32,6 +30,7 @@ import PraosProtocol.VizSimPraosP2P
 import Sample
 import SimTCPLinks (mkTcpConnProps)
 import SimTypes
+import System.Random (StdGen, mkStdGen)
 import Viz
 
 example1 :: Vizualisation
@@ -96,7 +95,7 @@ data LatencyPerStake = LatencyPerStake
   deriving (Generic, ToJSON, FromJSON)
 
 data DiffusionData = DiffusionData
-  { topography :: String
+  { topography :: P2PTopographyCharacteristics
   , entries :: [DiffusionEntry]
   , latency_per_stake :: [LatencyPerStake]
   }
@@ -129,7 +128,7 @@ diffusionSampleModel p2pTopographyCharacteristics fp = SampleModel Map.empty acc
 
     encodeFile fp $
       DiffusionData
-        { topography = show p2pTopographyCharacteristics
+        { topography = p2pTopographyCharacteristics
         , entries
         , latency_per_stake = map (diffusionEntryToLatencyPerStake nnodes) entries
         }

simulation/src/SimTypes.hs

@@ -1,15 +1,29 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module SimTypes where
 
+import Data.Aeson.Types (FromJSON, FromJSONKey, ToJSON (..), ToJSONKey, defaultOptions, genericToEncoding)
 import Data.Ix (Ix)
+import GHC.Generics (Generic)
 
 newtype NodeId = NodeId Int
   deriving (Eq, Ord, Ix, Show)
+  deriving newtype (ToJSON, FromJSON, ToJSONKey, FromJSONKey)
 
 data LabelNode e = LabelNode NodeId e deriving (Show)
+
 data LabelLink e = LabelLink NodeId NodeId e deriving (Show)
 
 -- | Position in simulation world coordinates
-data Point = Point !Double !Double deriving (Show)
+data Point = Point !Double !Double
+  deriving (Show, Generic)
+
+instance ToJSON Point where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON Point
 
 data WorldShape = WorldShape
   { worldDimensions :: !(Double, Double)
@@ -20,4 +34,9 @@ data WorldShape = WorldShape
   -- to the West edge, or if the world is a rectangle, with no wrapping at
   -- the edges. This affects the latencies.
   }
-  deriving (Show)
+  deriving (Show, Generic)
+
+instance ToJSON WorldShape where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON WorldShape