From cea8a22e1bb9f0e05706d4bb7f1489e3dc1d483d Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Fri, 20 Jan 2023 07:10:12 +0300
Subject: [PATCH] wip

---
 hbs2-core/lib/HBS2/Net/Proto/Types.hs | 18 ++++++++++++++++++
 hbs2-tests/test/Main.hs               |  6 ++++--
 2 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Net/Proto/Types.hs b/hbs2-core/lib/HBS2/Net/Proto/Types.hs
index 7a35ae9c..8a5ed0dc 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/Types.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Types.hs
@@ -37,6 +37,24 @@ class Request e p (m :: Type -> Type) | p -> e where
   request :: Peer e -> p -> m ()
 
 
+data family SessionKey  p :: Type
+data family SessionData p :: Type
+
+class ( Monad m
+      , HasProtocol e p
+      , Eq (SessionKey p)
+      ) => Sessions e p m | p -> e where
+
+  fetch  :: SessionData p          -- ^ default value in case it's not found
+         -> SessionKey p           -- ^ session key
+         -> (SessionData p -> a )  -- ^ modification function, i.e. lens
+         -> m a
+
+  update :: SessionKey p                      -- ^ session key
+         -> (SessionData p -> SessionData p)  -- ^ modification function, i.e. lens
+         -> m ()
+
+
 class (KnownNat (ProtocolId p), HasPeer e) => HasProtocol e p | p -> e  where
   type family ProtocolId p = (id :: Nat) | id -> p
   type family Encoded e :: Type
diff --git a/hbs2-tests/test/Main.hs b/hbs2-tests/test/Main.hs
index a8914d4d..c80efd49 100644
--- a/hbs2-tests/test/Main.hs
+++ b/hbs2-tests/test/Main.hs
@@ -67,7 +67,7 @@ data BlockDownload m =
   , _sOnBlockReady   :: OnBlockReady HbSync m
   }
 
-data Sessions e m =
+data MySessions e m =
   Sessions
   { _sBlockDownload  :: Cache (Peer e, Cookie e) (BlockDownload m)
   , _sBlockSizes     :: Cache (Hash HbSync) (Map (Peer e) Size)
@@ -123,7 +123,7 @@ main = do
   --     ]
 
 
-emptySessions :: forall e m . MonadIO m => m (Sessions e m)
+emptySessions :: forall e m . MonadIO m => m (MySessions e m)
 emptySessions = liftIO $
   Sessions <$> Cache.newCache (Just defCookieTimeout)
            <*> Cache.newCache (Just defBlockInfoTimeout)
@@ -316,6 +316,8 @@ test1 = do
 
         let h = fromString "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ"
 
+        -- updateSession cookie (id)
+        -- se <- getSession cookie (lens)
         -- cookie <- newSession ???
 
         -- newCookie <- genCookie @Fake (p1, h) -- <<~~~ FIXME: generate a good session id!