wip

hbs2-core/hbs2-core.cabal

@@ -71,6 +71,7 @@ library
                     , HBS2.Data.Types
                     , HBS2.Data.Types.Refs
                     , HBS2.Defaults
+                    , HBS2.Events
                     , HBS2.Hash
                     , HBS2.Merkle
                     , HBS2.Net.Messaging

hbs2-core/lib/HBS2/Events.hs

@@ -0,0 +1,38 @@
+{-# Language FunctionalDependencies #-}
+module HBS2.Events where
+
+import Data.Kind
+
+
+-- General Events class.
+--
+-- It's may be way too general.
+--
+-- e is an 'engine' or 'program' or whatever.
+-- If we will not introduce 'e' type,
+-- there will be only one type of event
+-- per "protocol" (a ) or a any concrete type per program.
+--
+-- Assume we need different type of event for testing
+-- purposes and for production or so on.
+--
+-- For this situation we introduce 'e', that
+-- allow us to do so.
+--
+-- In our case, e corresponds to an 'engine' that is
+-- a concrete network fabrique implementations (UDP, TCP, whatever)
+-- that could be implemented with 'e'.
+--
+-- And 'a' is corresponding to a concrete sub-protocol.
+--
+-- I suspect that 'e' has a global meaning and
+-- represent an 'interpreter'.
+
+class Monad m => HasEvents e a m | a -> e where
+
+  data family EventKey e a :: Type
+  type family Event e a    :: Type
+
+  subscribe  :: EventKey e a -> Event e a -> m ()
+
+

hbs2-core/lib/HBS2/Net/Proto/Sessions.hs

@@ -28,17 +28,6 @@ instance Eq SKey where
   (==) (SKey p1 a) (SKey p2 b) = unKey p1 a == unKey p1 b
 
 
--- we probably can not separate sessions
--- by sub-protocol types without
--- really crazy types.
---
--- And if we really need this, it may be done
--- by injecting a protocol type into 'e' or
--- introducing a common ADT for all session types
--- for common 'e' i.e. 'engine' or 'transport'
---
--- So it is that it is.
-
 data family SessionKey  e p :: Type
 type family SessionData e p :: Type
 
@@ -52,8 +41,9 @@ class ( Monad m
 
 
 
-  -- | Session fetch function.
-  -- | It will insert a new session, if default value is Just something.
+  -- | Session find function.
+  -- | It is useful when we want to check if session even
+  -- | exists and it will not start a new session.
 
   find :: SessionKey e p           -- ^ session key
        -> (SessionData e p -> a)  -- ^ modification function, i.e. lens

hbs2-tests/test/Peer2Main.hs

@@ -7,6 +7,7 @@ module Main where
 import HBS2.Actors.ChunkWriter
 import HBS2.Actors.Peer
 import HBS2.Clock
+import HBS2.Events
 import HBS2.Hash
 import HBS2.Net.Messaging.Fake
 import HBS2.Net.Proto
@@ -144,13 +145,24 @@ handleBlockInfo (p, h, sz') = do
     -- lift $ runEngineM env $ emitBlockSizeEvent ev h (p, h, Just sz) -- TODO: fix this crazy shit
 
 
+instance HasEvents Fake (BlockSize Fake) (PeerM Fake IO) where
+  data instance EventKey Fake (BlockSize Fake) = BlockSizeEvent ()
+  type instance Event Fake (BlockSize Fake) = ()
+
+  subscribe = undefined
+
 blockDownloadLoop :: forall e . ( HasProtocol e (BlockSize e)
                                 , Request e (BlockSize e) (PeerM e IO)
+                                , HasEvents e (BlockSize e) (PeerM e IO)
                                 , Num (Peer e)
                                 ) =>  PeerM e IO ()
 blockDownloadLoop = do
 
   -- w <- subscribe ???
+  --
+
+  -- subscribe @(GetBlockSize e) $ \(p,h,i) -> do
+  --   debug "WE GOT BLOCK!"
 
   request 1 (GetBlockSize @e "5KP4vM6RuEX6RA1ywthBMqZV5UJDLANC17UrF6zuWdRt")
   request 1 (GetBlockSize @e "81JeD7LNR6Q7RYfyWBxfjJn1RsWzvegkUXae6FUNgrMZ")