wip

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

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!