Merge branch 'release/next-userspace' into la/contact-store

2024-12-04 02:49:42 +03:00 · 2021-01-29 18:33:53 -05:00 · 2021-01-29 18:33:53 -05:00 · b726ee2066
commit b726ee2066
parent 6927327c7f 876e90106e
44 changed files with 1066 additions and 528 deletions
--- a/bin/solid.pill
+++ b/bin/solid.pill
@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:fd78b54d1c825f14b51c4dff001e17368953ecf9fc5a7b6792c059477761076a
-size 9001760
+oid sha256:6b4b198b552066fdee2a694a3134bf641b20591bebda21aa90920f4107f04f20
+size 9065500
--- a/default.nix
+++ b/default.nix
@ -155,8 +155,7 @@ let
      contents = {
        "${name}/urbit" = "${urbit}/bin/urbit";
        "${name}/urbit-worker" = "${urbit}/bin/urbit-worker";
-        # temporarily removed for compatibility reasons
-        # "${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
+        "${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
      };
    };

--- a/pkg/arvo/app/glob.hoon
+++ b/pkg/arvo/app/glob.hoon
@ -5,7 +5,7 @@
 /-  glob
 /+  default-agent, verb, dbug
 |%
-++  hash  0v7.9mc9i.jbk7p.smfcl.3aose.b6dat
++  hash  0v1.39us5.oj5a9.9as9u.od9db.0dipj
 +$  state-0  [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
 +$  all-states
  $%  state-0
--- a/pkg/arvo/app/graph-store.hoon
+++ b/pkg/arvo/app/graph-store.hoon
@ -726,7 +726,8 @@
      $:  %0
          p=time
          $=  q
-          $%  [%add-nodes =resource:store nodes=(tree [index:store tree-node])]
+          $%  [%add-graph =resource:store =tree-graph mark=(unit ^mark) ow=?]
+              [%add-nodes =resource:store nodes=(tree [index:store tree-node])]
              [%remove-nodes =resource:store indices=(tree index:store)]
              [%add-signatures =uid:store signatures=tree-signatures]
              [%remove-signatures =uid:store signatures=tree-signatures]
@ -806,6 +807,14 @@
      ^-  logged-update:store
      :+  %0  p.t
      ?-  -.q.t
+          %add-graph
+        :*  %add-graph
+            resource.q.t
+            (remake-graph tree-graph.q.t)
+            mark.q.t
+            ow.q.t
+        ==
+      ::
          %add-nodes
        :-  %add-nodes
        :-  resource.q.t
--- a/pkg/arvo/app/landscape/index.html
+++ b/pkg/arvo/app/landscape/index.html
@ -24,6 +24,6 @@
    <div id="portal-root"></div>
    <script src="/~landscape/js/channel.js"></script>
    <script src="/~landscape/js/session.js"></script>
-    <script src="/~landscape/js/bundle/index.226dd4e7ed526397a662.js"></script>
+    <script src="/~landscape/js/bundle/index.5fdbe84c6b57646a6a6b.js"></script>
  </body>
 </html>
--- a/pkg/arvo/app/lens.hoon
+++ b/pkg/arvo/app/lens.hoon
@ -28,8 +28,6 @@
        %contact-store
        %contact-hook
        %invite-store
-        %chat-store
-        %chat-hook
        %graph-store
    ==
  |=  app=@tas
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
@ -12,6 +12,7 @@
 -}
 module Urbit.Arvo.Common
  ( KingId(..), ServId(..)
+  , Vere(..), Wynn(..)
  , Json, JsonNode(..)
  , Desk(..), Mime(..)
  , Port(..), Turf(..)
@ -21,9 +22,10 @@ module Urbit.Arvo.Common
  , AmesDest, Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
  ) where

-import Urbit.Prelude hiding (Term)
+import Urbit.Prelude

 import Control.Monad.Fail (fail)
+import Data.Bits

 import qualified Network.HTTP.Types.Method as H
 import qualified Urbit.Ob                  as Ob
@ -45,6 +47,25 @@ newtype KingId = KingId { unKingId :: UV }
 newtype ServId = ServId { unServId :: UV }
  deriving newtype (Eq, Ord, Show, Num, Enum, Integral, Real, FromNoun, ToNoun)

+-- Arvo Version Negotiation ----------------------------------------------------
+
+-- Information about the king runtime passed to Arvo.
+data Vere = Vere { vereName :: Term,
+                   vereRev  :: [Cord],
+                   vereWynn :: Wynn }
+  deriving (Eq, Ord, Show)
+
+instance ToNoun Vere where
+  toNoun Vere{..} = toNoun ((vereName, vereRev), vereWynn)
+
+instance FromNoun Vere where
+  parseNoun n = named "Vere" $ do
+    ((vereName, vereRev), vereWynn) <- parseNoun n
+    pure $ Vere {..}
+
+-- A list of names and their kelvin numbers, used in version negotiations.
+newtype Wynn = Wynn { unWynn :: [(Term, Word)] }
+  deriving newtype (Eq, Ord, Show, FromNoun, ToNoun)

 -- Http Common -----------------------------------------------------------------

@ -112,7 +133,7 @@ deriveNoun ''HttpServerConf
 -- Desk and Mime ---------------------------------------------------------------

 newtype Desk = Desk { unDesk :: Cord }
-  deriving newtype (Eq, Ord, Show, ToNoun, FromNoun)
+  deriving newtype (Eq, Ord, Show, ToNoun, FromNoun, IsString)

 data Mime = Mime Path File
  deriving (Eq, Ord, Show)
@ -146,7 +167,14 @@ newtype Port = Port { unPort :: Word16 }

 -- @if
 newtype Ipv4 = Ipv4 { unIpv4 :: Word32 }
-  deriving newtype (Eq, Ord, Show, Enum, Real, Integral, Num, ToNoun, FromNoun)
+  deriving newtype (Eq, Ord, Enum, Real, Integral, Num, ToNoun, FromNoun)
+
+instance Show Ipv4 where
+  show (Ipv4 i) =
+    show ((shiftL i 24) .&. 0xff) ++ "." ++
+    show ((shiftL i 16) .&. 0xff) ++ "." ++
+    show ((shiftL i  8) .&. 0xff) ++ "." ++
+    show (i .&. 0xff)

 -- @is
 newtype Ipv6 = Ipv6 { unIpv6 :: Word128 }
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
@ -18,7 +18,7 @@ import Urbit.Arvo.Common (KingId(..), ServId(..))
 import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime)
 import Urbit.Arvo.Common (AmesDest, Turf)
 import Urbit.Arvo.Common (ReOrg(..), reorgThroughNoun)
-import Urbit.Arvo.Common (Desk)
+import Urbit.Arvo.Common (Desk, Wynn)


 -- Newt Effects ----------------------------------------------------------------
@ -259,20 +259,32 @@ data Ef
    = EfVane VaneEf
    | EfVega Cord EvilPath -- second path component, rest of path
    | EfExit Cord EvilPath -- second path component, rest of path
+    | EfWend Wynn
  deriving (Eq, Ord, Show)

+-- XX HACK
+clip :: Noun -> Noun
+clip (C (C _ x) y) = C x y
+clip _ = error "misclip"
+
+tack :: Noun -> Noun
+tack (C x y) = C (C (A 0) x) y
+tack _ = error "mistack"
+
 instance ToNoun Ef where
-  toNoun = \case
+  toNoun = clip . \case
    EfVane v   -> toNoun $ reorgThroughNoun ("", v)
    EfExit s p -> toNoun $ ReOrg "" s "exit" p (A 0)
    EfVega s p -> toNoun $ ReOrg "" s "vega" p (A 0)
+    EfWend w   -> toNoun $ reorgThroughNoun ("", w)

 instance FromNoun Ef where
-  parseNoun = parseNoun >=> \case
+  parseNoun = tack >>> parseNoun >=> \case
    ReOrg "" s "exit" p (A 0) -> pure (EfExit s p)
    ReOrg "" s "exit" p _     -> fail "%exit effect expects nil value"
    ReOrg "" s "vega" p (A 0) -> pure (EfVega s p)
    ReOrg "" s "vega" p _     -> fail "%vega effect expects nil value"
+    ReOrg "" s "wend" p val   -> EfWend <$> parseNoun val
    ReOrg "" s tag    p val   -> EfVane <$> parseNoun (toNoun (s, tag, p, val))
    ReOrg _  _ _      _ _     -> fail "Non-empty first path-element"

--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
@ -9,10 +9,10 @@
 -}
 module Urbit.Arvo.Event where

-import Urbit.Prelude hiding (Term)
+import Urbit.Prelude

 import Control.Monad.Fail (fail)
-import Urbit.Arvo.Common (KingId(..), ServId(..))
+import Urbit.Arvo.Common (KingId(..), ServId(..), Vere(..))
 import Urbit.Arvo.Common (Desk, Mime)
 import Urbit.Arvo.Common (Header(..), HttpEvent)
 import Urbit.Arvo.Common (AmesDest, Ipv4, Ipv6, Port, Turf)
@ -218,9 +218,12 @@ instance Show Entropy where
 data ArvoEv
    = ArvoEvWhom ()   Ship
    | ArvoEvWack ()   Entropy
-    | ArvoEvWarn Path Noun
+    | ArvoEvWyrd ()   Vere
    | ArvoEvCrud Path Noun
-    | ArvoEvVeer Atom Noun
+    | ArvoEvTrim UD
+    | ArvoEvWhat [Noun]
+    | ArvoEvWhey ()
+    | ArvoEvVerb (Maybe Bool)
  deriving (Eq, Ord, Show)

 deriveNoun ''ArvoEv
@ -318,50 +321,29 @@ data BlipEv
 deriveNoun ''BlipEv


-- Boot Events -----------------------------------------------------------------
-
-data Vane
-    = VaneVane VaneEv
-    | VaneZuse ZuseEv
-  deriving (Eq, Ord, Show)
-
-data VaneName
-    = Ames | Behn | Clay | Dill | Eyre | Ford | Gall | Iris | Jael
-  deriving (Eq, Ord, Show, Enum, Bounded)
-
-data ZuseEv
-    = ZEVeer () Cord Path BigCord
-    | ZEVoid Void
-  deriving (Eq, Ord, Show)
-
-data VaneEv
-    = VEVeer (VaneName, ()) Cord Path BigCord
-    | VEVoid Void
-  deriving (Eq, Ord, Show)
-
-deriveNoun ''Vane
-deriveNoun ''VaneName
-deriveNoun ''VaneEv
-deriveNoun ''ZuseEv
-
-
 -- The Main Event Type ---------------------------------------------------------

 data Ev
    = EvBlip BlipEv
-    | EvVane Vane
  deriving (Eq, Show)

 instance ToNoun Ev where
-  toNoun = \case
-    EvBlip v -> toNoun $ reorgThroughNoun (Cord "",     v)
-    EvVane v -> toNoun $ reorgThroughNoun (Cord "vane", v)
+  toNoun = toNoun . \case
+    EvBlip v@BlipEvAmes{}       -> reorgThroughNoun ("ames", v)
+    EvBlip v@BlipEvArvo{}       -> reorgThroughNoun ("",  v)
+    EvBlip v@BlipEvBehn{}       -> reorgThroughNoun ("behn", v)
+    EvBlip v@BlipEvBoat{}       -> reorgThroughNoun ("clay", v)
+    EvBlip v@BlipEvHttpClient{} -> reorgThroughNoun ("iris", v)
+    EvBlip v@BlipEvHttpServer{} -> reorgThroughNoun ("eyre", v)
+    EvBlip v@BlipEvNewt{}       -> reorgThroughNoun ("ames", v)
+    EvBlip v@BlipEvSync{}       -> reorgThroughNoun ("clay", v)
+    EvBlip v@BlipEvTerm{}       -> reorgThroughNoun ("dill", v)

