Implement --full-log-replay

pkg/king/app/CLI.hs

@@ -14,16 +14,17 @@ import System.Environment (getProgName)
 --------------------------------------------------------------------------------
 
 data Opts = Opts
-    { oQuiet     :: Bool
-    , oHashless  :: Bool
-    , oExit      :: Bool
-    , oDryRun    :: Bool
-    , oVerbose   :: Bool
-    , oAmesPort  :: Maybe Word16
-    , oTrace     :: Bool
-    , oCollectFx :: Bool
-    , oLocalhost :: Bool
-    , oOffline   :: Bool
+    { oQuiet      :: Bool
+    , oHashless   :: Bool
+    , oExit       :: Bool
+    , oDryRun     :: Bool
+    , oVerbose    :: Bool
+    , oAmesPort   :: Maybe Word16
+    , oTrace      :: Bool
+    , oCollectFx  :: Bool
+    , oLocalhost  :: Bool
+    , oOffline    :: Bool
+    , oFullReplay :: Bool
     }
   deriving (Show)
 
@@ -252,6 +253,10 @@ opts = do
                         <> help "Run without any networking"
                         <> hidden
 
+    oFullReplay <- switch
+          $ long "full-log-replay"
+         <> help "Ignores the snapshot and recomputes state from log"
+
     pure (Opts{..})
 
 newShip :: Parser Cmd

pkg/king/app/Main.hs

@@ -169,9 +169,24 @@ runOrExitImmediately getPier oExit =
         runRAcquire $ Pier.pier sls
 
 tryPlayShip :: (HasPierConfig e, HasLogFunc e)
-            => Bool -> Serf.Flags -> RIO e ()
-tryPlayShip oExit flags = runOrExitImmediately resumeShip oExit
+            => Bool -> Bool -> Serf.Flags -> RIO e ()
+tryPlayShip exitImmediately fullReplay flags =
+  do
+    when fullReplay $ do
+      wipeSnapshot
+    runOrExitImmediately resumeShip exitImmediately
   where
+    wipeSnapshot = do
+        shipPath <- getPierPath
+        logTrace "wipeSnapshot"
+        logDebug $ display $ pack @Text ("Wiping " <> north shipPath)
+        logDebug $ display $ pack @Text ("Wiping " <> south shipPath)
+        removeFileIfExists (north shipPath)
+        removeFileIfExists (south shipPath)
+
+    north shipPath = shipPath <> "/.urb/chk/north.bin"
+    south shipPath = shipPath <> "/.urb/chk/south.bin"
+
     resumeShip = do
         getPierPath >>= lockFile
         rio $ logTrace "RESUMING SHIP"
@@ -187,36 +202,6 @@ runRAcquire :: (MonadUnliftIO (m e),  MonadIO (m e), MonadReader e (m e))
             => RAcquire e a -> m e a
 runRAcquire act = rwith act pure
 
-tryResume :: (HasPierConfig e, HasLogFunc e) => Serf.Flags -> RIO e ()
-tryResume flags = do
-    rwith resumedPier $ \(serf, log, ss) -> do
-        logTrace (displayShow ss)
-        threadDelay 500000
-        ss <- shutdown serf 0
-        logTrace (displayShow ss)
-        logTrace "Resumed!"
-  where
-    resumedPier = do
-        getPierPath >>= lockFile
-        Pier.resumed flags
-
-tryFullReplay :: (HasPierConfig e, HasLogFunc e) => Serf.Flags -> RIO e ()
-tryFullReplay flags = do
-    wipeSnapshot
-    tryResume flags
-  where
-    wipeSnapshot = do
-        shipPath <- getPierPath
-        logTrace "wipeSnapshot"
-        logDebug $ display $ pack @Text ("Wiping " <> north shipPath)
-        logDebug $ display $ pack @Text ("Wiping " <> south shipPath)
-        removeFileIfExists (north shipPath)
-        removeFileIfExists (south shipPath)
-
-    north shipPath = shipPath <> "/.urb/chk/north.bin"
-    south shipPath = shipPath <> "/.urb/chk/south.bin"
-
-
 --------------------------------------------------------------------------------
 
 checkEvs :: forall e. HasLogFunc e => FilePath -> Word64 -> Word64 -> RIO e ()
@@ -432,7 +417,8 @@ newShip CLI.New{..} opts
 runShip :: CLI.Run -> CLI.Opts -> IO ()
 runShip (CLI.Run pierPath) opts = do
     let config = toPierConfig pierPath opts
-    runPierApp config $ tryPlayShip (CLI.oExit opts) (toSerfFlags opts)
+    runPierApp config $
+      tryPlayShip (CLI.oExit opts) (CLI.oFullReplay opts) (toSerfFlags opts)
 
 
 startBrowser :: HasLogFunc e => FilePath -> RIO e ()