diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index d2fec6f6..65afd981 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -31,7 +31,8 @@ import HBS2.Net.Proto.Notify import HBS2.Peer.Proto.Mailbox import HBS2.OrDie import HBS2.Storage.Simple -import HBS2.Storage.NCQ3 +-- import HBS2.Storage.NCQ3 +import HBS2.Storage.NCQ import HBS2.Storage.Operations.Missed import HBS2.Data.Detect @@ -785,9 +786,6 @@ runPeer opts = respawnOnError opts $ flip runContT pure do let pref = fromMaybe xdg (view storage opts <|> storConf) - let ncqPath = coerce pref "ncq3" - - debug $ "storage prefix:" <+> pretty ncqPath liftIO $ print $ pretty "debug: " <+> pretty (show debugConf) liftIO $ print $ pretty "trace: " <+> pretty (show traceConf) @@ -824,7 +822,13 @@ runPeer opts = respawnOnError opts $ flip runContT pure do -- error "STOP" - s <- ContT $ ncqWithStorage ncqPath + -- let ncqPath = coerce pref "ncq3" + let ncqPath = coerce pref "ncq" + + debug $ "storage prefix:" <+> pretty ncqPath + + -- s <- ContT $ ncqWithStorage ncqPath + s <- lift $ ncqStorageOpen ncqPath -- simpleStorageInit @HbSync (Just pref) let blk = liftIO . hasBlock s @@ -1364,17 +1368,17 @@ runPeer opts = respawnOnError opts $ flip runContT pure do monkeys <- liftIO $ async $ runMonkeys rpcctx - void $ waitAnyCancel $ w : [ loop - , m1 - , rpcProto - -- , probesMenv - -- , ann - , probesPenv - , proxyThread - , brainsThread - , messWatchDog - , monkeys - ] + void $ waitAnyCancel $ w : [ loop + , m1 + , rpcProto + -- , probesMenv + -- , ann + , probesPenv + , proxyThread + , brainsThread + , messWatchDog + , monkeys + ] -- liftIO $ ncqStorageStop s pause @'Seconds 1 @@ -1395,7 +1399,7 @@ checkMigration prefix = flip runContT pure $ callCC \exit -> do already <- Sy.doesDirectoryExist migration when (L.null blocks && not already) do - checkNCQ1 + -- checkNCQ1 exit () let reason = if already then @@ -1413,14 +1417,14 @@ checkMigration prefix = flip runContT pure $ callCC \exit -> do where - checkNCQ1 = do - let ncq1Dir = prefix "ncq" - ncq1Here <- Sy.doesDirectoryExist ncq1Dir - when ncq1Here do - notice $ yellow "found NCQv1 storage" - notice $ red "Run" <+> "hbs2-peer migrate" <+> pretty prefix - <> line - <> "to migrate the storage to a new version" - notice $ "You may also: backup" <+> pretty ncq1Dir <+> "or move it or remove permanently" - liftIO exitFailure + -- checkNCQ1 = do + -- let ncq1Dir = prefix "ncq" + -- ncq1Here <- Sy.doesDirectoryExist ncq1Dir + -- when ncq1Here do + -- notice $ yellow "found NCQv1 storage" + -- notice $ red "Run" <+> "hbs2-peer migrate" <+> pretty prefix + -- <> line + -- <> "to migrate the storage to a new version" + -- notice $ "You may also: backup" <+> pretty ncq1Dir <+> "or move it or remove permanently" + -- liftIO exitFailure diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs index e6ff48ca..b49212fc 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs @@ -67,6 +67,7 @@ ncqStorageOpen fp upd = do ncqStateKey <- newTVarIO (FileKey maxBound) ncqStateUse <- newTVarIO mempty ncqServiceSem <- atomically $ newTSem 1 + ncqRunSem <- atomically $ newTSem 1 ncqFileLock <- newTVarIO Nothing ncqCurrentFossils <- newTVarIO mempty diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs index b77a1b88..96affe6d 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -32,12 +32,15 @@ ncqStorageStop NCQStorage{..} = do ncqStorageRun :: forall m . MonadUnliftIO m => NCQStorage -> m () -ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do +ncqStorageRun ncq@NCQStorage{..} = withSem ncqRunSem $ flip runContT pure do ContT $ bracket setAlive (const unsetAlive) ContT $ bracket none $ const $ liftIO do readTVarIO ncqFileLock >>= mapM_ FL.unlockFile + ContT $ bracket none $ const $ liftIO do + debug "storage done" + closeQ <- liftIO newTQueueIO closer <- spawnActivity $ liftIO $ fix \loop -> do diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs index 3ed9e8df..c5dcd456 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs @@ -116,6 +116,7 @@ data NCQStorage = , ncqOnRunWriteIdle :: TVar (IO ()) , ncqSyncNo :: TVar Int , ncqServiceSem :: TSem + , ncqRunSem :: TSem , ncqFileLock :: TVar (Maybe FileLock) }