+-- XX We really should check the first path element, but since this is used only
+-- in the event browser, which otherwise is broken, I don't care right now.
 instance FromNoun Ev where
  parseNoun = parseNoun >=> \case
-    ReOrg ""     s t p v -> fmap EvBlip $ parseNoun $ toNoun (s,t,p,v)
-    ReOrg "vane" s t p v -> fmap EvVane $ parseNoun $ toNoun (s,t,p,v)
-    ReOrg _      _ _ _ _ -> fail "First path-elem must be ?($ %vane)"
+    ReOrg _ s t p v -> fmap EvBlip $ parseNoun $ toNoun (s,t,p,v)


 -- Short Event Names -----------------------------------------------------------
@ -373,7 +355,6 @@ instance FromNoun Ev where
 -}
 getSpinnerNameForEvent :: Ev -> Maybe Text
 getSpinnerNameForEvent = \case
-    EvVane _ -> Nothing
    EvBlip b -> case b of
        BlipEvAmes _           -> Just "ames"
        BlipEvArvo _           -> Just "arvo"
--- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs
@ -4,6 +4,7 @@
 module Urbit.King.App
  ( KingEnv
  , runKingEnvStderr
+  , runKingEnvStderrRaw
  , runKingEnvLogFile
  , runKingEnvNoLog
  , kingEnvKillSignal
@ -29,6 +30,7 @@ where
 import Urbit.King.Config
 import Urbit.Prelude

+import RIO                    (logGeneric)
 import System.Directory       ( createDirectoryIfMissing
                              , getXdgDirectory
                              , XdgDirectory(XdgCache)
@ -90,6 +92,22 @@ runKingEnvStderr verb lvl inner = do
      <&> setLogMinLevel lvl
  withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc inner

+runKingEnvStderrRaw :: Bool -> LogLevel -> RIO KingEnv a -> IO a
+runKingEnvStderrRaw verb lvl inner = do
+  logOptions <-
+    logOptionsHandle stderr verb
+      <&> setLogUseTime True
+      <&> setLogUseLoc False
+      <&> setLogMinLevel lvl
+  withLogFunc logOptions $ \logFunc ->
+    let lf = wrapCarriage logFunc
+    in runKingEnv lf lf inner
+
+-- XX loses callstack
+wrapCarriage :: LogFunc -> LogFunc
+wrapCarriage lf = mkLogFunc $ \_ ls ll bldr ->
+  runRIO lf $ logGeneric ls ll (bldr <> "\r")
+
 runKingEnvLogFile :: Bool -> LogLevel -> Maybe FilePath -> RIO KingEnv a -> IO a
 runKingEnvLogFile verb lvl fileM inner = do
  logFile <- case fileM of
@ -119,7 +137,8 @@ defaultLogFile :: IO FilePath
 defaultLogFile = do
  logDir <- getXdgDirectory XdgCache "urbit"
  createDirectoryIfMissing True logDir
-  pure (logDir </> "king.log")
+  logId :: Word32 <- randomIO
+  pure (logDir </> "king-" <> show logId <> ".log")

 runKingEnvNoLog :: RIO KingEnv a -> IO a
 runKingEnvNoLog act = runKingEnv mempty mempty act
--- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs
@ -382,7 +382,7 @@ replayPartEvs top last = do
 {-|
    Interesting
 -}
-testPill :: HasLogFunc e => FilePath -> Bool -> Bool -> RIO e ()
+testPill :: HasKingEnv e => FilePath -> Bool -> Bool -> RIO e ()
 testPill pax showPil showSeq = do
  logInfo "Reading pill file."
  pillBytes <- readFile pax
@ -678,10 +678,13 @@ main = do
  runKingEnv args log =
    let
      verb = verboseLogging args
+      runStderr = case args of
+        CLI.CmdRun {} -> runKingEnvStderrRaw
+        _             -> runKingEnvStderr
      CLI.Log {..} = log
    in case logTarget lTarget args of
       CLI.LogFile f -> runKingEnvLogFile verb lLevel f
-       CLI.LogStderr -> runKingEnvStderr  verb lLevel
+       CLI.LogStderr -> runStderr         verb lLevel
       CLI.LogOff    -> runKingEnvNoLog

  setupSignalHandlers = do
--- a/pkg/hs/urbit-king/lib/Urbit/King/Scry.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/King/Scry.hs
@ -2,30 +2,32 @@
  Scry helpers
 -}

-module Urbit.King.Scry (scryNow) where
+module Urbit.King.Scry
+  ( scryNow
+  , module Urbit.Vere.Pier.Types
+  )
+where

 import Urbit.Prelude
 import Urbit.Vere.Serf.Types

-import qualified Urbit.Noun.Time as Time
+import Urbit.Arvo.Common (Desk)
+import Urbit.Vere.Pier.Types (ScryFunc)

 scryNow :: forall e n
        . (HasLogFunc e, FromNoun n)
-       => (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
-       -> Text    -- ^ vane + care as two-letter string
-       -> Ship    -- ^ ship in scry path, usually the local ship
-       -> Text    -- ^ desk in scry path
+       => ScryFunc
+       -> Term    -- ^ vane + care as two-letter string
+       -> Desk    -- ^ desk in scry path
       -> [Text]  -- ^ resource path to scry for
       -> RIO e (Maybe n)
-scryNow scry vare ship desk path = do
-  env <- ask
-  wen <- io Time.now
-  let wan = tshow $ Time.MkDate wen
-  let pax = Path $ fmap MkKnot $ vare : (tshow ship) : desk : wan : path
-  io (scry wen Nothing pax) >>= \case
-    Just (_, fromNoun @n -> Just v) -> pure $ Just v
-    Just (_, n) -> do
-      logError $ displayShow ("uncanny scry result", vare, pax, n)
-      pure Nothing
-    Nothing -> pure Nothing
+scryNow scry vare desk path =
+  io (scry Nothing (EachNo $ DemiOnce vare desk (Path $ MkKnot <$> path)))
+    >>= \case
+      Just ("omen", fromNoun @(Path, Term, n) -> Just (_,_,v)) -> pure $ Just v
+      Just (_, fromNoun @n -> Just v) -> pure $ Just v
+      Just (_, n) -> do
+        logError $ displayShow ("uncanny scry result", vare, path, n)
+        pure Nothing
+      Nothing -> pure Nothing

--- a/pkg/hs/urbit-king/lib/Urbit/Prelude.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Prelude.hs
@ -16,6 +16,7 @@ module Urbit.Prelude
    , io, rio
    , logTrace
    , acquireWorker, acquireWorkerBound
+    , hark
    ) where

 import ClassyPrelude
@ -38,6 +39,8 @@ import RIO (HasLogFunc, LogFunc, LogLevel(..), logDebug, logError, logFuncL,
            logInfo, logOptionsHandle, logOther, logWarn, mkLogFunc,
            setLogMinLevel, setLogUseLoc, setLogUseTime, withLogFunc)

+import qualified RIO
+
 io :: MonadIO m => IO a -> m a
 io = liftIO

@ -47,6 +50,9 @@ rio = liftRIO
 logTrace :: HasLogFunc e => Utf8Builder -> RIO e ()
 logTrace = logOther "trace"

+-- | Composes a log message out of textual components.
+hark :: [Text] -> Utf8Builder
+hark = RIO.displayBytesUtf8 . foldMap encodeUtf8

 -- Utils for Spawning Worker Threads -------------------------------------------

--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
@ -24,8 +24,7 @@ import Urbit.King.App      (HasKingId(..), HasPierEnv(..))
 import Urbit.Vere.Ames.DNS (NetworkMode(..), ResolvServ(..))
 import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ)
 import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ)
