From 2098bc58af00cd1c616bb9c45f20150b278f0b72 Mon Sep 17 00:00:00 2001
From: Marcin Szamotulski <profunctor@pm.me>
Date: Wed, 3 Jun 2020 09:41:24 +0200
Subject: [PATCH] Versions: mapWithVersion

ouroboros-consensus will use `Versions` which contain only hot peer
protocols (without warm protocols).  To preserve this interface,
we can  use `mapWithVersions` to add warm peer protocols.  This will be
only useful for warm peer applications which do not need to consult
version data, otherwise we will need to push warm peer protocols down to
consensus.
---
 .../Network/Protocol/Handshake/Version.hs       | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Version.hs b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Version.hs
index 181cda2c419..320389acf55 100644
--- a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Version.hs
+++ b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Version.hs
@@ -23,6 +23,7 @@ module Ouroboros.Network.Protocol.Handshake.Version
   , simpleSingletonVersions
   , foldMapVersions
   , combineVersions
+  , mapWithVersion
   ) where
 
 import           Data.Foldable (toList)
@@ -70,6 +71,22 @@ instance Functor (Versions vNum extra) where
       where
         fmapSigma (Sigma t (Version (Application app) extra)) = Sigma t (Version (Application $ \x y -> f (app x y)) extra)
 
+
+mapWithVersion
+    :: forall vNum extra a b.
+       (vNum -> a -> b)
+    -> Versions vNum extra a
+    -> Versions vNum extra b
+mapWithVersion f (Versions vs) = Versions $ Map.mapWithKey g vs
+  where
+    g :: vNum -> Sigma (Version extra a) -> Sigma (Version extra b)
+    g vNum (Sigma vData (Version (Application app) extra)) =
+      Sigma vData
+            (Version
+              (Application $ \vData' vData'' -> f vNum (app vData' vData''))
+              extra)
+
+
 data Sigma f where
   Sigma :: !t -> !(f t) -> Sigma f