diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Test.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Test.hs
index 8c246d08c01..0d7cba538e5 100644
--- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Test.hs
+++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Test.hs
@@ -17,7 +17,7 @@ import Data.Typeable (Typeable)
import Data.Dynamic (fromDynamic)
import Data.Maybe (listToMaybe)
import qualified Data.ByteString.Char8 as BS
-import Data.List (nub, groupBy)
+import Data.List (nub, groupBy, intercalate)
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Map.Strict as Map
@@ -1081,3 +1081,162 @@ _governorFindingPublicRoots targetNumberOfRootPeers domains =
pickTrivially :: Applicative m => Map IPv4 a -> Int -> m (Set IPv4)
pickTrivially m n = pure . Set.take n . Map.keysSet $ m
+
+--
+-- Visualisation of examples
+--
+
+-- | Graph visualisation tool, see
+--
+-- It's not designed for general graphs, just file hierarchies, but it's got
+-- a very convenient input format, so not much effort to visualise.
+--
+_gourceVisualisationScript :: GovernorMockEnvironment -> String
+_gourceVisualisationScript =
+ renderGourceScript
+ . toGourceScript Map.empty
+ . visualisationTrace
+
+visualisationTrace :: GovernorMockEnvironment
+ -> [(Time, TracePeerSelection PeerAddr)]
+visualisationTrace =
+ takeFirstNHours 24
+ . selectGovernorEvents
+ . selectPeerSelectionTraceEvents
+ . runGovernorInMockEnvironment
+
+toGourceScript :: Map PeerAddr (PeerSource, [PeerAddr])
+ -> [(Time, TracePeerSelection PeerAddr)]
+ -> [GourceEntry]
+toGourceScript peers ((ts, TraceLocalRootPeersChanged _ new):trace) =
+ -- link new root peers directly to the root as cold
+ [ GourceEntry {
+ timestamp = ts,
+ path = peeraddr : [],
+ modtype = NodeAdded,
+ username = "local root"
+ }
+ | peeraddr <- Map.keys new ]
+ ++ toGourceScript peers' trace
+ where
+ peers' = Map.fromList
+ [ (peeraddr, (PeerSourceLocalRoot, []))
+ | peeraddr <- Map.keys new ]
+ <> peers
+
+toGourceScript peers ((ts, TracePublicRootsRequest _ _):trace) =
+ GourceEntry {
+ timestamp = ts,
+ path = [],
+ modtype = NodeModified,
+ username = "public roots request"
+ }
+ : toGourceScript peers trace
+
+toGourceScript peers ((ts, TracePublicRootsResults new _ _):trace) =
+ -- link new root peers directly to the root as cold
+ [ GourceEntry {
+ timestamp = ts,
+ path = peeraddr : [],
+ modtype = NodeAdded,
+ username = "public root"
+ }
+ | peeraddr <- Set.elems new
+ , peeraddr `Map.notMember` peers
+ ]
+ ++ toGourceScript peers' trace
+ where
+ peers' = Map.fromList
+ [ (peeraddr, (PeerSourcePublicRoot, []))
+ | peeraddr <- Set.elems new
+ , peeraddr `Map.notMember` peers
+ ]
+ <> peers
+
+toGourceScript peers ((ts, TraceGossipRequests _ _ _ gossip):trace) =
+ [ GourceEntry {
+ timestamp = ts,
+ path = discoverypath,
+ modtype = NodeModified,
+ username = "gossip"
+ }
+ | peeraddr <- Set.elems gossip
+ , let Just (_, discoverypath) = Map.lookup peeraddr peers ]
+ ++ toGourceScript peers trace
+
+toGourceScript peers ((ts, TraceGossipResults results):trace) =
+ [ GourceEntry {
+ timestamp = ts,
+ path = dstaddr : snd (peers Map.! srcaddr),
+ modtype = NodeAdded,
+ username = "discovered"
+ }
+ | (srcaddr, Right dstaddrs) <- results
+ , dstaddr <- dstaddrs
+ , dstaddr `Map.notMember` peers
+ ]
+ ++ toGourceScript peers' trace
+ where
+ peers' = Map.fromList
+ [ (dstaddr, (PeerSourceGossip, dstaddr : discoverypath))
+ | (srcaddr, Right dstaddrs) <- results
+ , dstaddr <- dstaddrs
+ , dstaddr `Map.notMember` peers
+ , let Just (_, discoverypath) = Map.lookup srcaddr peers ]
+ <> peers
+
+
+toGourceScript peers (_:trace) = toGourceScript peers trace
+toGourceScript _ [] = []
+
+-- | See
+--
+-- * timestamp - A unix timestamp of when the update occured.
+-- * username - The name of the user who made the update.
+-- * type - initial for the update type - (A)dded, (M)odified or (D)eleted.
+-- * file - Path of the file updated.
+-- * colour - A colour for the file in hex (FFFFFF) format. Optional.
+--
+data GourceEntry = GourceEntry {
+ timestamp :: Time,
+ path :: [PeerAddr],
+ modtype :: NodeModification,
+ username :: String
+-- colour :: Colour
+ }
+
+data NodeModification = NodeAdded | NodeModified | NodeDeleted
+
+--data Colour = ColourLocalRoot
+-- | ColourPublicRoot
+
+renderGourceScript :: [GourceEntry] -> String
+renderGourceScript = unlines . map renderGourceEntry
+
+renderGourceEntry :: GourceEntry -> String
+renderGourceEntry GourceEntry {
+ timestamp,
+ path,
+ modtype,
+ username
+-- colour
+ } =
+ intercalate "|"
+ [ renderTime timestamp
+ , username
+ , renderModType modtype
+ , intercalate "/" ("root" : [ show addr | PeerAddr addr <- reverse path ])
+ ++ ".node"
+-- , renderColour colour
+ ]
+ where
+ renderTime :: Time -> String
+ renderTime t = show (floor (diffTime t (Time 0)) :: Int)
+
+ renderModType NodeAdded = "A"
+ renderModType NodeModified = "M"
+ renderModType NodeDeleted = "D"
+
+-- renderColour ColourLocalRoot = "FFFFFF"
+-- renderColour ColourPublicRoot = "FFFF00"
+