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

bin/solid.pill

@@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:fd78b54d1c825f14b51c4dff001e17368953ecf9fc5a7b6792c059477761076a
+oid sha256:6b4b198b552066fdee2a694a3134bf641b20591bebda21aa90920f4107f04f20
-size 9001760
+size 9065500

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";
       };
     };
 

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

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

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>

pkg/arvo/app/lens.hoon

@@ -28,8 +28,6 @@
         %contact-store
         %contact-hook
         %invite-store
-        %chat-store
-        %chat-hook
         %graph-store
     ==
   |=  app=@tas

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 }

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"
 

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
+  toNoun = toNoun . \case
-    EvBlip v -> toNoun $ reorgThroughNoun (Cord "",     v)
+    EvBlip v@BlipEvAmes{}       -> reorgThroughNoun ("ames", v)
-    EvVane v -> toNoun $ reorgThroughNoun (Cord "vane", 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 _ 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)"
 
 
 -- 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"

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

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

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

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 -------------------------------------------
 

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 Urbit.Vere.Stat     (AmesStat(..), bump, bump')
-import qualified Urbit.Noun.Time as Time
 
 
 -- 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
+              -> do
-                { pktOrigin = pktOrigin <|> Just (ipDest p a) }
+                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
+        atomically (enqueueEv (EvErr (hearEv p a b) (hearFailed s))) >>= \case
-          Intake -> pure ()
+          Intake -> bump asSrf
           Ouster -> do
             d <- atomically $ do
-              d <- readTVar dropCtr
+              bump' asQuf
-              writeTVar dropCtr (d + 1)
+              readTVar asQuf
-              pure d
+            when (d `rem` packetsDroppedPerComplaint == 1) $
-            when (d `rem` packetsDroppedPerComplaint == 0) $
               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)

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
+  { pktVersion  :: Word3
-  , pktEncrypted  :: Bool
-  --
   , pktSndr     :: Ship
   , pktRcvr     :: Ship
-  , pktOrigin     :: Maybe AmesDest
+  , pktSndrTick :: Word4
-  , pktContent    :: Bytes
+  , 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
+    -- skip first three bits
-    let checksum     = shiftR  head  3 .&. (2 ^ 20 - 1)
+    let isAmes     = testBit head  3  &  not
-    let sndrRank     = shiftR  head 23 .&. 0b11
+    let pktVersion = shiftR  head  4 .&. 0b111 & fromIntegral
-    let rcvrRank     = shiftR  head 25 .&. 0b11
+    let sndrRank   = shiftR  head  7 .&. 0b11
-    let pktEncrypted = testBit head 27  &  not  -- loobean
+    let rcvrRank   = shiftR  head  9 .&. 0b11
-    -- verify checksum
+    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
       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
+    tick <- getWord8
-    pktRcvr <- getShip rcvrRank
+    let pktSndrTick = tick .&. 0b1111
+    let pktRcvrTick = shiftR tick 4
+
+    pktSndr <- getShip sndrClass
+    pktRcvr <- getShip rcvrClass
+
     len <- remaining
-    payload <- getBytes len
+    pktContent <- 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{..}
     where
       getShip = fmap Ship . \case
-        0 -> fromIntegral <$> getWord16le              -- galaxy / star
+        Lord   -> fromIntegral <$> getWord16le
-        1 -> fromIntegral <$> getWord32le              -- planet
+        Planet -> fromIntegral <$> getWord32le
-        2 -> fromIntegral <$> getWord64le              -- moon
+        Moon   -> fromIntegral <$> getWord64le
-        3 -> LargeKey <$> getWord64le <*> getWord64le  -- comet
+        Comet  -> LargeKey <$> getWord64le <*> getWord64le
-        _ -> fail "impossibiru"
 
   put Packet{..} = do
-    let load = jamBS $ toNoun (pktOrigin, pktContent)
     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 body = runPut $ do
-    let encr = pktEncrypted
+          putWord8 $ (pktSndrTick .&. 0b1111)
+                 .|. shiftL (pktRcvrTick .&. 0b1111) 4
+          putSndr
+          putRcvr
+          putByteString pktContent
+
     let vers = fromIntegral pktVersion .&. 0b111
-    let head =        vers
+    let chek = muk body
-           .|. shiftL chek                  3
+
-           .|. shiftL sndR                 23
+    -- skip first 3 bytes, set 4th to yes (0) for "is ames"
-           .|. shiftL rcvR                 25
+    let head = shiftL vers 4
-           .|. if     encr then 0 else bit 27
+           .|. 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 ^ 16 -> (0, putWord16le $ fromIntegral s)    -- lord
-          | s < 2 ^ 32 -> (1, putWord32le $ fromIntegral s)    -- pan
+          | s < 2 ^ 32 -> (1, putWord32le $ fromIntegral s)    -- planet
-          | s < 2 ^ 64 -> (2, putWord64le $ fromIntegral s)    -- mon
+          | s < 2 ^ 64 -> (2, putWord64le $ fromIntegral s)    -- moon
-          | otherwise  -> (3, putWord64le p >> putWord64le q)  -- com
+          | otherwise  -> (3, putWord64le p >> putWord64le q)  -- comet

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

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
 

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,16 +77,30 @@ 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")
+    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) [] ""
 
     authenticated env req = runRIO env
