wip

hbs2-storage-simple/lib/HBS2/Storage/Simple.hs

@@ -1,13 +1,14 @@
 {-# Language TemplateHaskell #-}
 {-# Language ScopedTypeVariables #-}
-module HBS2.Storage.Simple where
+module HBS2.Storage.Simple
+  ( module HBS2.Storage.Simple
+  , module HBS2.Storage
+  ) where
 
-import Control.Concurrent
 import Control.Concurrent.Async
 import Control.Exception
 import Control.Monad
 import Control.Monad.Except
-import Control.Monad.IO.Class
 import Control.Monad.Trans.Maybe
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString qualified as BS
@@ -26,16 +27,13 @@ import System.IO.Error
 
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TBQueue qualified as TBQ
-import Control.Concurrent.STM.TBQueue (TBQueue)
 import Control.Concurrent.STM.TBMQueue qualified as TBMQ
 import Control.Concurrent.STM.TBMQueue (TBMQueue)
-import Control.Concurrent.STM.TVar (TVar)
 import Control.Concurrent.STM.TVar qualified as TV
 
 
 import HBS2.Clock
 import HBS2.Hash
-import HBS2.Prelude
 import HBS2.Prelude.Plated
 import HBS2.Storage
 

hbs2-tests/hbs2-tests.cabal

@@ -76,6 +76,8 @@ test-suite test
         , bytestring
         , cache
         , containers
+        , directory
+        , filepath
         , hashable
         , microlens-platform
         , mtl

hbs2-tests/test/Main.hs

@@ -1,10 +1,42 @@
 module Main where
 
+import HBS2.Prelude
+import HBS2.Hash
+import HBS2.Net.Proto
+import HBS2.Net.Messaging
+import HBS2.Storage.Simple
+
 import Test.Tasty
 import Test.Tasty.HUnit
 
+import Control.Concurrent.Async
+import Data.Hashable
+import Data.Word
+import Prettyprinter
+import System.Directory
+import System.FilePath.Posix
+import System.IO
+
+
+data Fake
+
+instance HasPeer Fake where
+  newtype instance Peer Fake = FakePeer Word8
+                               deriving newtype (Hashable,Num,Enum)
+                               deriving stock (Eq,Ord,Show)
+
+
+instance Pretty (Peer Fake) where
+  pretty (FakePeer n) = parens ("peer" <+> pretty n)
+
+debug :: (MonadIO m) => Doc ann -> m ()
+debug p = liftIO $ hPrint stderr p
+
+
 main :: IO ()
-main =
+main = do
+  hSetBuffering stderr LineBuffering
+
   defaultMain $
     testGroup "root"
       [
@@ -12,6 +44,32 @@ main =
       ]
 
 
+runFakePeer :: Peer Fake -> IO ()
+runFakePeer p = do
+
+  let pid = fromIntegral (hash p) :: Word8
+
+  debug $ "I'm" <+> pretty p <+> pretty pid
+
+  dir <- canonicalizePath ( ".peers" </> show pid)
+
+  createDirectoryIfMissing True dir
+
+  let opts = [ StoragePrefix dir
+             ]
+
+  storage <- simpleStorageInit opts :: IO (SimpleStorage HbSync)
+
+
+  pure ()
+
 test1 :: IO ()
 test1 = do
-  pure ()
+
+  let peers = [0..3] :: [Peer Fake]
+
+  peerz <- mapM (async . runFakePeer) peers
+
+  void $ waitAnyCatchCancel peerz
+
+