diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 7f8b9aaf3c..66092ffb69 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -194,9 +194,9 @@ tryBootFromPill oExit pill lite ship boot = do where bootedPier vSlog = do view pierPathL >>= lockFile - rio $ logDebug "Starting boot" + rio $ logInfo "Starting boot" sls <- Pier.booted vSlog pill lite ship boot - rio $ logDebug "Completed boot" + rio $ logInfo "Completed boot" pure sls runOrExitImmediately @@ -210,9 +210,9 @@ runOrExitImmediately vSlog getPier oExit mStart = do where shutdownImmediately :: (Serf, Log.EventLog) -> RIO PierEnv () shutdownImmediately (serf, log) = do - logDebug "Sending shutdown signal" + logInfo "Sending shutdown signal" Serf.stop serf - logDebug "Shutdown!" + logInfo "Shutdown!" runPier :: (Serf, Log.EventLog) -> RIO PierEnv () runPier serfLog = do @@ -231,9 +231,9 @@ tryPlayShip exitImmediately fullReplay playFrom mStart = do where wipeSnapshot = do shipPath <- view pierPathL - logDebug "wipeSnapshot" - logDebug $ display $ pack @Text ("Wiping " <> north shipPath) - logDebug $ display $ pack @Text ("Wiping " <> south shipPath) + logInfo "wipeSnapshot" + logInfo $ display $ pack @Text ("Wiping " <> north shipPath) + logInfo $ display $ pack @Text ("Wiping " <> south shipPath) removeFileIfExists (north shipPath) removeFileIfExists (south shipPath) @@ -243,9 +243,9 @@ tryPlayShip exitImmediately fullReplay playFrom mStart = do resumeShip :: TVar (Text -> IO ()) -> RAcquire PierEnv (Serf, Log.EventLog) resumeShip vSlog = do view pierPathL >>= lockFile - rio $ logDebug "RESUMING SHIP" + rio $ logInfo "RESUMING SHIP" sls <- Pier.resumed vSlog playFrom - rio $ logDebug "SHIP RESUMED" + rio $ logInfo "SHIP RESUMED" pure sls runRAcquire :: (MonadUnliftIO (m e), MonadIO (m e), MonadReader e (m e)) @@ -260,7 +260,7 @@ checkEvs pierPath first last = do rwith (Log.existing logPath) $ \log -> do let ident = Log.identity log let pbSty = PB.defStyle { PB.stylePostfix = PB.exact } - logDebug (displayShow ident) + logInfo (displayShow ident) last <- atomically $ Log.lastEv log <&> \lastReal -> min last lastReal @@ -285,7 +285,7 @@ checkEvs pierPath first last = do showEvents pb eId cycle = await >>= \case Nothing -> do lift $ PB.killProgressBar pb - lift $ logDebug "Everything checks out." + lift $ logInfo "Everything checks out." Just bs -> do lift $ PB.incProgress pb 1 lift $ do @@ -314,10 +314,10 @@ collectAllFx = error "TODO" -} collectAllFx :: FilePath -> RIO KingEnv () collectAllFx top = do - logDebug $ display $ pack @Text top + logInfo $ display $ pack @Text top vSlog <- logSlogs rwith (collectedFX vSlog) $ \() -> - logDebug "Done collecting effects!" + logInfo "Done collecting effects!" where tmpDir :: FilePath tmpDir = top ".tmpdir" @@ -338,10 +338,10 @@ collectAllFx top = do replayPartEvs :: FilePath -> Word64 -> RIO KingEnv () replayPartEvs top last = do - logDebug $ display $ pack @Text top + logInfo $ display $ pack @Text top fetchSnapshot rwith replayedEvs $ \() -> - logDebug "Done replaying events!" + logInfo "Done replaying events!" where fetchSnapshot :: RIO KingEnv () fetchSnapshot = do @@ -384,57 +384,57 @@ replayPartEvs top last = do -} testPill :: HasLogFunc e => FilePath -> Bool -> Bool -> RIO e () testPill pax showPil showSeq = do - logDebug "Reading pill file." + logInfo "Reading pill file." pillBytes <- readFile pax - logDebug "Cueing pill file." + logInfo "Cueing pill file." pillNoun <- io $ cueBS pillBytes & either throwIO pure - logDebug "Parsing pill file." + logInfo "Parsing pill file." pill <- fromNounErr pillNoun & either (throwIO . uncurry ParseErr) pure - logDebug "Using pill to generate boot sequence." + logInfo "Using pill to generate boot sequence." bootSeq <- genBootSeq (Ship 0) pill False (Fake (Ship 0)) - logDebug "Validate jam/cue and toNoun/fromNoun on pill value" + logInfo "Validate jam/cue and toNoun/fromNoun on pill value" reJam <- validateNounVal pill - logDebug "Checking if round-trip matches input file:" + logInfo "Checking if round-trip matches input file:" unless (reJam == pillBytes) $ do - logDebug " Our jam does not match the file...\n" - logDebug " This is surprising, but it is probably okay." + logInfo " Our jam does not match the file...\n" + logInfo " This is surprising, but it is probably okay." when showPil $ do - logDebug "\n\n== Pill ==\n" + logInfo "\n\n== Pill ==\n" io $ pPrint pill when showSeq $ do - logDebug "\n\n== Boot Sequence ==\n" + logInfo "\n\n== Boot Sequence ==\n" io $ pPrint bootSeq validateNounVal :: (HasLogFunc e, Eq a, ToNoun a, FromNoun a) => a -> RIO e ByteString validateNounVal inpVal = do - logDebug " jam" + logInfo " jam" inpByt <- evaluate $ jamBS $ toNoun inpVal - logDebug " cue" + logInfo " cue" outNon <- cueBS inpByt & either throwIO pure - logDebug " fromNoun" + logInfo " fromNoun" outVal <- fromNounErr outNon & either (throwIO . uncurry ParseErr) pure - logDebug " toNoun" + logInfo " toNoun" outNon <- evaluate (toNoun outVal) - logDebug " jam" + logInfo " jam" outByt <- evaluate $ jamBS outNon - logDebug "Checking if: x == cue (jam x)" + logInfo "Checking if: x == cue (jam x)" unless (inpVal == outVal) $ error "Value fails test: x == cue (jam x)" - logDebug "Checking if: jam x == jam (cue (jam x))" + logInfo "Checking if: jam x == jam (cue (jam x))" unless (inpByt == outByt) $ error "Value fails test: jam x == jam (cue (jam x))" @@ -446,11 +446,11 @@ validateNounVal inpVal = do pillFrom :: CLI.PillSource -> RIO HostEnv Pill pillFrom = \case CLI.PillSourceFile pillPath -> do - logDebug $ display $ "boot: reading pill from " ++ (pack pillPath :: Text) + logInfo $ display $ "boot: reading pill from " ++ (pack pillPath :: Text) io (loadFile pillPath >>= either throwIO pure) CLI.PillSourceURL url -> do - logDebug $ display $ "boot: retrieving pill from " ++ (pack url :: Text) + logInfo $ display $ "boot: retrieving pill from " ++ (pack url :: Text) -- Get the jamfile with the list of stars accepting comets right now. manager <- io $ C.newManager tlsManagerSettings request <- io $ C.parseRequest url @@ -729,7 +729,7 @@ runShipRestarting r o = do logTrace $ display (pier <> " shutdown requested") race_ (wait tid) $ do threadDelay 5_000_000 - logDebug $ display (pier <> " not down after 5s, killing with fire.") + logInfo $ display (pier <> " not down after 5s, killing with fire.") cancel tid logTrace $ display ("Ship terminated: " <> pier) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs index f16f6a55a8..25eccdc4bc 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs @@ -131,11 +131,11 @@ doResolv gal (prevWen, prevIP) turfs stderr = do io (resolv gal turfs) >>= \case Nothing -> do stderr $ "ames: czar at " ++ galStr ++ ": not found" - logDebug $ displayShow ("(ames) Failed to lookup IP for ", gal) + logInfo $ displayShow ("(ames) Failed to lookup IP for ", gal) pure (prevIP, tim) Just (turf, host, port, addr) -> do when (Just addr /= prevIP) (printCzar addr) - logDebug $ displayShow ("(ames) Looked up ", host, port, turf, addr) + logInfo $ displayShow ("(ames) Looked up ", host, port, turf, addr) pure (Just addr, tim) where galStr = renderGalaxy gal @@ -155,7 +155,7 @@ resolvWorker resolvWorker gal vTurfs vLast waitMsg send stderr = async (forever go) where logDrop = - logDebug $ displayShow ("(ames) Dropping packet; no ip for galaxy ", gal) + logInfo $ displayShow ("(ames) Dropping packet; no ip for galaxy ", gal) go :: RIO e () go = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs index 0dc758b46b..75014dd0d0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs @@ -80,14 +80,14 @@ forceBind :: HasLogFunc e => PortNumber -> HostAddress -> RIO e Socket forceBind por hos = go where go = do - logDebug (display ("AMES: UDP: Opening socket on port " <> tshow por)) + logInfo (display ("AMES: UDP: Opening socket on port " <> tshow por)) io (doBind por hos) >>= \case Right sk -> do - logDebug (display ("AMES: UDP: Opened socket on port " <> tshow por)) + logInfo (display ("AMES: UDP: Opened socket on port " <> tshow por)) pure sk Left err -> do - logDebug (display ("AMES: UDP: " <> tshow err)) - logDebug ("AMES: UDP: Failed to open UDP socket. Waiting") + logInfo (display ("AMES: UDP: " <> tshow err)) + logInfo ("AMES: UDP: Failed to open UDP socket. Waiting") threadDelay 250_000 go @@ -138,7 +138,7 @@ recvPacket sok = do -} fakeUdpServ :: HasLogFunc e => RIO e UdpServ fakeUdpServ = do - logDebug $ displayShow ("AMES", "UDP", "\"Starting\" fake UDP server.") + logInfo $ displayShow ("AMES", "UDP", "\"Starting\" fake UDP server.") pure UdpServ { .. } where usSend = \_ _ -> pure () @@ -158,7 +158,7 @@ realUdpServ -> HostAddress -> RIO e UdpServ realUdpServ por hos = do - logDebug $ displayShow ("AMES", "UDP", "Starting real UDP server.") + logInfo $ displayShow ("AMES", "UDP", "Starting real UDP server.") env <- ask @@ -178,7 +178,7 @@ realUdpServ por hos = do -} let signalBrokenSocket :: Socket -> RIO e () signalBrokenSocket sock = do - logDebug $ displayShow ("AMES", "UDP" + logInfo $ displayShow ("AMES", "UDP" , "Socket broken. Requesting new socket" ) atomically $ do @@ -242,11 +242,11 @@ realUdpServ por hos = do enqueueRecvPacket p a b let shutdown = do - logDebug "AMES: UDP: Shutting down. (killing threads)" + logInfo "AMES: UDP: Shutting down. (killing threads)" cancel tOpen cancel tSend cancel tRecv - logDebug "AMES: UDP: Shutting down. (closing socket)" + logInfo "AMES: UDP: Shutting down. (closing socket)" io $ join $ atomically $ do res <- readTVar vSock <&> maybe (pure ()) close writeTVar vSock Nothing diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs index 6b8272266c..ae626ed08c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs @@ -163,7 +163,7 @@ clay env plan = handleEffect :: ClayDrv -> SyncEf -> IO () handleEffect cd = runRIO env . \case SyncEfHill _ mountPoints -> do - logDebug $ displayShow ("(clay) known mount points:", mountPoints) + logInfo $ displayShow ("(clay) known mount points:", mountPoints) pierPath <- view pierPathL mountPairs <- flip mapM mountPoints $ \desk -> do ss <- takeFilesystemSnapshot (pierPath (deskToPath desk)) @@ -171,14 +171,14 @@ clay env plan = atomically $ writeTVar (cdMountPoints cd) (M.fromList mountPairs) SyncEfDirk p desk -> do - logDebug $ displayShow ("(clay) dirk:", p, desk) + logInfo $ displayShow ("(clay) dirk:", p, desk) m <- atomically $ readTVar (cdMountPoints cd) let snapshot = M.findWithDefault M.empty desk m pierPath <- view pierPathL let dir = pierPath deskToPath desk actions <- buildActionListFromDifferences dir snapshot - logDebug $ displayShow ("(clay) dirk actions: ", actions) + logInfo $ displayShow ("(clay) dirk actions: ", actions) let !intoList = map (actionsToInto dir) actions @@ -196,7 +196,7 @@ clay env plan = (applyActionsToMountPoints desk actions) SyncEfErgo p desk actions -> do - logDebug $ displayShow ("(clay) ergo:", p, desk, actions) + logInfo $ displayShow ("(clay) ergo:", p, desk, actions) m <- atomically $ readTVar (cdMountPoints cd) let mountPoint = M.findWithDefault M.empty desk m @@ -211,7 +211,7 @@ clay env plan = (applyActionsToMountPoints desk hashedActions) SyncEfOgre p desk -> do - logDebug $ displayShow ("(clay) ogre:", p, desk) + logInfo $ displayShow ("(clay) ogre:", p, desk) pierPath <- view pierPathL removeDirectoryRecursive $ pierPath deskToPath desk atomically $ modifyTVar (cdMountPoints cd) (M.delete desk) @@ -229,13 +229,13 @@ clay env plan = performAction :: (Map FilePath Int) -> (FilePath, Maybe (Mime, Int)) -> RIO e () performAction m (fp, Nothing) = do - logDebug $ displayShow ("(clay) deleting file ", fp) + logInfo $ displayShow ("(clay) deleting file ", fp) removeFile fp performAction m (fp, Just ((Mime _ (File (Octs bs)), hash))) - | skip = logDebug $ + | skip = logInfo $ displayShow ("(clay) skipping unchanged file update " , fp) | otherwise = do - logDebug $ displayShow ("(clay) updating file " , fp) + logInfo $ displayShow ("(clay) updating file " , fp) createDirectoryIfMissing True $ takeDirectory fp writeFile fp bs where diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 3d97651a00..ee6d616eb4 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -178,7 +178,7 @@ startServ -> (Text -> RIO e ()) -> RIO e Serv startServ who isFake conf plan stderr = do - logDebug (displayShow ("EYRE", "startServ")) + logInfo (displayShow ("EYRE", "startServ")) multi <- view multiEyreApiL @@ -221,11 +221,11 @@ startServ who isFake conf plan stderr = do let onKilReq :: Ship -> Word64 -> STM () onKilReq _ship = plan . cancelEv srvId . fromIntegral - logDebug (displayShow ("EYRE", "joinMultiEyre", who, mTls, mCre)) + logInfo (displayShow ("EYRE", "joinMultiEyre", who, mTls, mCre)) atomically (joinMultiEyre multi who mCre onReq onKilReq) - logDebug $ displayShow ("EYRE", "Starting loopback server") + logInfo $ displayShow ("EYRE", "Starting loopback server") lop <- serv vLive $ ServConf { scHost = soHost (pttLop ptt) , scPort = soWhich (pttLop ptt) @@ -237,7 +237,7 @@ startServ who isFake conf plan stderr = do } } - logDebug $ displayShow ("EYRE", "Starting insecure server") + logInfo $ displayShow ("EYRE", "Starting insecure server") ins <- serv vLive $ ServConf { scHost = soHost (pttIns ptt) , scPort = soWhich (pttIns ptt) @@ -250,7 +250,7 @@ startServ who isFake conf plan stderr = do } mSec <- for mTls $ \tls -> do - logDebug "Starting secure server" + logInfo "Starting secure server" serv vLive $ ServConf { scHost = soHost (pttSec ptt) , scPort = soWhich (pttSec ptt) @@ -271,7 +271,7 @@ startServ who isFake conf plan stderr = do let por = Ports secPor insPor lopPor fil = pierPath <> "/.http.ports" - logDebug $ displayShow ("EYRE", "All Servers Started.", srvId, por, fil) + logInfo $ displayShow ("EYRE", "All Servers Started.", srvId, por, fil) for secPor $ \p -> stderr ("http: secure web interface live on https://localhost:" <> tshow p) stderr ("http: web interface live on http://localhost:" <> tshow insPor) @@ -351,10 +351,10 @@ eyre env who plan isFake stderr = (initialEvents, runHttpServer) restart :: Drv -> HttpServerConf -> RIO e Serv restart (Drv var) conf = do - logDebug "Restarting http server" + logInfo "Restarting http server" let startAct = startServ who isFake conf plan stderr res <- fromEither =<< restartService var startAct kill - logDebug "Done restating http server" + logInfo "Done restating http server" pure res liveFailed _ = pure () @@ -362,11 +362,11 @@ eyre env who plan isFake stderr = (initialEvents, runHttpServer) handleEf :: Drv -> HttpServerEf -> IO () handleEf drv = runRIO env . \case HSESetConfig (i, ()) conf -> do - logDebug (displayShow ("EYRE", "%set-config")) + logInfo (displayShow ("EYRE", "%set-config")) Serv {..} <- restart drv conf - logDebug (displayShow ("EYRE", "%set-config", "Sending %live")) + logInfo (displayShow ("EYRE", "%set-config", "Sending %live")) atomically $ plan (EvErr (liveEv sServId sPorts) liveFailed) - logDebug "Write ports file" + logInfo "Write ports file" io (writePortsFile sPortsFile sPorts) HSEResponse (i, req, _seq, ()) ev -> do logDebug (displayShow ("EYRE", "%response")) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index 706afb8f3d..73a0c5c559 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -72,7 +72,7 @@ leaveMultiEyre MultiEyreApi {..} who = do multiEyre :: HasLogFunc e => MultiEyreConf -> RIO e MultiEyreApi multiEyre conf@MultiEyreConf {..} = do - logDebug (displayShow ("EYRE", "MULTI", conf)) + logInfo (displayShow ("EYRE", "MULTI", conf)) vLive <- io emptyLiveReqs >>= newTVarIO vPlan <- newTVarIO mempty @@ -96,7 +96,7 @@ multiEyre conf@MultiEyreConf {..} = do Just cb -> cb who reqId mIns <- for mecHttpPort $ \por -> do - logDebug (displayShow ("EYRE", "MULTI", "HTTP", por)) + logInfo (displayShow ("EYRE", "MULTI", "HTTP", por)) serv vLive $ ServConf { scHost = host , scPort = SPChoices $ singleton $ fromIntegral por @@ -109,7 +109,7 @@ multiEyre conf@MultiEyreConf {..} = do } mSec <- for mecHttpsPort $ \por -> do - logDebug (displayShow ("EYRE", "MULTI", "HTTPS", por)) + logInfo (displayShow ("EYRE", "MULTI", "HTTPS", por)) serv vLive $ ServConf { scHost = host , scPort = SPChoices $ singleton $ fromIntegral por diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index e007d6331a..0fdab349b6 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -164,7 +164,7 @@ tryOpenChoices tryOpenChoices hos = go where go (p :| ps) = do - logDebug (displayShow ("EYRE", "Trying to open port.", p)) + logInfo (displayShow ("EYRE", "Trying to open port.", p)) io (tryOpen hos p) >>= \case Left err -> do logError (displayShow ("EYRE", "Failed to open port.", p)) @@ -185,7 +185,7 @@ tryOpenAny hos = do pure (Right (p, s)) logDbg :: (HasLogFunc e, Show a) => [Text] -> a -> RIO e () -logDbg ctx msg = logDebug (prefix <> suffix) +logDbg ctx msg = logInfo (prefix <> suffix) where prefix = display (concat $ fmap (<> ": ") ctx) suffix = displayShow msg @@ -312,7 +312,7 @@ configCreds TlsConfig {..} = fakeServ :: HasLogFunc e => ServConf -> RIO e ServApi fakeServ conf = do let por = fakePort (scPort conf) - logDebug (displayShow ("EYRE", "SERV", "Running Fake Server", por)) + logInfo (displayShow ("EYRE", "SERV", "Running Fake Server", por)) pure $ ServApi { saKil = pure () , saPor = pure por @@ -331,7 +331,7 @@ getFirstTlsConfig (MTC var) = do realServ :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi realServ vLive conf@ServConf {..} = do - logDebug (displayShow ("EYRE", "SERV", "Running Real Server")) + logInfo (displayShow ("EYRE", "SERV", "Running Real Server")) kil <- newEmptyTMVarIO por <- newEmptyTMVarIO @@ -344,7 +344,7 @@ realServ vLive conf@ServConf {..} = do } where runServ vPort = do - logDebug (displayShow ("EYRE", "SERV", "runServ")) + logInfo (displayShow ("EYRE", "SERV", "runServ")) rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do atomically (putTMVar vPort por) startServer scType scHost por sok scRedi vLive diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs index ce3bc01a93..af571afc93 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs @@ -31,21 +31,21 @@ restartService -> (s -> RIO e ()) -> RIO e (Either SomeException s) restartService vServ sstart kkill = do - logDebug "restartService" + logInfo "restartService" modifyMVar vServ $ \case Nothing -> doStart Just sv -> doRestart sv where doRestart :: s -> RIO e (Maybe s, Either SomeException s) doRestart serv = do - logDebug "doStart" + logInfo "doStart" try (kkill serv) >>= \case Left exn -> pure (Nothing, Left exn) Right () -> doStart doStart :: RIO e (Maybe s, Either SomeException s) doStart = do - logDebug "doStart" + logInfo "doStart" try sstart <&> \case Right s -> (Just s, Right s) Left exn -> (Nothing, Left exn) @@ -59,7 +59,7 @@ stopService -> (s -> RIO e ()) -> RIO e (Either SomeException ()) stopService vServ kkill = do - logDebug "stopService" + logInfo "stopService" modifyMVar vServ $ \case Nothing -> pure (Nothing, Right ()) Just sv -> do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs index 1a7057bb61..147c3bd939 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs @@ -179,7 +179,7 @@ streamBlocks env init getAct = send init >> loop send "" = pure () send c = do - runRIO env (logInfo (display ("sending chunk " <> tshow c))) + runRIO env (logDebug (display ("sending chunk " <> tshow c))) yield $ Chunk $ fromByteString c yield Flush diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs index 011ce86acd..92e36145b2 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs @@ -140,7 +140,7 @@ client env plan = (initialEvents, runHttpClient) runReq HttpClientDrv{..} id req = async $ case cvtReq req of Nothing -> do - logDebug $ displayShow ("(malformed http client request)", id, req) + logInfo $ displayShow ("(malformed http client request)", id, req) planEvent id (Cancel ()) Just r -> do logDebug $ displayShow ("(http client request)", id, req) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/LMDB.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/LMDB.hs index 8e544647b6..691e25e5c0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/LMDB.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/LMDB.hs @@ -226,7 +226,7 @@ readRowsBatch :: ∀e. HasLogFunc e readRowsBatch env dbi first = readRows where readRows = do - logDebug $ display ("(readRowsBatch) From: " <> tshow first) + logInfo $ display ("(readRowsBatch) From: " <> tshow first) withWordPtr first $ \pIdx -> withKVPtrs' (MDB_val 8 (castPtr pIdx)) nullVal $ \pKey pVal -> rwith (readTxn env) $ \txn -> diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs index f23f82aa33..bc31c32e96 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs @@ -82,7 +82,7 @@ wsConn pre inp out wsc = do flip finally cleanup $ do res <- atomically (waitCatchSTM writer <|> waitCatchSTM reader) - logDebug $ displayShow (res :: Either SomeException ()) + logInfo $ displayShow (res :: Either SomeException ()) -------------------------------------------------------------------------------- @@ -95,7 +95,7 @@ wsClient pax por = do out <- io $ newTBMChanIO 5 con <- pure (mkConn inp out) - logDebug "NOUNSERV (wsClie) Trying to connect" + logInfo "NOUNSERV (wsClie) Trying to connect" tid <- io $ async $ WS.runClient "127.0.0.1" por (unpack pax) @@ -111,7 +111,7 @@ wsServApp :: (HasLogFunc e, ToNoun o, FromNoun i, Show i, Show o) -> WS.PendingConnection -> RIO e () wsServApp cb pen = do - logDebug "NOUNSERV (wsServer) Got connection!" + logInfo "NOUNSERV (wsServer) Got connection!" wsc <- io $ WS.acceptRequest pen inp <- io $ newTBMChanIO 5 out <- io $ newTBMChanIO 5 @@ -125,10 +125,10 @@ wsServer = do tid <- async $ do env <- ask - logDebug "NOUNSERV (wsServer) Starting server" + logInfo "NOUNSERV (wsServer) Starting server" io $ WS.runServer "127.0.0.1" 9999 $ runRIO env . wsServApp (writeTBMChan con) - logDebug "NOUNSERV (wsServer) Server died" + logInfo "NOUNSERV (wsServer) Server died" atomically $ closeTBMChan con pure $ Server (readTBMChan con) tid 9999 diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 37b38a7d1f..82da7d0df9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -178,21 +178,21 @@ bootNewShip -> RIO e () bootNewShip pill lite ship bootEv = do seq@(BootSeq ident x y) <- genBootSeq ship pill lite bootEv - logDebug "BootSeq Computed" + logInfo "BootSeq Computed" pierPath <- view pierPathL rio (setupPierDirectory pierPath) - logDebug "Directory setup." + logInfo "Directory setup." let logPath = (pierPath ".urb/log") rwith (Log.new logPath ident) $ \log -> do - logDebug "Event log onitialized." + logInfo "Event log onitialized." jobs <- (\now -> bootSeqJobs now seq) <$> io Time.now writeJobs log (fromList jobs) - logDebug "Finsihed populating event log with boot sequence" + logInfo "Finsihed populating event log with boot sequence" -- Resume an existing ship. ---------------------------------------------------- @@ -216,16 +216,16 @@ resumed vSlog replayUntil = do serf <- runSerf vSlog tap rio $ do - logDebug "Replaying events" + logInfo "Replaying events" Serf.execReplay serf log replayUntil >>= \case Left err -> error (show err) Right 0 -> do - logDebug "No work during replay so no snapshot" + logInfo "No work during replay so no snapshot" pure () Right _ -> do - logDebug "Taking snapshot" + logInfo "Taking snapshot" io (Serf.snapshot serf) - logDebug "SNAPSHOT TAKEN" + logInfo "SNAPSHOT TAKEN" pure (serf, log) @@ -251,14 +251,14 @@ acquireWorker :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) acquireWorker nam act = mkRAcquire (async act) kill where kill tid = do - logDebug ("Killing worker thread: " <> display nam) + logInfo ("Killing worker thread: " <> display nam) cancel tid acquireWorkerBound :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) acquireWorkerBound nam act = mkRAcquire (asyncBound act) kill where kill tid = do - logDebug ("Killing worker thread: " <> display nam) + logInfo ("Killing worker thread: " <> display nam) cancel tid @@ -293,11 +293,11 @@ pier (serf, log) vSlog startedSig = do pure (res, Term.useDemux res) void $ acquireWorker "TERMSERV Listener" $ forever $ do - logDebug "TERMSERV Waiting for external terminal." + logInfo "TERMSERV Waiting for external terminal." atomically $ do ext <- Term.connClient <$> readTQueue termApiQ Term.addDemux ext demux - logDebug "TERMSERV External terminal connected." + logInfo "TERMSERV External terminal connected." -- Slogs go to both stderr and to the terminal. env <- ask @@ -377,7 +377,7 @@ pier (serf, log) vSlog startedSig = do threadDelay 15_000_000 wen <- io Time.now let kal = \mTermNoun -> runRIO env $ do - logDebug $ displayShow ("scry result: ", mTermNoun) + logInfo $ displayShow ("scry result: ", mTermNoun) let nkt = MkKnot $ tshow $ Time.MkDate wen let pax = Path ["j", "~zod", "life", nkt, "~zod"] atomically $ putTMVar scrySig (wen, Nothing, pax, kal) @@ -501,7 +501,7 @@ router slog waitFx Drivers {..} = do logEvent :: HasLogFunc e => Ev -> RIO e () logEvent ev = do - logInfo $ "<- " <> display (summarizeEvent ev) + --logInfo $ "<- " <> display (summarizeEvent ev) logDebug $ "[EVENT]\n" <> display pretty where pretty :: Text @@ -509,7 +509,7 @@ logEvent ev = do logEffect :: HasLogFunc e => Lenient Ef -> RIO e () logEffect ef = do - logInfo $ " -> " <> display (summarizeEffect ef) + --logInfo $ " -> " <> display (summarizeEffect ef) logDebug $ display $ "[EFFECT]\n" <> pretty ef where pretty :: Lenient Ef -> Text diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index e03512883e..6a65f2d238 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -40,7 +40,7 @@ withSerf config = mkRAcquire startup kill where startup = do (serf, st) <- io $ start config - logDebug (displayShow ("serf state", st)) + logInfo (displayShow ("serf state", st)) pure serf kill serf = do void $ rio $ stop serf @@ -58,7 +58,7 @@ execReplay serf log last = do where doBoot :: RIO e (Either PlayBail Word) doBoot = do - logDebug "Beginning boot sequence" + logInfo "Beginning boot sequence" let bootSeqLen = lifecycleLen (Log.identity log) @@ -72,14 +72,14 @@ execReplay serf log last = do when (numEvs /= bootSeqLen) $ do throwIO (MissingBootEventsInEventLog numEvs bootSeqLen) - logDebug $ display ("Sending " <> tshow numEvs <> " boot events to serf") + logInfo $ display ("Sending " <> tshow numEvs <> " boot events to serf") io (boot serf evs) >>= \case Just err -> do - logDebug "Error on replay, exiting" + logInfo "Error on replay, exiting" pure (Left err) Nothing -> do - logDebug "Finished boot events, moving on to more events from log." + logInfo "Finished boot events, moving on to more events from log." doReplay <&> \case Left err -> Left err Right num -> Right (num + numEvs) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 06082c142d..eea980a7fc 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -472,7 +472,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop loop rd else if w == 3 then do -- ETX (^C) - logDebug $ displayShow "Ctrl-c interrupt" + logInfo $ displayShow "Ctrl-c interrupt" atomically $ do writeTQueue wq [Term.Trace "interrupt\r\n"] writeTQueue rq $ Ctl $ Cord "c"