@@ -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 ->

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 :: HasKingEnv e
-genBootSeq ship Pill {..} lite boot = io $ do
+           => Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq
-  ent <- genEntropy
+genBootSeq _    PillIvory {}   _    _    = throwIO CannotBootFromIvoryPill
-  let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums
+genBootSeq ship PillPill  {..} lite boot = do
-  pure $ BootSeq ident pBootFormulas ovums
+  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)
+  (termBorn, runTerm) <- rio (Term.term' termSys (renderStat stat) serfSIGINT)
-  (amesBorn, runAmes) <- rio (Ames.ames' who isFake scry stderr)
+  (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

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,10 +45,13 @@ instance Show Nock where
 
 --------------------------------------------------------------------------------
 
-data Pill = Pill
+data Pill
-  { pBootFormulas   :: ![Nock]
+  = PillIvory [Noun]
-  , pKernelOvums    :: ![Ev]
+  | PillPill
-  , pUserspaceOvums :: ![Ev]
+    { pName         :: Noun
+    , pBootFormulae :: ![Nock]  -- XX not actually nock, semantically
+    , pKernelOva    :: ![Ev]
+    , pUserspaceOva :: ![Ev]
     }
  deriving (Eq, Show)
 
@@ -87,6 +91,10 @@ data DriverApi ef = DriverApi
   }
 
 
+-- Scrying  --------------------------------------------------------------------
+
+type ScryFunc = Gang -> ScryReq -> IO (Maybe (Term, Noun))
+
 -- Instances -------------------------------------------------------------------
 
 instance ToNoun Work where

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
@@ -172,9 +176,9 @@ recvPleaHandlingSlog serf = loop
  where
   loop = recvPlea serf >>= \case
     PSlog info        -> serfSlog serf info >> loop
+    PFlog (Cord ofni) -> serfSlog serf (0, Tank $ Leaf $ Tape $ ofni) >> loop
     other             -> pure other
 
-
 -- Higher-Level IPC Functions --------------------------------------------------
 
 recvRipe :: Serf -> IO SerfInfo
@@ -219,9 +223,9 @@ sendCompactionRequest serf = do
   sendWrit serf (WLive $ LPack ())
   recvLive serf
 
-sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun))
+sendScryRequest :: Serf -> Gang -> ScryReq -> IO (Maybe (Term, Noun))
-sendScryRequest serf w g p = do
+sendScryRequest serf g r = do
-  sendWrit serf (WPeek 0 w g p)
+  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 -> Gang -> ScryReq -> IO (Maybe (Term, Noun))
-scry serf w g p = withSerfLockIO serf $ \ss -> do
+scry serf g r = withSerfLockIO serf $ \ss -> do
-  (ss,) <$> sendScryRequest serf w g p
+  (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 :: Gang -> ScryReq -> (Maybe (Term, Noun) -> IO ()) -> IO ()
-  doScry w g p k = (scry serf w g p >>= k) >> topLoop
+  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:
 

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

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)
 
 

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
+    ]
+

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

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:

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 {..}

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
+  arbitrary = oneof [ EvBlip <$> arb
-                    , 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 ]
 

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"
          )

pkg/hs/urbit-king/test/gold/hoontree.gold

@@ -1 +1 @@
-2082167031
+233234490

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
+mugBS = mum 0xcafe_babe 0x7fff
-  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
 
 -- 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)

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

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",

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 };
-}
+};

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);

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>
     </>
   );
 }

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>;
 

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];
 
@@ -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)!;

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);

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
+  {
-  //
+    c3_o lac_o = ( c3y == u3_Host.ops_u.veb ) ? c3n : c3y;
-  if ( c3y == u3_Host.ops_u.veb ) {
+    wir = u3nc(c3__arvo, u3_nul);
-    //  XX this path shouldn't be necessary
+    cad = u3nt(c3__verb, u3_nul, lac_o);
-    //
-    wir = u3nt(c3__term, '1', u3_nul);
-    cad = u3nc(c3__verb, u3_nul);
-
     u3_auto_plan(car_u, u3_ovum_init(0, u3_blip, wir, cad));
   }
 

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, mon, c3n);
-  u3_unix_ef_look(unx_u, 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.

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;
+    //  try to build export target path
-    if (!pac_c) {
-      pac_c = u3_Host.ops_u.pek_c;
-    }
-
-    u3_noun pad;
-    {
-      //  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));
+      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, pax));
+                   u3qb_scag(len_w - 1, u3t(pro)));
-      u3z(pax);
+      }
+      else {
+        u3l_log("pier: invalid export path %s\n", pac_c);
+        pad = u3_none;
+      }
+      u3z(pro);
     }
 
+    //  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);
+      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);
+      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, wyr), bot_u.mod);  // transfer [wir] and [wyr]
-    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);
   }
 
   //  prepend legacy boot event to the userspace sequence

pkg/urbit/version

@@ -1 +1 @@
-1.0
+1.1