-
-import qualified Urbit.Noun.Time as Time
+import Urbit.Vere.Stat     (AmesStat(..), bump, bump')


 -- Constants -------------------------------------------------------------------
@ -47,7 +46,6 @@ type Version = Word8

 data AmesDrv = AmesDrv
  { aTurfs    :: TVar (Maybe [Turf])
-  , aDropped  :: TVar Word
  , aVersion  :: TVar (Maybe Version)
  , aUdpServ  :: UdpServ
  , aResolvr  :: ResolvServ
@ -125,13 +123,14 @@ udpPort isFake who = do
 udpServ :: (HasLogFunc e, HasNetworkConfig e, HasPortControlApi e)
        => Bool
        -> Ship
+        -> AmesStat
        -> RIO e UdpServ
-udpServ isFake who = do
+udpServ isFake who stat =  do
  mode <- netMode isFake
  port <- udpPort isFake who
  case modeAddress mode of
    Nothing   -> fakeUdpServ
-    Just host -> realUdpServ port host
+    Just host -> realUdpServ port host stat

 _bornFailed :: e -> WorkError -> IO ()
 _bornFailed env _ = runRIO env $ do
@ -141,10 +140,11 @@ ames'
  :: HasPierEnv e
  => Ship
  -> Bool
-  -> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+  -> AmesStat
+  -> ScryFunc
  -> (Text -> RIO e ())
  -> RIO e ([Ev], RAcquire e (DriverApi NewtEf))
-ames' who isFake scry stderr = do
+ames' who isFake stat scry stderr = do
  -- Unfortunately, we cannot use TBQueue because the only behavior
  -- provided for when full is to block the writer. The implementation
  -- below uses materially the same data structures as TBQueue, however.
@ -164,11 +164,11 @@ ames' who isFake scry stderr = do
          pure Ouster
    dequeuePacket = do
      pM <- tryReadTQueue ventQ
-      when (isJust pM) $ modifyTVar avail (+ 1)
+      when (isJust pM) $ modifyTVar' avail (+ 1)
      pure pM

  env <- ask
-  let (bornEvs, startDriver) = ames env who isFake scry enqueuePacket stderr
+  let (bornEvs, startDriver) = ames env who isFake stat scry enqueuePacket stderr

  let runDriver = do
        diOnEffect <- startDriver
@ -195,11 +195,12 @@ ames
  => e
  -> Ship
  -> Bool
-  -> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+  -> AmesStat
+  -> ScryFunc
  -> (EvErr -> STM PacketOutcome)
  -> (Text -> RIO e ())
  -> ([Ev], RAcquire e (NewtEf -> IO ()))
-ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
+ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
 where
  king = fromIntegral (env ^. kingIdL)

@ -218,21 +219,28 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
    cachedScryLane <- cache scryLane

    aTurfs   <- newTVarIO Nothing
-    aDropped <- newTVarIO 0
    aVersion <- newTVarIO Nothing
    aVersTid <- trackVersionThread aVersion
-    aUdpServ <- udpServ isFake who
+    aUdpServ <- udpServ isFake who stat
    aResolvr <- resolvServ aTurfs (usSend aUdpServ) stderr
    aRecvTid <- queuePacketsThread
-      aDropped
      aVersion
      cachedScryLane
      (send aUdpServ aResolvr mode)
      aUdpServ
+      stat

    pure (AmesDrv { .. })

-  hearFailed _ = pure ()
+  hearFailed AmesStat {..} = runRIO env . \case
+    RunSwap{} -> bump asSwp
+    RunBail gs -> do
+      for gs \(t, es) ->
+        for es \e ->
+          logWarn $ hark
+            ["ames: goof: ", unTerm t, ": ", tankToText e]
+      bump asBal 
+    RunOkay{} -> bump asOky

  trackVersionThread :: HasLogFunc e => TVar (Maybe Version) -> RIO e (Async ())
  trackVersionThread versSlot = async $ forever do
@ -249,34 +257,43 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
    threadDelay (10 * 60 * 1_000_000)  -- 10m

  queuePacketsThread :: HasLogFunc e
-                     => TVar Word
-                     -> TVar (Maybe Version)
+                     => TVar (Maybe Version)
                     -> (Ship -> RIO e (Maybe [AmesDest]))
                     -> (AmesDest -> ByteString -> RIO e ())
                     -> UdpServ
+                     -> AmesStat
                     -> RIO e (Async ())
-  queuePacketsThread dropCtr vers lan forward UdpServ{..} = async $ forever $ do
+  queuePacketsThread vers lan forward UdpServ{..} s@(AmesStat{..}) = async $ forever $ do
      -- port number, host address, bytestring
-    (p, a, b) <- atomically usRecv
+    (p, a, b) <- atomically (bump' asRcv >> usRecv)
    ver <- readTVarIO vers
-
    case decode b of
      Right (pkt@Packet {..}) | ver == Nothing || ver == Just pktVersion -> do
        logDebug $ displayShow ("ames: bon packet", pkt, showUD $ bytesAtom b)

        if pktRcvr == who
-          then serfsUp p a b
+          then do
+            bump asSup
+            serfsUp p a b
          else lan pktRcvr >>= \case
            Just ls
              |  dest:_ <- filter notSelf ls
-              -> forward dest $ encode pkt
-                { pktOrigin = pktOrigin <|> Just (ipDest p a) }
+              -> do
+                bump asFwd
+                forward dest $ encode pkt
+                  { pktOrigin = pktOrigin
+                            <|> Just (AAIpv4 (Ipv4 a) (fromIntegral p)) }
              where
                notSelf (EachYes g) = who /= Ship (fromIntegral g)
                notSelf (EachNo  _) = True
-            _ -> logInfo $ displayShow ("ames: dropping unroutable", pkt)

-      Right pkt -> logInfo $ displayShow ("ames: dropping ill-versed", pkt, ver)
+            _ -> do
+              bump asDrt
+              logInfo $ displayShow ("ames: dropping unroutable", pkt)
+
+      Right pkt -> do
+        bump asDvr
+        logInfo $ displayShow ("ames: dropping ill-versed", pkt, ver)

      -- XX better handle misversioned or illegible packets.
      -- Remarks from 67f06ce5, pkg/urbit/vere/io/ames.c, L1010:
@ -293,18 +310,19 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
      --    trigger printfs suggesting upgrade.
      --    they cannot be filtered, as we do not know their semantics
      --
-      Left e -> logInfo $ displayShow ("ames: dropping malformed", e)
+      Left e -> do
+        bump asDml
+        logInfo $ displayShow ("ames: dropping malformed", e)

    where
      serfsUp p a b =
-        atomically (enqueueEv (EvErr (hearEv p a b) hearFailed)) >>= \case
-          Intake -> pure ()
+        atomically (enqueueEv (EvErr (hearEv p a b) (hearFailed s))) >>= \case
+          Intake -> bump asSrf
          Ouster -> do
            d <- atomically $ do
-              d <- readTVar dropCtr
-              writeTVar dropCtr (d + 1)
-              pure d
-            when (d `rem` packetsDroppedPerComplaint == 0) $
+              bump' asQuf
+              readTVar asQuf
+            when (d `rem` packetsDroppedPerComplaint == 1) $
              logWarn "ames: queue full; dropping inbound packets"

  stop :: forall e. AmesDrv -> RIO e ()
@ -342,12 +360,12 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
        EachNo  addr -> to (ipv4Addr addr)

  scryVersion :: HasLogFunc e => RIO e (Maybe Version)
-  scryVersion = scryNow scry "ax" who "" ["protocol", "version"]
+  scryVersion = scryNow scry "ax" "" ["protocol", "version"]

  scryLane :: HasLogFunc e
           => Ship
           -> RIO e (Maybe [AmesDest])
-  scryLane ship = scryNow scry "ax" who "" ["peers", tshow ship, "forward-lane"]
+  scryLane ship = scryNow scry "ax" "" ["peers", tshow ship, "forward-lane"]

  ipv4Addr (Jammed (AAVoid v  )) = absurd v
  ipv4Addr (Jammed (AAIpv4 a p)) = SockAddrInet (fromIntegral p) (unIpv4 a)
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/Packet.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/Packet.hs
@ -9,18 +9,19 @@ import Urbit.Prelude
 import Control.Monad.Fail
 import Data.Bits
 import Data.LargeWord
+import Data.List (genericIndex)
 import Data.Serialize

-import Urbit.Arvo (AmesDest)
+import Urbit.Arvo (AmesAddress(..), Ipv4(..), Port(..))

 data Packet = Packet
-  { pktVersion    :: Word8
-  , pktEncrypted  :: Bool
-  --
-  , pktSndr       :: Ship
-  , pktRcvr       :: Ship
-  , pktOrigin     :: Maybe AmesDest
-  , pktContent    :: Bytes
+  { pktVersion  :: Word3
+  , pktSndr     :: Ship
+  , pktRcvr     :: Ship
+  , pktSndrTick :: Word4
+  , pktRcvrTick :: Word4
+  , pktOrigin   :: Maybe AmesAddress
+  , pktContent  :: ByteString
  }
  deriving Eq

@ -28,73 +29,140 @@ instance Show Packet where
  show Packet {..}
    = "Packet {pktVersion = "
   <> show pktVersion
-   <> ", pktEncrypted = "
-   <> show pktEncrypted
   <> ", pktSndr = "
   <> show pktSndr
   <> ", pktRcvr = "
   <> show pktRcvr
+   <> ", pktSndrTick = "
+   <> show pktSndrTick
+   <> ", pktRcvrTick = "
+   <> show pktRcvrTick
   <> ", pktOrigin = "
   <> show pktOrigin
   <> ", pktContent = "
-   <> showUD (bytesAtom $ unBytes pktContent)
+   <> showUD (bytesAtom pktContent)
   <> "}"

+{-
+-- Wire format
+data PacketHeader = PacketHeader
+  { pktIsAmes    :: Bool       -- sim_o
+  , pktVersion   :: Word3      -- ver_y
+  , pktSndrClass :: ShipClass  -- sac_y
+  , pktRcvrClass :: ShipClass  -- rac_y
+  , pktChecksum  :: Word20     -- mug_l
+  , pktIsRelayed :: Bool       -- rel_o
+  }
+  deriving Eq
+
+data PacketBody = PacketBody
+  { pktSndr     :: Ship               -- sen_d
+  , pktRcvr     :: Ship               -- rec_d
+  , pktSndrTick :: Word4              -- sic_y
+  , pktRcvrTick :: Word4              -- ric_y
+  , pktContent  :: ByteString         -- (con_s, con_y)
+  , pktOrigin   :: Maybe AmesAddress  -- rog_d
+  }
+  deriving Eq
+-}
+
+type Word3 = Word8
+type Word4 = Word8
+type Word20 = Word32
+
+data ShipClass
+  = Lord
+  | Planet
+  | Moon
+  | Comet
+  deriving (Eq, Show)
+
+muk :: ByteString -> Word20
+muk bs = mugBS bs .&. (2 ^ 20 - 1)
+
+-- XX check this
+getAmesAddress :: Get AmesAddress
+getAmesAddress = AAIpv4 <$> (Ipv4 <$> getWord32le) <*> (Port <$> getWord16le)
+
+putAmesAddress :: Putter AmesAddress
+putAmesAddress = \case
+  AAIpv4 (Ipv4 ip) (Port port) -> putWord32le ip >> putWord16le port
+
 instance Serialize Packet where
  get = do
    -- header
    head <- getWord32le
-    let pktVersion   =         head    .&. 0b111        & fromIntegral
-    let checksum     = shiftR  head  3 .&. (2 ^ 20 - 1)
-    let sndrRank     = shiftR  head 23 .&. 0b11
-    let rcvrRank     = shiftR  head 25 .&. 0b11
-    let pktEncrypted = testBit head 27  &  not  -- loobean
-    -- verify checksum
+    -- skip first three bits
+    let isAmes     = testBit head  3  &  not
+    let pktVersion = shiftR  head  4 .&. 0b111 & fromIntegral
+    let sndrRank   = shiftR  head  7 .&. 0b11
+    let rcvrRank   = shiftR  head  9 .&. 0b11
+    let checksum   = shiftR  head 11 .&. (2 ^ 20 - 1)
+    let isRelayed  = testBit head 31  &  not  -- loobean
+    let sndrClass = genericIndex [Lord, Planet, Moon, Comet] sndrRank
+    let rcvrClass = genericIndex [Lord, Planet, Moon, Comet] rcvrRank
+    guard isAmes
+
+    pktOrigin <- if isRelayed
+      then Just <$> getAmesAddress
+      else pure Nothing
+
+    -- body
    lookAhead $ do
-      len  <- remaining
+      len <- remaining
      body <- getBytes len
-      let chk = fromIntegral (mugBS body) .&. (2 ^ 20 - 1)
+      let chk = muk body
      when (checksum /= chk) $
        fail ("checksum mismatch: expected " <> show checksum
           <> "; got " <> show chk)
-    -- body
-    pktSndr <- getShip sndrRank
-    pktRcvr <- getShip rcvrRank
-    len     <- remaining
-    payload <- getBytes len
-    -- data ("payload")
-    (pktOrigin, pktContent) <- case cueBS payload of
-          Left  e -> fail (show e)
-          Right n -> case fromNounErr n of
-            Left  e -> fail (show e)
-            Right c -> pure c
-    pure Packet {..}
+
+    tick <- getWord8
+    let pktSndrTick = tick .&. 0b1111
+    let pktRcvrTick = shiftR tick 4
+
+    pktSndr <- getShip sndrClass
+    pktRcvr <- getShip rcvrClass
+
+    len <- remaining
+    pktContent <- getBytes len
+
+    pure Packet{..}
    where
      getShip = fmap Ship . \case
-        0 -> fromIntegral <$> getWord16le              -- galaxy / star
-        1 -> fromIntegral <$> getWord32le              -- planet
-        2 -> fromIntegral <$> getWord64le              -- moon
-        3 -> LargeKey <$> getWord64le <*> getWord64le  -- comet
-        _ -> fail "impossibiru"
+        Lord   -> fromIntegral <$> getWord16le
+        Planet -> fromIntegral <$> getWord32le
+        Moon   -> fromIntegral <$> getWord64le
+        Comet  -> LargeKey <$> getWord64le <*> getWord64le

-  put Packet {..} = do
-    let load = jamBS $ toNoun (pktOrigin, pktContent)
+  put Packet{..} = do
    let (sndR, putSndr) = putShipGetRank pktSndr
    let (rcvR, putRcvr) = putShipGetRank pktRcvr
-    let body = runPut (putSndr <> putRcvr <> putByteString load)
-    let chek = fromIntegral (mugBS body) .&. (2 ^ 20 - 1)
-    let encr = pktEncrypted
+
+    let body = runPut $ do
+          putWord8 $ (pktSndrTick .&. 0b1111)
+                 .|. shiftL (pktRcvrTick .&. 0b1111) 4
+          putSndr
+          putRcvr
+          putByteString pktContent
+
    let vers = fromIntegral pktVersion .&. 0b111
-    let head =        vers
-           .|. shiftL chek                  3
-           .|. shiftL sndR                 23
-           .|. shiftL rcvR                 25
-           .|. if     encr then 0 else bit 27
+    let chek = muk body
+
+    -- skip first 3 bytes, set 4th to yes (0) for "is ames"
+    let head = shiftL vers 4
+           .|. shiftL sndR 7
+           .|. shiftL rcvR 9
+           .|. shiftL chek 11
+           .|. if isJust pktOrigin then 0 else bit 31
+
    putWord32le head
-    putByteString body  -- XX can we avoid copy?
+    case pktOrigin of
+      Just o  -> putAmesAddress o
+      Nothing -> pure ()
+    putByteString body
    where
      putShipGetRank s@(Ship (LargeKey p q)) = case () of
-        _ | s < 2 ^ 16 -> (0, putWord16le $ fromIntegral s)    -- gar
-          | s < 2 ^ 32 -> (1, putWord32le $ fromIntegral s)    -- pan
-          | s < 2 ^ 64 -> (2, putWord64le $ fromIntegral s)    -- mon
-          | otherwise  -> (3, putWord64le p >> putWord64le q)  -- com
+        _ | s < 2 ^ 16 -> (0, putWord16le $ fromIntegral s)    -- lord
+          | s < 2 ^ 32 -> (1, putWord32le $ fromIntegral s)    -- planet
+          | s < 2 ^ 64 -> (2, putWord64le $ fromIntegral s)    -- moon
+          | otherwise  -> (3, putWord64le p >> putWord64le q)  -- comet
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs
@ -39,7 +39,7 @@ import Network.Socket

 import Control.Monad.STM         (retry)
 import Network.Socket.ByteString (recvFrom, sendTo)
-
+import Urbit.Vere.Stat           (AmesStat(..), bump)

 -- Types -----------------------------------------------------------------------

@ -156,8 +156,9 @@ realUdpServ
   . (HasLogFunc e, HasPortControlApi e)
  => PortNumber
  -> HostAddress
+  -> AmesStat
  -> RIO e UdpServ
-realUdpServ por hos = do
+realUdpServ por hos sat = do
  logInfo $ displayShow ("AMES", "UDP", "Starting real UDP server.")

  env <- ask
@ -192,6 +193,7 @@ realUdpServ por hos = do
      enqueueRecvPacket p a b = do
        did <- atomically (tryWriteTBQueue qRecv (p, a, b))
        when (did == False) $ do
+          bump (asUqf sat)
          logWarn $ displayShow $ ("AMES", "UDP",)
            "Dropping inbound packet because queue is full."

@ -232,13 +234,16 @@ realUdpServ por hos = do
      Just sk -> do
        recvPacket sk >>= \case
          Left exn -> do
+            bump (asUdf sat)
            logError "AMES: UDP: Failed to receive packet"
            signalBrokenSocket sk
          Right Nothing -> do
+            bump (asUi6 sat)
            logError "AMES: UDP: Dropping non-ipv4 packet"
            pure ()
          Right (Just (b, p, a)) -> do
            logDebug "AMES: UDP: Received packet."
+            bump (asUdp sat)
            enqueueRecvPacket p a b

  let shutdown = do
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs
@ -10,7 +10,7 @@ module Urbit.Vere.Behn (behn, DriverApi(..), behn') where

 import Data.Time.Clock.System (SystemTime)

-import Urbit.Arvo            hiding (Behn)
+import Urbit.Arvo
 import Urbit.Prelude
 import Urbit.Vere.Pier.Types

--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/KingSubsite.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/KingSubsite.hs
@ -13,16 +13,15 @@ import Urbit.Prelude hiding (Builder)

 import Data.ByteString.Builder
 import Urbit.King.Scry
-import Urbit.Vere.Serf.Types

 import Data.Conduit       (ConduitT, Flush(..), yield)
 import Data.Text.Encoding (encodeUtf8Builder)
+import Urbit.Vere.Stat    (RenderedStat)

 import qualified Data.Text.Encoding  as E
 import qualified Network.HTTP.Types  as H
 import qualified Network.Wai         as W
 import qualified Network.Wai.Conduit as W
-import qualified Urbit.Noun.Time     as Time

 newtype KingSubsite = KS { runKingSubsite :: W.Application }

@ -43,10 +42,11 @@ streamSlog a = do

 kingSubsite :: HasLogFunc e
            => Ship
-            -> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+            -> ScryFunc
+            -> IO RenderedStat
            -> TVar ((Atom, Tank) -> IO ())
            -> RAcquire e KingSubsite
-kingSubsite who scry func = do
+kingSubsite who scry stat func = do
  clients <- newTVarIO (mempty :: Map Word (SlogAction -> IO ()))
  nextId  <- newTVarIO (0 :: Word)
  baton   <- newTMVarIO ()
@ -77,15 +77,29 @@ kingSubsite who scry func = do
          else
            let loop = yield Flush
                    >> forever (atomically (readTQueue q) >>= streamSlog)
-            in  respond $ W.responseSource (H.mkStatus 200 "OK") heads loop)
+            in  respond $ W.responseSource (H.mkStatus 200 "OK") slogHeads loop)
+
+    ["~_~", "stat"] -> do
+      authed <- authenticated env req
+      if not authed
+        then respond $ emptyResponse 403 "Permission Denied"
+        else do
+          lines <- stat
+          let msg = mconcat ((<> "\n") . encodeUtf8Builder <$> lines)
+                 <> "\nRefresh for more current data."
+          respond $ W.responseBuilder (H.mkStatus 200 "OK") statHeads msg

    _ -> respond $ emptyResponse 404 "Not Found"

  where
-    heads = [ ("Content-Type" , "text/event-stream")
-            , ("Cache-Control", "no-cache")
-            , ("Connection"   , "keep-alive")
-            ]
+    slogHeads = [ ("Content-Type",  "text/event-stream")
+                , ("Cache-Control", "no-cache")
+                , ("Connection",    "keep-alive")
+                ]
+    
+    statHeads = [ ("Content-Type",  "text/plain")
+                , ("Cache-Control", "no-cache")
+                ]

    emptyResponse cod mes = W.responseLBS (H.mkStatus cod mes) [] ""

@ -102,7 +116,7 @@ kingSubsite who scry func = do
              => Text
              -> RIO e (Maybe Bool)
    scryAuth cookie =
-      scryNow scry "ex" who "" ["authenticated", "cookie", textAsTa cookie]
+      scryNow scry "ex" "" ["authenticated", "cookie", textAsTa cookie]

 fourOhFourSubsite :: Ship -> KingSubsite
 fourOhFourSubsite who = KS $ \req respond ->
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@ -23,6 +23,7 @@ import RIO.Directory
 import Urbit.Arvo
 import Urbit.King.App
 import Urbit.Vere.Pier.Types
+import Urbit.Vere.Stat

 import Control.Monad.STM      (retry)
 import System.Environment     (getExecutablePath)
@ -31,11 +32,11 @@ import System.Posix.Files     (ownerModes, setFileMode)
 import Urbit.EventLog.LMDB    (EventLog)
 import Urbit.EventLog.Event   (buildLogEvent)
 import Urbit.King.API         (TermConn)
-import Urbit.Noun.Time        (Wen)
 import Urbit.TermSize         (TermSize(..), termSize)
 import Urbit.Vere.Serf        (Serf)

 import qualified Data.Text                   as T
+import qualified Data.List as L
 import qualified System.Entropy              as Ent
 import qualified Urbit.EventLog.LMDB         as Log
 import qualified Urbit.King.API              as King
@ -71,16 +72,22 @@ setupPierDirectory shipPath = do

 -- Load pill into boot sequence. -----------------------------------------------

+data CannotBootFromIvoryPill = CannotBootFromIvoryPill
+  deriving (Show, Exception)
+
 genEntropy :: MonadIO m => m Entropy
 genEntropy = Entropy . fromIntegral . bytesAtom <$> io (Ent.getEntropy 64)

-genBootSeq :: MonadIO m => Ship -> Pill -> Bool -> LegacyBootEvent -> m BootSeq
-genBootSeq ship Pill {..} lite boot = io $ do
-  ent <- genEntropy
-  let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums
-  pure $ BootSeq ident pBootFormulas ovums
+genBootSeq :: HasKingEnv e
+           => Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq
+genBootSeq _    PillIvory {}   _    _    = throwIO CannotBootFromIvoryPill
+genBootSeq ship PillPill  {..} lite boot = do
+  ent <- io genEntropy
+  wyr <- wyrd
+  let ova = preKern ent <> [wyr] <> pKernelOva <> postKern <> pUserspaceOva
+  pure $ BootSeq ident pBootFormulae ova
 where
-  ident = LogIdentity ship isFake (fromIntegral $ length pBootFormulas)
+  ident = LogIdentity ship isFake (fromIntegral $ length pBootFormulae)
  preKern ent =
    [ EvBlip $ BlipEvArvo $ ArvoEvWhom () ship
    , EvBlip $ BlipEvArvo $ ArvoEvWack () ent
@ -295,14 +302,18 @@ pier (serf, log) vSlog startedSig injected = do
  let execute = writeTQueue executeQ
  let persist = writeTQueue persistQ
  let sigint  = Serf.sendSIGINT serf
-  let scry    = \w b g -> do
+  let scry    = \g r -> do
        res <- newEmptyMVar
-        atomically $ writeTQueue scryQ (w, b, g, putMVar res)
+        atomically $ writeTQueue scryQ (g, r, putMVar res)
        takeMVar res

+  -- Set up the runtime stat counters.
+  stat <- newStat
+
  -- Set up the runtime subsite server and its capability to slog
+  -- and display stats.
  siteSlog <- newTVarIO (const $ pure ())
-  runtimeSubsite <- Site.kingSubsite ship scry siteSlog
+  runtimeSubsite <- Site.kingSubsite ship scry (renderStat stat) siteSlog

  --  Slogs go to stderr, to the runtime subsite, and to the terminal.
  env <- ask
@ -311,12 +322,12 @@ pier (serf, log) vSlog startedSig injected = do
      io $ readTVarIO siteSlog >>= ($ s)
      logOther "serf" (display $ T.strip $ tankToText tank)

+  let err = atomically . Term.trace muxed . (<> "\r\n")
  (bootEvents, startDrivers) <- do
    env <- ask
-    let err = atomically . Term.trace muxed . (<> "\r\n")
    siz <- atomically $ Term.curDemuxSize demux
    let fak = isFake logId
-    drivers env ship fak compute scry (siz, muxed) err sigint runtimeSubsite
+    drivers env ship fak compute scry (siz, muxed) err sigint stat runtimeSubsite

  let computeConfig = ComputeConfig { ccOnWork      = takeTMVar computeQ
                                    , ccOnKill      = onKill
@ -330,6 +341,8 @@ pier (serf, log) vSlog startedSig injected = do

  tSerf <- acquireWorker "Serf" (runCompute serf computeConfig)

+  doVersionNegotiation compute err
+
  -- Run all born events and retry them until they succeed.
  wackEv <- EvBlip . BlipEvArvo . ArvoEvWack () <$> genEntropy
  rio $ for_ (wackEv : bootEvents) $ \ev -> do
@ -341,7 +354,7 @@ pier (serf, log) vSlog startedSig injected = do
        cb :: Int -> WorkError -> IO ()
        cb n | n >= 3 = error ("boot event failed: " <> show ev)
        cb n          = \case
-          RunOkay _         -> putMVar okaySig ()
+          RunOkay _ _       -> putMVar okaySig ()
          RunSwap _ _ _ _ _ -> putMVar okaySig ()
          RunBail _         -> inject (n + 1)

@ -368,7 +381,7 @@ pier (serf, log) vSlog startedSig injected = do
    let inject = atomically $ compute $ RRWork $ EvErr ev $ cb
        cb :: WorkError -> IO ()
        cb = \case
-          RunOkay _         -> putMVar okaySig (Right ())
+          RunOkay _ _       -> putMVar okaySig (Right ())
          RunSwap _ _ _ _ _ -> putMVar okaySig (Right ())
          RunBail goofs     -> putMVar okaySig (Left goofs)

@ -409,6 +422,68 @@ death tag tid = do
    Left  exn -> Left (tag, exn)
    Right ()  -> Right tag

+-- %wyrd version negotiation ---------------------------------------------------
+
+data PierVersionNegotiationFailed = PierVersionNegotiationFailed
+ deriving (Show, Exception)
+
+zuseVersion :: Word
+zuseVersion = 420
+
+wyrd :: HasKingEnv e => RIO e Ev
+wyrd = do
+  king <- tshow <$> view kingIdL
+
+  let k   = Wynn [("zuse", zuseVersion),
+                  ("lull", 330),
+                  ("arvo", 240),
+                  ("hoon", 140),
+                  ("nock", 4)]
+      sen = MkTerm king
+      v   = Vere sen [Cord "king-haskell", Cord "1.0"] k
+
+  pure $ EvBlip $ BlipEvArvo $ ArvoEvWyrd () v
+
+doVersionNegotiation
+  :: HasPierEnv e
+  => (RunReq -> STM ())
+  -> (Text -> RIO e ())
+  -> RAcquire e ()
+doVersionNegotiation compute stderr = do
+  ev <- rio wyrd
+
+  okaySig :: MVar (Either [Goof] FX) <- newEmptyMVar
+  let inject = atomically $ compute $ RRWork $ EvErr ev $ cb
+      cb :: WorkError -> IO ()
+      cb = \case
+        RunOkay _ fx       -> putMVar okaySig (Right fx)
+        RunSwap _ _ _ _ fx -> putMVar okaySig (Right fx)
+        RunBail goofs      -> putMVar okaySig (Left goofs)
+
+  rio $ stderr "vere: checking version compatibility"
+  io inject
+
+  takeMVar okaySig >>= \case
+    Left goof -> do
+      rio $ stderr "pier: version negotation failed"
+      logError $ display @Text ("Goof in wyrd event: " <> tshow goof)
+      throwIO PierVersionNegotiationFailed
+
+    Right fx  -> do
+      -- Walk through the returned fx looking for a wend effect. If we find
+      -- one, check the zuse versions.
+      rio $ for_ fx $ \case
+        GoodParse (EfWend (Wynn xs)) -> case L.lookup "zuse" xs of
+          Nothing -> pure ()
+          Just zuseVerInWynn ->
+            if zuseVerInWynn /= zuseVersion
+            then do
+              rio $ stderr "pier: pier: version negotiation failed; downgrade"
+              throwIO PierVersionNegotiationFailed
+            else
+              pure ()
+        _ -> pure ()
+

 -- Start All Drivers -----------------------------------------------------------

@ -427,16 +502,19 @@ drivers
  -> Ship
  -> Bool
  -> (RunReq -> STM ())
-  -> (Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+  -> ScryFunc
  -> (TermSize, Term.Client)
  -> (Text -> RIO e ())
  -> IO ()
+  -> Stat
  -> Site.KingSubsite
  -> RAcquire e ([Ev], RAcquire e Drivers)
-drivers env who isFake plan scry termSys stderr serfSIGINT sub = do
+drivers env who isFake plan scry termSys stderr serfSIGINT stat sub = do
+  let Stat{..} = stat
+
  (behnBorn, runBehn) <- rio Behn.behn'
-  (termBorn, runTerm) <- rio (Term.term' termSys serfSIGINT)
-  (amesBorn, runAmes) <- rio (Ames.ames' who isFake scry stderr)
+  (termBorn, runTerm) <- rio (Term.term' termSys (renderStat stat) serfSIGINT)
+  (amesBorn, runAmes) <- rio (Ames.ames' who isFake statAmes scry stderr)
  (httpBorn, runEyre) <- rio (Eyre.eyre' who isFake stderr sub)
  (clayBorn, runClay) <- rio Clay.clay'
  (irisBorn, runIris) <- rio Iris.client'
@ -494,6 +572,7 @@ router slog waitFx Drivers {..} = do
      case ef of
        GoodParse (EfVega _ _              ) -> vega
        GoodParse (EfExit _ _              ) -> exit
+        GoodParse (EfWend _                ) -> pure ()
        GoodParse (EfVane (VEBehn       ef)) -> io (dBehn ef)
        GoodParse (EfVane (VEBoat       ef)) -> io (dSync ef)
        GoodParse (EfVane (VEClay       ef)) -> io (dSync ef)
@ -529,7 +608,7 @@ data ComputeConfig = ComputeConfig
  { ccOnWork      :: STM RunReq
  , ccOnKill      :: STM ()
  , ccOnSave      :: STM ()
-  , ccOnScry      :: STM (Wen, Gang, Path, Maybe (Term, Noun) -> IO ())
+  , ccOnScry      :: STM (Gang, ScryReq, Maybe (Term, Noun) -> IO ())
  , ccPutResult   :: (Fact, FX) -> STM ()
  , ccShowSpinner :: Maybe Text -> STM ()
  , ccHideSpinner :: STM ()
@ -543,7 +622,7 @@ runCompute serf ComputeConfig {..} = do
  let onRR = asum [ ccOnKill <&> Serf.RRKill
                  , ccOnSave <&> Serf.RRSave
                  , ccOnWork
-                  , ccOnScry <&> \(w,g,p,k) -> Serf.RRScry w g p k
+                  , ccOnScry <&> \(g,r,k) -> Serf.RRScry g r k
                  ]

  vEvProcessing :: TMVar Ev <- newEmptyTMVarIO
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
@ -14,10 +14,11 @@ module Urbit.Vere.Pier.Types
  , jobId
  , jobMug
  , DriverApi(..)
+  , ScryFunc
  )
 where

-import Urbit.Prelude hiding (Term)
+import Urbit.Prelude

 import Urbit.Arvo
 import Urbit.Noun.Time
@ -44,11 +45,14 @@ instance Show Nock where

 --------------------------------------------------------------------------------

-data Pill = Pill
-  { pBootFormulas   :: ![Nock]
-  , pKernelOvums    :: ![Ev]
-  , pUserspaceOvums :: ![Ev]
-  }
+data Pill
+  = PillIvory [Noun]
+  | PillPill
+    { pName         :: Noun
+    , pBootFormulae :: ![Nock]  -- XX not actually nock, semantically
+    , pKernelOva    :: ![Ev]
+    , pUserspaceOva :: ![Ev]
+    }
 deriving (Eq, Show)

 data BootSeq = BootSeq !LogIdentity ![Nock] ![Ev]
@ -87,6 +91,10 @@ data DriverApi ef = DriverApi
  }


+-- Scrying  --------------------------------------------------------------------
+
+type ScryFunc = Gang -> ScryReq -> IO (Maybe (Term, Noun))
+
 -- Instances -------------------------------------------------------------------

 instance ToNoun Work where
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
@ -16,15 +16,16 @@
  |%
  ::  +writ: from king to serf
  ::
-  +$  gang  (unit (set ship))
  +$  writ
    $%  $:  %live
            $%  [%cram eve=@]
                [%exit cod=@]
                [%save eve=@]
+                [%meld ~]
                [%pack ~]
        ==  ==
-        [%peek mil=@ now=@da lyc=gang pat=path]
+        :: sam=[gang (each path $%([%once @tas @tas path] [beam @tas beam]))]
+        [%peek mil=@ sam=*]
        [%play eve=@ lit=(list ?((pair @da ovum) *))]
        [%work mil=@ job=(pair @da ovum)]
    ==
@ -33,7 +34,8 @@
  +$  plea
    $%  [%live ~]
        [%ripe [pro=%1 hon=@ nok=@] eve=@ mug=@]
-        [%slog pri=@ ?(cord tank)]
+        [%slog pri=@ tank]
+        [%flog cord]
        $:  %peek
            $%  [%done dat=(unit (cask))]
                [%bail dud=goof]
@ -48,6 +50,7 @@
                [%bail lud=(list goof)]
        ==  ==
    ==
+  --
  ```
 -}

@ -84,7 +87,8 @@ import Foreign.Ptr                  (castPtr)
 import Foreign.Storable             (peek, poke)
 import RIO.Prelude                  (decodeUtf8Lenient)
 import System.Posix.Signals         (sigINT, sigKILL, signalProcess)
-import Urbit.Arvo                   (Ev, FX)
+import Urbit.Arvo                   (FX)
+import Urbit.Arvo.Event
 import Urbit.Noun.Time              (Wen)

 import qualified Data.ByteString        as BS
@ -171,9 +175,9 @@ recvPleaHandlingSlog :: Serf -> IO Plea
 recvPleaHandlingSlog serf = loop
 where
  loop = recvPlea serf >>= \case
-    PSlog info -> serfSlog serf info >> loop
-    other      -> pure other
-
+    PSlog info        -> serfSlog serf info >> loop
+    PFlog (Cord ofni) -> serfSlog serf (0, Tank $ Leaf $ Tape $ ofni) >> loop
+    other             -> pure other

 -- Higher-Level IPC Functions --------------------------------------------------

@ -219,9 +223,9 @@ sendCompactionRequest serf = do
  sendWrit serf (WLive $ LPack ())
  recvLive serf

-sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun))
-sendScryRequest serf w g p = do
-  sendWrit serf (WPeek 0 w g p)
+sendScryRequest :: Serf -> Gang -> ScryReq -> IO (Maybe (Term, Noun))
+sendScryRequest serf g r = do
+  sendWrit serf (WPeek 0 g r)
  recvPeek serf

 sendShutdownRequest :: Serf -> Atom -> IO ()
@ -370,10 +374,9 @@ compact serf = withSerfLockIO serf $ \ss -> do
 {-|
  Peek into the serf state.
 -}
-scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun))
-scry serf w g p = withSerfLockIO serf $ \ss -> do
-  (ss,) <$> sendScryRequest serf w g p
-
+scry :: Serf -> Gang -> ScryReq -> IO (Maybe (Term, Noun))
+scry serf g r = withSerfLockIO serf $ \ss -> do
+  (ss,) <$> sendScryRequest serf g r

 {-|
  Given a list of boot events, send them to to the serf in a single
@ -493,7 +496,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
    RRSave ()      -> doSave
    RRKill ()      -> doKill
    RRPack ()      -> doPack
-    RRScry w g p k -> doScry w g p k
+    RRScry g r k   -> doScry g r k

  doPack :: IO ()
  doPack = compact serf >> topLoop
@ -511,8 +514,8 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
  doKill :: IO ()
  doKill = waitForLog >> snapshot serf >> pure ()

-  doScry :: Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO ()
-  doScry w g p k = (scry serf w g p >>= k) >> topLoop
+  doScry :: Gang -> ScryReq -> (Maybe (Term, Noun) -> IO ()) -> IO ()
+  doScry g r k = (scry serf g r >>= k) >> topLoop

  doWork :: EvErr -> IO ()
  doWork firstWorkErr = do
@ -529,13 +532,13 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
    RRKill ()      -> atomically (closeTBMQueue que) >> pure doKill
    RRSave ()      -> atomically (closeTBMQueue que) >> pure doSave
    RRPack ()      -> atomically (closeTBMQueue que) >> pure doPack
-    RRScry w g p k -> atomically (closeTBMQueue que) >> pure (doScry w g p k)
+    RRScry g r k   -> atomically (closeTBMQueue que) >> pure (doScry g r k)
    RRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que

  onWorkResp :: Wen -> EvErr -> Work -> IO ()
  onWorkResp wen (EvErr evn err) = \case
    WDone eid hash fx -> do
-      io $ err (RunOkay eid)
+      io $ err (RunOkay eid fx)
      atomically $ sendOn ((Fact eid hash wen (toNoun evn)), fx)
    WSwap eid hash (wen, noun) fx -> do
      io $ err (RunSwap eid hash wen noun fx)
@ -543,6 +546,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
    WBail goofs -> do
      io $ err (RunBail goofs)

+
 {-|
  Given:

--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC/Types.hs
@ -35,7 +35,7 @@ data Work

 data Writ
  = WLive Live
-  | WPeek Atom Wen Gang Path
+  | WPeek Atom Gang ScryReq
  | WPlay EventId [Noun]
  | WWork Atom Wen Ev
 deriving (Show)
@ -44,6 +44,7 @@ data Plea
  = PLive ()
  | PRipe SerfInfo
  | PSlog Slog
+  | PFlog Cord
  | PPeek Scry
  | PPlay Play
  | PWork Work
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs
@ -2,7 +2,7 @@ module Urbit.Vere.Serf.Types where

 import Urbit.Prelude

-import Urbit.Arvo      (Ev, FX)
+import Urbit.Arvo      (Desk, Ev, FX)
 import Urbit.Noun.Time (Wen)


@ -82,7 +82,7 @@ data EvErr = EvErr Ev (WorkError -> IO ())
 data WorkError -- TODO Rename type and constructors
  = RunSwap EventId Mug Wen Noun FX -- TODO Maybe provide less info here?
  | RunBail [Goof]
-  | RunOkay EventId
+  | RunOkay EventId FX

 {-
  - RRWork: Ask the serf to do work, will output (Fact, FX) if work
@ -94,7 +94,19 @@ data RunReq
  | RRSave ()
  | RRKill ()
  | RRPack ()
-  | RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ())
+  | RRScry Gang ScryReq (Maybe (Term, Noun) -> IO ())
+
+type ScryReq = (Each Path Demi)
+
+data Demi
+  = DemiOnce Term Desk Path
+  | DemiBeam Term Beam
+  deriving (Show)
+
+-- TODO
+type Beam = Void
+
+deriveNoun ''Demi


 -- Exceptions ------------------------------------------------------------------
@ -111,6 +123,8 @@ data SerfExn
  | SerfNotRunning
  | MissingBootEventsInEventLog Word Word
  | SnapshotAheadOfLog EventId EventId
+  | BailDuringWyrd [Goof]
+  | SwapDuringWyrd Mug (Wen, Noun) FX
 deriving (Show, Exception)


--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Stat.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Stat.hs
@ -0,0 +1,75 @@
+module Urbit.Vere.Stat where
+
+import Urbit.Prelude
+
+data Stat = Stat
+  { statAmes :: AmesStat
+  }
+
+data AmesStat = AmesStat
+  { asUdp :: TVar Word
+  , asUqf :: TVar Word
+  , asUdf :: TVar Word
+  , asUi6 :: TVar Word
+  , asRcv :: TVar Word
+  , asSup :: TVar Word
+  , asSrf :: TVar Word
+  , asQuf :: TVar Word
+  , asFwd :: TVar Word
+  , asDrt :: TVar Word
+  , asDvr :: TVar Word
+  , asDml :: TVar Word
+  , asSwp :: TVar Word
+  , asBal :: TVar Word
+  , asOky :: TVar Word
+  }
+
+newStat :: MonadIO m => m Stat
+newStat = do
+  asUdp <- newTVarIO 0
+  asUqf <- newTVarIO 0
+  asUdf <- newTVarIO 0
+  asUi6 <- newTVarIO 0
+  asRcv <- newTVarIO 0
+  asSup <- newTVarIO 0
+  asSrf <- newTVarIO 0
+  asQuf <- newTVarIO 0
+  asFwd <- newTVarIO 0
+  asDrt <- newTVarIO 0
+  asDvr <- newTVarIO 0
+  asDml <- newTVarIO 0
+  asSwp <- newTVarIO 0
+  asBal <- newTVarIO 0
+  asOky <- newTVarIO 0
+  pure Stat{statAmes = AmesStat{..}}
+
+bump :: MonadIO m => TVar Word -> m ()
+bump s = atomically $ bump' s
+
+bump' :: TVar Word -> STM ()
+bump' s = modifyTVar' s (+ 1)
+
+type RenderedStat = [Text]
+
+renderStat :: MonadIO m => Stat -> m RenderedStat
+renderStat Stat{statAmes = AmesStat{..}} =
+  sequence
+    [ pure "stat:"
+    , pure "  ames:"
+    ,     ("    udp ingress:             " <>) <$> tshow <$> readTVarIO asUdp
+    ,     ("    udp queue evict:         " <>) <$> tshow <$> readTVarIO asUqf
+    ,     ("    udp recv fail:           " <>) <$> tshow <$> readTVarIO asUdf
+    ,     ("    udp dropped non-ipv4:    " <>) <$> tshow <$> readTVarIO asUi6
+    ,     ("    driver ingress:          " <>) <$> tshow <$> readTVarIO asRcv
+    ,     ("    enqueued for serf:       " <>) <$> tshow <$> readTVarIO asSup
+    ,     ("    sent to serf:            " <>) <$> tshow <$> readTVarIO asSrf
+    ,     ("    serf queue evict:        " <>) <$> tshow <$> readTVarIO asQuf
+    ,     ("    forwarded:               " <>) <$> tshow <$> readTVarIO asFwd
+    ,     ("    dropped (unroutable):    " <>) <$> tshow <$> readTVarIO asDrt
+    ,     ("    dropped (wrong version): " <>) <$> tshow <$> readTVarIO asDvr
+    ,     ("    dropped (malformed):     " <>) <$> tshow <$> readTVarIO asDml
+    ,     ("    serf swapped:            " <>) <$> tshow <$> readTVarIO asSwp
+    ,     ("    serf bailed:             " <>) <$> tshow <$> readTVarIO asBal
+    ,     ("    serf okay:               " <>) <$> tshow <$> readTVarIO asOky
+    ]
+
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs
@ -27,6 +27,7 @@ import Urbit.Vere.Pier.Types
 import Data.List           ((!!))
 import RIO.Directory       (createDirectoryIfMissing)
 import Urbit.King.API      (readPortsFile)
+import Urbit.Vere.Stat     (RenderedStat)
 import Urbit.TermSize      (TermSize(TermSize))
 import Urbit.Vere.Term.API (Client(Client), ClientTake(..))

@ -558,7 +559,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop
                loop rd
              else if w == 3 then do
                -- ETX (^C)
-                logInfo $ displayShow "Ctrl-c interrupt"
+                logInfo $ "Ctrl-c interrupt"
                atomically $ do
                  writeTQueue wq [Term.Trace "interrupt\r\n"]
                  writeTQueue rq $ Ctl $ Cord "c"
@ -599,9 +600,10 @@ localClient doneSignal = fst <$> mkRAcquire start stop
 term'
  :: HasPierEnv e
  => (TermSize, Client)
+  -> IO RenderedStat
  -> IO ()
  -> RIO e ([Ev], RAcquire e (DriverApi TermEf))
-term' (tsize, client) serfSIGINT = do
+term' (tsize, client) stat serfSIGINT = do
  let TermSize wi hi = tsize
      initEv = [blewEvent wi hi, initialHail]

@ -610,7 +612,7 @@ term' (tsize, client) serfSIGINT = do
  runDriver = do
    env <- ask
    ventQ :: TQueue EvErr <- newTQueueIO
-    diOnEffect <- term env (tsize, client) (writeTQueue ventQ) serfSIGINT
+    diOnEffect <- term env (tsize, client) (writeTQueue ventQ) stat serfSIGINT

    let diEventSource = fmap RRWork <$> tryReadTQueue ventQ

@ -623,9 +625,10 @@ term :: forall e. (HasPierEnv e)
     => e
     -> (TermSize, Client)
     -> (EvErr -> STM ())
+     -> IO RenderedStat
     -> IO ()
     -> RAcquire e (TermEf -> IO ())
-term env (tsize, Client{..}) plan serfSIGINT = runTerm
+term env (tsize, Client{..}) plan stat serfSIGINT = runTerm
  where
    runTerm :: RAcquire e (TermEf -> IO ())
    runTerm = do
--- a/pkg/hs/urbit-king/package.yaml
+++ b/pkg/hs/urbit-king/package.yaml
@ -1,5 +1,5 @@
 name: urbit-king
-version: 0.10.8
+version: 1.1
 license: MIT
 license-file: LICENSE
 data-files:
--- a/pkg/hs/urbit-king/test/AmesTests.hs
+++ b/pkg/hs/urbit-king/test/AmesTests.hs
@ -108,9 +108,10 @@ instance Arbitrary LogIdentity where
 instance Arbitrary Packet where
  arbitrary = do
    pktVersion   <- suchThat arb (< 8)
-    pktEncrypted <- arb
    pktSndr      <- arb
    pktRcvr      <- arb
+    pktSndrTick  <- suchThat arb (< 16)
+    pktRcvrTick  <- suchThat arb (< 16)
    pktOrigin    <- arb
    pktContent   <- arb
    pure Packet {..}
--- a/pkg/hs/urbit-king/test/ArvoTests.hs
+++ b/pkg/hs/urbit-king/test/ArvoTests.hs
@ -31,18 +31,6 @@ roundTrip x = Just x == fromNoun (toNoun x)
 nounEq :: (ToNoun a, ToNoun b) => a -> b -> Bool
 nounEq x y = toNoun x == toNoun y

-data EvExample = EvEx Ev Noun
-  deriving (Eq, Show)
-
-eventSanity :: [EvExample] -> Bool
-eventSanity = all $ \(EvEx e n) -> toNoun e == n
-
-instance Arbitrary EvExample where
-  arbitrary = oneof $ fmap pure $
-    [ EvEx (EvVane $ VaneVane $ VEVeer (Jael, ()) "" (Path []) "")
-           (toNoun (Path ["vane", "vane", "jael"], Cord "veer", (), (), ()))
-    ]
-
 --------------------------------------------------------------------------------

 tests :: TestTree
@ -51,7 +39,6 @@ tests =
    [ testProperty "Round Trip Effect"   (roundTrip @Ef)
    , testProperty "Round Trip Event"    (roundTrip @Ev)
    , testProperty "Round Trip AmesDest" (roundTrip @AmesDest)
-    , testProperty "Basic Event Sanity" eventSanity
    ]


@ -131,24 +118,9 @@ instance Arbitrary BlipEv where
                    ]

 instance Arbitrary Ev where
-  arbitrary = oneof [ EvVane <$> arb
-                    , EvBlip <$> arb
+  arbitrary = oneof [ EvBlip <$> arb
                    ]

-instance Arbitrary Vane where
-  arbitrary = oneof [ VaneVane <$> arb
-                    , VaneZuse <$> arb
-                    ]
-
-instance Arbitrary VaneName where
-  arbitrary = oneof $ pure <$> [minBound .. maxBound]
-
-instance Arbitrary VaneEv where
-  arbitrary = VEVeer <$> arb <*> arb <*> arb <*> arb
-
-instance Arbitrary ZuseEv where
-  arbitrary = ZEVeer () <$> arb <*> arb <*> arb
-
 instance Arbitrary StdMethod where
  arbitrary = oneof $ pure <$> [ minBound .. maxBound ]

--- a/pkg/hs/urbit-king/test/Options.hs
+++ b/pkg/hs/urbit-king/test/Options.hs
@ -35,7 +35,7 @@ instance KnownSymbol name => Options.IsOption (Pill name) where
         )
  
  defaultValue =
-    Pill ( "../../../bin"
+    Pill ( "../../../bin/"
        ++ TypeLits.symbolVal (Proxy @name)
        ++ ".pill"
         )
--- a/pkg/hs/urbit-king/test/gold/hoontree.gold
+++ b/pkg/hs/urbit-king/test/gold/hoontree.gold
@ -1 +1 @@
-2082167031
+233234490
--- a/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
+++ b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
@ -5,6 +5,7 @@ module Urbit.Noun.Mug where
 import ClassyPrelude

 import Data.Bits
+import Data.ByteString.Builder
 import Urbit.Atom

 import Data.Hash.Murmur (murmur3)
@ -13,14 +14,7 @@ type Mug = Word32

 {-# INLINE mugBS #-}
 mugBS :: ByteString -> Word32
-mugBS = go 0xcafebabe
-  where
-    go seed buf =
-      let haz = murmur3 seed buf
-          ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)
-      in if ham == 0
-        then go (seed + 1) buf
-        else ham
+mugBS = mum 0xcafe_babe 0x7fff

 -- XX is there a way to do this without copy?
 {-# INLINE mugAtom #-}
@ -29,4 +23,16 @@ mugAtom = mugBS . atomBytes

 {-# INLINE mugBoth #-}
 mugBoth :: Word32 -> Word32 -> Word32
-mugBoth m n = mugAtom $ fromIntegral $ m `xor` 0x7fff_ffff `xor` n
+mugBoth m n = mum 0xdead_beef 0xfffe
+            $ toStrict $ toLazyByteString (word32LE m <> word32LE n)
+
+mum :: Word32 -> Word32 -> ByteString -> Word32
+mum syd fal key = go syd 0
+  where
+    go syd 8 = fal
+    go syd i =
+      let haz = murmur3 syd key
+          ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)
+      in if ham /= 0
+        then ham
+        else go (syd + 1) (i + 1)
--- a/pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs
+++ b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs
@ -147,7 +147,9 @@ enumFromAtom :: [(String, Name)] -> Exp
 enumFromAtom cons = LamE [VarP x] body
  where
    (x, c)    = (mkName "x", mkName "c")
-    getTag    = BindS (VarP c) $ AppE (VarE 'parseNounUtf8Atom) (VarE x)
+    getTag    = BindS (VarP c)
+              $ AppE (AppE (VarE 'named) matchFail)
+              $ AppE (VarE 'parseNounUtf8Atom) (VarE x)
    examine   = NoBindS $ CaseE (VarE c) (matches ++ [fallback])
    matches   = mkMatch <$> cons
    fallback  = Match WildP (NormalB $ AppE (VarE 'fail) matchFail) []
@ -194,6 +196,7 @@ taggedFromNoun cons = LamE [VarP n] (DoE [getHead, getTag, examine])
            $ AppE (VarE 'parseNoun) (VarE n)

    getTag = BindS (SigP (VarP c) (ConT ''Text))
+           $ AppE (AppE (VarE 'named) tagFail)
           $ AppE (VarE 'parseNounUtf8Atom) (VarE h)

    examine = NoBindS
@ -208,6 +211,8 @@ taggedFromNoun cons = LamE [VarP n] (DoE [getHead, getTag, examine])
    fallback  = Match WildP (NormalB $ AppE (VarE 'fail) matchFail) []
    matchFail = unexpectedTag (fst <$> cons) (VarE c)

+    tagFail = LitE $ StringL (intercalate " " (('%':) <$> (fst <$> cons)))
+
 --------------------------------------------------------------------------------

 tagString :: Int -> Name -> String
--- a/pkg/interface/package-lock.json
+++ b/pkg/interface/package-lock.json
@ -10150,57 +10150,6 @@
              "version": "2.1.1",
              "resolved": "https://registry.npmjs.org/normalize-path/-/normalize-path-2.1.1.tgz",
              "integrity": "sha1-GrKLVW4Zg2Oowab35vogE3/mrtk=",
-              "dev": true,
-              "requires": {
-                "remove-trailing-separator": "^1.0.1"
-              }
-            }
-          }
-        },
-        "binary-extensions": {
-          "version": "1.13.1",
-          "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-1.13.1.tgz",
-          "integrity": "sha512-Un7MIEDdUC5gNpcGDV97op1Ywk748MpHcFTHoYs6qnj1Z3j7I53VG3nwZhKzoBZmbdRNnb6WRdFlwl7tSDuZGw==",
-          "dev": true
-        },
-        "braces": {
-          "version": "2.3.2",
-          "resolved": "https://registry.npmjs.org/braces/-/braces-2.3.2.tgz",
-          "integrity": "sha512-aNdbnj9P8PjdXU4ybaWLK2IF3jc/EoDYbC7AazW6to3TRsfXxscC9UXOB5iDiEQrkyIbWp2SLQda4+QAa7nc3w==",
-          "dev": true,
-          "requires": {
-            "arr-flatten": "^1.1.0",
-            "array-unique": "^0.3.2",
-            "extend-shallow": "^2.0.1",
-            "fill-range": "^4.0.0",
-            "isobject": "^3.0.1",
-            "repeat-element": "^1.1.2",
-            "snapdragon": "^0.8.1",
-            "snapdragon-node": "^2.0.1",
-            "split-string": "^3.0.2",
-            "to-regex": "^3.0.1"
-          }
-        },
-        "chokidar": {
-          "version": "2.1.8",
-          "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-2.1.8.tgz",
-          "integrity": "sha512-ZmZUazfOzf0Nve7duiCKD23PFSCs4JPoYyccjUFF3aQkQadqBhfzhjkwBH2mNOG9cTBwhamM37EIsIkZw3nRgg==",
-          "dev": true,
-          "requires": {
-            "anymatch": "^2.0.0",
-            "async-each": "^1.0.1",
-            "braces": "^2.3.2",
-            "fsevents": "^1.2.7",
-            "glob-parent": "^3.1.0",
-            "inherits": "^2.0.3",
-            "is-binary-path": "^1.0.0",
-            "is-glob": "^4.0.0",
-            "normalize-path": "^3.0.0",
-            "path-is-absolute": "^1.0.0",
-            "readdirp": "^2.2.1",
-            "upath": "^1.1.1"
-          }
-        },
        "extend-shallow": {
          "version": "2.0.1",
          "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz",
--- a/pkg/interface/src/logic/lib/util.ts
+++ b/pkg/interface/src/logic/lib/util.ts
@ -370,11 +370,19 @@ export function useShowNickname(contact: Contact | null, hide?: boolean): boolea
  return !!(contact && contact.nickname && !hideNicknames);
 }

-export function useHovering() {
+interface useHoveringInterface {
+  hovering: boolean;
+  bind: {
+    onMouseOver: () => void,
+    onMouseLeave: () => void
+  }
+}
+
+export const useHovering = (): useHoveringInterface => {
  const [hovering, setHovering] = useState(false);
  const bind = {
-    onMouseEnter: () => setHovering(true),
+    onMouseOver: () => setHovering(true),
    onMouseLeave: () => setHovering(false)
  };
  return { hovering, bind };
-}
+};
--- a/pkg/interface/src/logic/store/store.ts
+++ b/pkg/interface/src/logic/store/store.ts
@ -1,3 +1,5 @@
+import _ from 'lodash';
+
 import BaseStore from './base';
 import InviteReducer from '../reducers/invite-update';
 import MetadataReducer from '../reducers/metadata-update';
@ -28,6 +30,18 @@ export default class GlobalStore extends BaseStore<StoreState> {
  connReducer = new ConnectionReducer();
  settingsReducer = new SettingsReducer();

+  pastActions: Record<string, any> = {}
+
+  constructor() {
+    super();
+    (window as any).debugStore = this.debugStore.bind(this);
+  }
+
+  debugStore(tag: string, ...stateKeys: string[]) {
+    console.log(this.pastActions[tag]);
+    console.log(_.pick(this.state, stateKeys));
+  }
+
  rehydrate() {
    this.localReducer.rehydrate(this.state);
  }
@ -84,6 +98,11 @@ export default class GlobalStore extends BaseStore<StoreState> {
  }

  reduce(data: Cage, state: StoreState) {
+    //  debug shim
+    const tag = Object.keys(data)[0];
+    const oldActions = this.pastActions[tag] || [];
+    this.pastActions[tag] = [data[tag], ...oldActions.slice(0,14)];
+
    this.inviteReducer.reduce(data, this.state);
    this.metadataReducer.reduce(data, this.state);
    this.localReducer.reduce(data, this.state);
--- a/pkg/interface/src/views/apps/launch/components/ModalButton.tsx
+++ b/pkg/interface/src/views/apps/launch/components/ModalButton.tsx
@ -17,7 +17,7 @@ const ModalButton = (props) => {
  return (
    <>
      {modal}
-      <Box
+      <Button
        onClick={showModal}
        display="flex"
        alignItems="center"
@ -30,7 +30,7 @@ const ModalButton = (props) => {
        {...rest}
      >
        <Icon icon={props.icon} mr={2} color={color}></Icon><Text color={color}>{props.text}</Text>
-      </Box>
+      </Button>
    </>
  );
 }
--- a/pkg/interface/src/views/apps/notifications/graph.tsx
+++ b/pkg/interface/src/views/apps/notifications/graph.tsx
@ -180,6 +180,7 @@ const GraphNode = ({
      icon
      color={`#000000`}
      classes="mix-blend-diff"
+      padded
    />
    ) : <Box style={{ width: '16px' }}></Box>;

--- a/pkg/interface/src/views/apps/notifications/inbox.tsx
+++ b/pkg/interface/src/views/apps/notifications/inbox.tsx
@ -1,4 +1,4 @@
-import React, { useEffect, useCallback, useState, useMemo, useRef } from "react";
+import React, { useEffect, useCallback, useRef, useState } from "react";
 import f from "lodash/fp";
 import _ from "lodash";
 import { Icon, Col, Row, Box, Text, Anchor, Rule, Center } from "@tlon/indigo-react";
@ -9,16 +9,13 @@ import { BigInteger } from "big-integer";
 import GlobalApi from "~/logic/api/global";
 import { Notification } from "./notification";
 import { Associations } from "~/types";
-
-import {Invites} from "./invites";
-import {useLazyScroll} from "~/logic/lib/useLazyScroll";
-
-import { cite } from '~/logic/lib/util';
 import { InviteItem } from '~/views/components/Invite';
 import { useWaitForProps } from "~/logic/lib/useWaitForProps";
 import { useHistory } from "react-router-dom";
 import {useModal} from "~/logic/lib/useModal";
 import {JoinGroup} from "~/views/landscape/components/JoinGroup";
+import {Invites} from "./invites";
+import {useLazyScroll} from "~/logic/lib/useLazyScroll";

 type DatedTimebox = [BigInteger, Timebox];

@ -33,7 +30,7 @@ function filterNotification(associations: Associations, groups: string[]) {
    } else if ("group" in n.index) {
      const { group } = n.index.group;
      return groups.findIndex((g) => group === g) !== -1;
-    } 
+    }
    return true;
  };
 }
@ -66,7 +63,7 @@ export default function Inbox(props: {

  const notifications =
    Array.from(props.showArchive ? props.archive : props.notifications) || [];
-  
+
  const calendar = {
    ...MOMENT_CALENDAR_DATE, sameDay: function (now) {
      if (this.subtract(6, 'hours').isBefore(now)) {
@ -99,6 +96,68 @@ export default function Inbox(props: {
  );

  const scrollRef = useRef(null);
+
+  const [joining, setJoining] = useState<[string, string] | null>(null);
+
+  const { modal, showModal } = useModal(
+    { modal: useCallback(
+      (dismiss) => (
+        <JoinGroup
+          groups={props.groups}
+          contacts={props.contacts}
+          api={props.api}
+          autojoin={joining?.[0]?.slice(6)}
+          inviteUid={joining?.[1]}
+        />
+        ),
+      [props.contacts, props.groups, props.api, joining]
+  )})
+
+  const joinGroup = useCallback((group: string, uid: string) => {
+    setJoining([group, uid]);
+    showModal();
+  }, [setJoining, showModal]);
+
+  const acceptInvite = (app: string, uid: string) => async (invite) => {
+    const resource = {
+      ship: `~${invite.resource.ship}`,
+      name: invite.resource.name
+    };
+
+    const resourcePath = resourceAsPath(invite.resource);
+    if(app === 'contacts') {
+      joinGroup(resourcePath, uid);
+    } else if ( app === 'chat') {
+      await api.invite.accept(app, uid);
+      history.push(`/~landscape/home/resource/chat${resourcePath.slice(5)}`);
+    } else if ( app === 'graph') {
+      await api.invite.accept(app, uid);
+      history.push(`/~graph/join${resourcePath}`);
+    }
+  };
+
+
+
+
+  const inviteItems = (invites, api) => {
+    const returned = [];
+    Object.keys(invites).map((appKey) => {
+      const app = invites[appKey];
+      Object.keys(app).map((uid) => {
+        const invite = app[uid];
+        const inviteItem =
+          <InviteItem
+            key={uid}
+            invite={invite}
+            onAccept={acceptInvite(appKey, uid)}
+            onDecline={() => api.invite.decline(appKey, uid)}
+          />;
+        returned.push(inviteItem);
+      });
+    });
+    return returned;
+  };
+
  const loadMore = useCallback(async () => {
    return api.hark.getMore();
  }, [api]);
@ -108,6 +167,7 @@ export default function Inbox(props: {

  return (
    <Col ref={scrollRef} position="relative" height="100%" overflowY="auto">
+      {modal}
      <Invites invites={invites} api={api} associations={associations} />
      {[...notificationsByDayMap.keys()].sort().reverse().map((day, index) => {
        const timeboxes = notificationsByDayMap.get(day)!;
@ -157,7 +217,7 @@ function DaySection({
  groupConfig,
  graphConfig,
 }) {
-  
+
  const lent = timeboxes.map(([,nots]) => nots.length).reduce(f.add, 0);
  if (lent === 0 || timeboxes.length === 0) {
    return null;
--- a/pkg/urbit/jets/tree.c
+++ b/pkg/urbit/jets/tree.c
--- a/pkg/urbit/noun/jets.c
+++ b/pkg/urbit/noun/jets.c
@ -1796,13 +1796,13 @@ _cj_minx(u3_noun cey, u3_noun cor)
 }

 static void
-_cj_print_tas(FILE* fh, u3_noun tas)
+_cj_print_tas(u3_noun tas)
 {
  c3_w  met_w = u3r_met(3, tas);
  c3_c* str_c = alloca(met_w + 1);
  u3r_bytes(0, met_w, (c3_y*)str_c, tas);
  str_c[met_w] = 0;
-  fprintf(fh, "/%s", str_c);
+  u3l_log("/%s", str_c);
 }

 /* _cj_mine(): declare a core and produce location. RETAIN.
@ -1851,7 +1851,7 @@ _cj_mine(u3_noun cey, u3_noun cor, u3_noun bas)
        u3_noun i = bal;
        u3l_log("hot jet: ");
        while ( i != u3_nul ) {
-          _cj_print_tas(stderr, u3h(i));
+          _cj_print_tas(u3h(i));
          i = u3t(i);
        }
        u3l_log("\r\n  axe %d, jax %d,\r\n  bash ", axe, jax_l);
--- a/pkg/urbit/vere/io/fore.c
+++ b/pkg/urbit/vere/io/fore.c
@ -121,14 +121,10 @@ _fore_io_talk(u3_auto* car_u)

  //  set verbose as per -v
  //
-  //    XX should be explicit, not a toggle
-  //
-  if ( c3y == u3_Host.ops_u.veb ) {
-    //  XX this path shouldn't be necessary
-    //
-    wir = u3nt(c3__term, '1', u3_nul);
-    cad = u3nc(c3__verb, u3_nul);
-
+  {
+    c3_o lac_o = ( c3y == u3_Host.ops_u.veb ) ? c3n : c3y;
+    wir = u3nc(c3__arvo, u3_nul);
+    cad = u3nt(c3__verb, u3_nul, lac_o);
    u3_auto_plan(car_u, u3_ovum_init(0, u3_blip, wir, cad));
  }

--- a/pkg/urbit/vere/io/unix.c
+++ b/pkg/urbit/vere/io/unix.c
@ -79,7 +79,7 @@ struct _u3_ufil;
  } u3_unix;

 void
-u3_unix_ef_look(u3_unix* unx_u, u3_noun all);
+u3_unix_ef_look(u3_unix* unx_u, u3_noun mon, u3_noun all);

 /* u3_readdir_r():
 */
@ -609,8 +609,7 @@ static void
 _unix_commit_mount_point(u3_unix* unx_u, u3_noun mon)
 {
  unx_u->dyr = c3y;
-  u3z(mon);
-  u3_unix_ef_look(unx_u, c3n);
+  u3_unix_ef_look(unx_u, mon, c3n);
  return;
 }

@ -1355,19 +1354,25 @@ u3_unix_release(c3_c* pax_c)
  c3_free(paf_c);
 }

-/* u3_unix_ef_look(): update the root.
+/* u3_unix_ef_look(): update the root of a specific mount point.
 */
 void
-u3_unix_ef_look(u3_unix* unx_u, u3_noun all)
+u3_unix_ef_look(u3_unix* unx_u, u3_noun mon, u3_noun all)
 {
  if ( c3y == unx_u->dyr ) {
    unx_u->dyr = c3n;
-    u3_umon* mon_u;
+    u3_umon* mon_u = unx_u->mon_u;

-    for ( mon_u = unx_u->mon_u; mon_u; mon_u = mon_u->nex_u ) {
+    while ( mon_u && ( c3n == u3r_sing_c(mon_u->nam_c, mon) ) ) {
+      mon_u = mon_u->nex_u;
+    }
+
+    if ( mon_u ) {
      _unix_update_mount(unx_u, mon_u, all);
    }
  }
+
+  u3z(mon);
 }

 /* _unix_io_talk(): start listening for fs events.
--- a/pkg/urbit/vere/pier.c
+++ b/pkg/urbit/vere/pier.c
@ -470,6 +470,14 @@ u3_pier_peek_last(u3_pier*   pir_u,
  _pier_peek_plan(pir_u, pic_u);
 }

+/* _pier_stab(): parse path
+*/
+static u3_noun
+_pier_stab(u3_noun pac)
+{
+  return u3do("stab", pac);
+}
+
 /* _pier_on_scry_done(): scry callback.
 */
 static void
@ -482,48 +490,64 @@ _pier_on_scry_done(void* ptr_v, u3_noun nun)
    u3l_log("pier: scry failed\n");
  }
  else {
+    u3_weak out,    pad;
+    c3_c   *ext_c, *pac_c;
+
    u3l_log("pier: scry succeeded\n");

-    //  serialize as desired
+    if ( u3_Host.ops_u.puk_c ) {
+      pac_c = u3_Host.ops_u.puk_c;
+    }
+    else {
+      pac_c = u3_Host.ops_u.pek_c;
+    }
+
+    //  try to serialize as requested
    //
-    u3_atom out;
-    c3_c*   ext_c;
    {
      u3_atom puf = u3i_string(u3_Host.ops_u.puf_c);
      if ( c3y == u3r_sing(c3__jam, puf) ) {
        out   = u3qe_jam(res);
        ext_c = "jam";
      }
-      else {
+      else if ( c3y == u3a_is_atom(res) ) {
        out   = u3dc("scot", u3k(puf), u3k(res));
        ext_c = "txt";
      }
+      else {
+        u3l_log("pier: cannot export cell as %s\n", u3_Host.ops_u.puf_c);
+        out   = u3_none;
+      }
      u3z(puf);
    }

-    c3_c* pac_c = u3_Host.ops_u.puk_c;
-    if (!pac_c) {
-      pac_c = u3_Host.ops_u.pek_c;
-    }
-
-    u3_noun pad;
+    //  try to build export target path
+    //
    {
-      //  XX crashes if [pac_c] is not a valid path
-      //  XX virtualize or fix
-      //
-      u3_noun pax = u3do("stab", u3i_string(pac_c));
-      c3_w len_w = u3kb_lent(u3k(pax));
-      pad = u3nt(c3_s4('.','u','r','b'),
-                 c3_s3('p','u','t'),
-                 u3qb_scag(len_w - 1, pax));
-      u3z(pax);
+      u3_noun pro = u3m_soft(0, _pier_stab, u3i_string(pac_c));
+      if ( 0 == u3h(pro) ) {
+        c3_w len_w = u3kb_lent(u3k(u3t(pro)));
+        pad = u3nt(c3_s4('.', 'u', 'r', 'b'),
+                   c3_s3('p', 'u', 't'),
+                   u3qb_scag(len_w - 1, u3t(pro)));
+      }
+      else {
+        u3l_log("pier: invalid export path %s\n", pac_c);
+        pad = u3_none;
+      }
+      u3z(pro);
    }

-    c3_c fil_c[2048];
-    snprintf(fil_c, 2048, "%s/.urb/put/%s.%s", pir_u->pax_c, pac_c+1, ext_c);
+    //  if serialization and export path succeeded, write to disk
+    //
+    if ( (u3_none != out) && (u3_none != pad) ) {
+      c3_c fil_c[2048];
+      snprintf(fil_c, 2048, "%s/.urb/put/%s.%s",
+               pir_u->pax_c, pac_c+1, ext_c);

-    u3_walk_save(fil_c, 0, out, pir_u->pax_c, pad);
-    u3l_log("pier: scry in %s\n", fil_c);
+      u3_walk_save(fil_c, 0, out, pir_u->pax_c, pad);
+      u3l_log("pier: scry result in %s\n", fil_c);
+    }
  }

  u3l_log("pier: exit\n");
@ -1707,20 +1731,21 @@ _pier_boot_make(u3_noun who, u3_noun wyr, u3_noun ven, u3_noun pil)
  //  prepend entropy and identity to the module sequence
  //
  {
-    u3_noun wir, cad;
+    u3_noun cad, wir = u3nt(u3_blip, c3__arvo, u3_nul);
    c3_w    eny_w[16];
-
    c3_rand(eny_w);
-    wir = u3nt(u3_blip, c3__arvo, u3_nul);
+
+    cad = u3nt(c3__verb, u3_nul, ( c3y == u3_Host.ops_u.veb ) ? c3n : c3y);
+    bot_u.mod = u3nc(u3nc(u3k(wir), cad), bot_u.mod);
+
    cad = u3nc(c3__wack, u3i_words(16, eny_w));
-    bot_u.mod = u3nc(u3nc(wir, cad), bot_u.mod);
+    bot_u.mod = u3nc(u3nc(u3k(wir), cad), bot_u.mod);
+
+    cad = u3nc(c3__whom, who);                    // transfer [who]
+    bot_u.mod = u3nc(u3nc(u3k(wir), cad), bot_u.mod);

    wir = u3nt(u3_blip, c3__arvo, u3_nul);
-    cad = u3nc(c3__whom, who);  // transfer
-    bot_u.mod = u3nc(u3nc(wir, cad), bot_u.mod);
-
-    wir = u3nt(u3_blip, c3__arvo, u3_nul);
-    bot_u.mod = u3nc(u3nc(wir, wyr), bot_u.mod);
+    bot_u.mod = u3nc(u3nc(wir, wyr), bot_u.mod);  // transfer [wir] and [wyr]
  }

  //  prepend legacy boot event to the userspace sequence
--- a/pkg/urbit/version
+++ b/pkg/urbit/version
@ -1 +1 @@
-1.0
+1.1
 @ -1 +1 @@
 .0
 .1