From 1a9b1a83a57574f1bb7a3bfc37d999c16d9ae404 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Thu, 10 Dec 2020 17:56:56 -0800
Subject: [PATCH 01/16] king: 'implement' joe's breaching ev/ef path reform

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs | 13 +++++-
 pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs  | 50 ++++++----------------
 2 files changed, 24 insertions(+), 39 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
index b6a2bd1747..db78cc955f 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
@@ -254,14 +254,23 @@ data Ef
     | EfExit Cord EvilPath -- second path component, rest of path
   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)
 
 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)
diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
index f95166a495..cfd968a8f0 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
@@ -218,9 +218,7 @@ instance Show Entropy where
 data ArvoEv
     = ArvoEvWhom ()   Ship
     | ArvoEvWack ()   Entropy
-    | ArvoEvWarn Path Noun
     | ArvoEvCrud Path Noun
-    | ArvoEvVeer Atom Noun
   deriving (Eq, Ord, Show)
 
 deriveNoun ''ArvoEv
@@ -318,50 +316,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 +350,6 @@ instance FromNoun Ev where
 -}
 getSpinnerNameForEvent :: Ev -> Maybe Text
 getSpinnerNameForEvent = \case
-    EvVane _ -> Nothing
     EvBlip b -> case b of
         BlipEvAmes _           -> Just "ames"
         BlipEvArvo _           -> Just "arvo"

From 716ed1203b70cf24d6a3590d1d147a5fedd3258d Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Thu, 10 Dec 2020 18:05:10 -0800
Subject: [PATCH 02/16] king: fix warning

---
 pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs
index 35c462ac22..0957a8eda4 100644
--- 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
 

From 876fb521eefb255ca6ac43be6297e53ec902266b Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <glaysher@umich.edu>
Date: Thu, 3 Dec 2020 13:41:03 -0500
Subject: [PATCH 03/16] First draft adding wyrd; doesn't boot.

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs    | 22 +++++++++++++-
 pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs     |  3 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs      | 24 +++++++++++++++
 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs  | 30 +++++++++++++++++--
 .../urbit-king/lib/Urbit/Vere/Serf/Types.hs   |  5 +++-
 5 files changed, 79 insertions(+), 5 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
index f02c7f69d5..4794e0322a 100644
--- 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,7 +22,7 @@ module Urbit.Arvo.Common
   , AmesDest, Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
   ) where
 
-import Urbit.Prelude hiding (Term)
+import Urbit.Prelude
 
 import Control.Monad.Fail (fail)
 
@@ -45,6 +46,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  :: (Term, UD, UD, UD),
+                   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, UD)] }
+  deriving newtype (Eq, Ord, Show, FromNoun, ToNoun)
 
 -- Http Common -----------------------------------------------------------------
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
index f95166a495..6c1c458daf 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
@@ -12,7 +12,7 @@ module Urbit.Arvo.Event where
 import Urbit.Prelude hiding (Term)
 
 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)
@@ -221,6 +221,7 @@ data ArvoEv
     | ArvoEvWarn Path Noun
     | ArvoEvCrud Path Noun
     | ArvoEvVeer Atom Noun
+    | ArvoEvWyrd Vere
   deriving (Eq, Ord, Show)
 
 deriveNoun ''ArvoEv
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
index ed18cefc7e..158ba43507 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@@ -335,6 +335,10 @@ pier (serf, log) vSlog startedSig injected = do
 
   tSerf <- acquireWorker "Serf" (runCompute serf computeConfig)
 
+  -- TODO: Go through the version negotionation with the serf. Before we start
+  -- the drivers, we send a %wyrd event and wait for a %wynn
+  doVersionNegotiation compute
+
   -- Run all born events and retry them until they succeed.
   wackEv <- EvBlip . BlipEvArvo . ArvoEvWack () <$> genEntropy
   rio $ for_ (wackEv : bootEvents) $ \ev -> do
@@ -414,6 +418,26 @@ death tag tid = do
     Left  exn -> Left (tag, exn)
     Right ()  -> Right tag
 
+-- %wyrd version negotiation ---------------------------------------------------
+
+doVersionNegotiation
+  :: HasPierEnv e
+  => (RunReq -> STM ())
+  -> RAcquire e ()
+doVersionNegotiation compute = do
+  -- What we want to do is actually inspect the effects here.
+  arvoVer <- fromNounExn $ toNoun $ Cord "arvo-kelvin"
+  let k   = Wynn [("zuse", 309),
+                  ("arvo", arvoVer),
+                  ("hoon", 141),
+                  ("nock", 4)]
+      sen = MkTerm "121331"  -- TODO: What is sen? I can just generate a nonce here.
+      v   = Vere sen ("KingHaskell", 0, 10, 9) k
+
+  retVar <- newEmptyTMVarIO
+  atomically $ compute $ RRWyrd v (putTMVar retVar)
+  ret <- atomically $ takeTMVar retVar
+  pure ()
 
 -- Start All Drivers -----------------------------------------------------------
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
index 71c2ef2f38..70cc7a28ac 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
@@ -84,7 +84,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, Vere, Wynn)
+import Urbit.Arvo.Event
 import Urbit.Noun.Time              (Wen)
 
 import qualified Data.ByteString        as BS
@@ -367,6 +368,27 @@ compact serf = withSerfLockIO serf $ \ss -> do
   sendCompactionRequest serf
   pure (ss, ())
 
+{-|
+  Tells the serf our version number and puts any returned version information
+  into the passed in d
+-}
+wyrd :: Vere -> (Maybe Wynn -> STM ()) -> Serf -> IO ()
+wyrd v ret serf = withSerfLockIO serf $ \ss -> do
+  now <- Time.now
+  sendWrit serf (WWork 0 now $ EvBlip $ BlipEvArvo $ ArvoEvWyrd v)
+  recvWork serf >>= \case
+    WBail goofs -> do
+      throwIO (BailDuringWyrd goofs)
+    WSwap eid hash (wen, noun) fx -> do
+      throwIO (SwapDuringWyrd hash (wen, noun) fx)
+    WDone eid hash fx -> do
+      -- Looks at the
+
+      pure (ss, ())
+
+      -- yield (eid, fx)
+      -- loop hash eid
+
 {-|
   Peek into the serf state.
 -}
@@ -374,7 +396,6 @@ scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun))
 scry serf w g p = withSerfLockIO serf $ \ss -> do
   (ss,) <$> sendScryRequest serf w g p
 
-
 {-|
   Given a list of boot events, send them to to the serf in a single
   %play message. They must all be sent in a single %play event so that
@@ -493,11 +514,15 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
     RRSave ()      -> doSave
     RRKill ()      -> doKill
     RRPack ()      -> doPack
+    RRWyrd v ret   -> doWyrd v ret
     RRScry w g p k -> doScry w g p k
 
   doPack :: IO ()
   doPack = compact serf >> topLoop
 
+  doWyrd :: Vere -> (Maybe Wynn -> STM ()) -> IO ()
+  doWyrd v w = wyrd v w serf >> topLoop
+
   waitForLog :: IO ()
   waitForLog = do
     serfLast <- serfLastEventBlocking serf
@@ -530,6 +555,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
     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)
+    RRWyrd v ret   -> atomically (closeTBMQueue que) >> pure (doWyrd v ret)
     RRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que
 
   onWorkResp :: Wen -> EvErr -> Work -> IO ()
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs
index 91f8a659ed..5de79b269b 100644
--- 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      (Ev, FX, Vere, Wynn)
 import Urbit.Noun.Time (Wen)
 
 
@@ -94,6 +94,7 @@ data RunReq
   | RRSave ()
   | RRKill ()
   | RRPack ()
+  | RRWyrd Vere (Maybe Wynn -> STM ())
   | RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ())
 
 
@@ -111,6 +112,8 @@ data SerfExn
   | SerfNotRunning
   | MissingBootEventsInEventLog Word Word
   | SnapshotAheadOfLog EventId EventId
+  | BailDuringWyrd [Goof]
+  | SwapDuringWyrd Mug (Wen, Noun) FX
  deriving (Show, Exception)
 
 

From 4f67f90c9c47a72e52e11d087deeeadf1ca89b07 Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <glaysher@umich.edu>
Date: Mon, 7 Dec 2020 10:34:47 -0500
Subject: [PATCH 04/16] Dumping

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs    | 2 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 7 ++-----
 2 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
index 6c1c458daf..745e22d12b 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
@@ -362,7 +362,7 @@ 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 x      _ _ _ _ -> fail $ "First path-elem must be ?($ %vane): found " ++ show x
 
 
 -- Short Event Names -----------------------------------------------------------
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
index 70cc7a28ac..bbb8612a83 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
@@ -382,13 +382,10 @@ wyrd v ret serf = withSerfLockIO serf $ \ss -> do
     WSwap eid hash (wen, noun) fx -> do
       throwIO (SwapDuringWyrd hash (wen, noun) fx)
     WDone eid hash fx -> do
-      -- Looks at the
-
+      -- TODO: fish around in the fx for the upgrade event here. The equivalent
+      -- of _pier_on_lord_wyrd_done().
       pure (ss, ())
 
-      -- yield (eid, fx)
-      -- loop hash eid
-
 {-|
   Peek into the serf state.
 -}

From aefb53e64e8e65113e168a1e8ded1bb0cfe0f95b Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Tue, 15 Dec 2020 13:46:26 -0800
Subject: [PATCH 05/16] king: path format chage, fix tests

---
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs      | 12 +++++---
 .../urbit-king/lib/Urbit/Vere/Pier/Types.hs   | 15 ++++++----
 pkg/hs/urbit-king/test/ArvoTests.hs           | 30 +------------------
 pkg/hs/urbit-king/test/Options.hs             |  2 +-
 4 files changed, 19 insertions(+), 40 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
index 8f1169e88e..52820353f4 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@@ -70,16 +70,20 @@ 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
+genBootSeq _    PillIvory {}   _    _    = throwIO CannotBootFromIvoryPill
+genBootSeq ship PillPill  {..} lite boot = io $ do
   ent <- genEntropy
-  let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums
-  pure $ BootSeq ident pBootFormulas ovums
+  let ova = preKern ent <> 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
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
index ab5adba732..3b01660a86 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
@@ -17,7 +17,7 @@ module Urbit.Vere.Pier.Types
   )
 where
 
-import Urbit.Prelude hiding (Term)
+import Urbit.Prelude
 
 import Urbit.Arvo
 import Urbit.Noun.Time
@@ -44,11 +44,14 @@ instance Show Nock where
 
 --------------------------------------------------------------------------------
 
-data Pill = Pill
-  { pBootFormulas   :: ![Nock]
-  , pKernelOvums    :: ![Ev]
-  , pUserspaceOvums :: ![Ev]
-  }
+data Pill
+  = PillIvory [Noun]
+  | PillPill
+    { pName         :: Term
+    , pBootFormulae :: ![Nock]
+    , pKernelOva    :: ![Ev]
+    , pUserspaceOva :: ![Ev]
+    }
  deriving (Eq, Show)
 
 data BootSeq = BootSeq !LogIdentity ![Nock] ![Ev]
diff --git a/pkg/hs/urbit-king/test/ArvoTests.hs b/pkg/hs/urbit-king/test/ArvoTests.hs
index b2396b4296..bdd87ff3eb 100644
--- 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 ]
 
diff --git a/pkg/hs/urbit-king/test/Options.hs b/pkg/hs/urbit-king/test/Options.hs
index 21f1f826ad..3b9aa7456c 100644
--- 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"
          )

From d6def3c4cb03fe01899d3f2a38349abbfa4421c3 Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <glaysher@umich.edu>
Date: Wed, 16 Dec 2020 11:17:13 -0500
Subject: [PATCH 06/16] WIP: Got to the point where we boot and goof on the
 event

---
 bin/solid.pill                                |  4 +-
 pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs    |  4 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs      | 44 +++++++++++++------
 .../urbit-king/lib/Urbit/Vere/Pier/Types.hs   |  9 ++++
 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs  | 29 ++----------
 .../urbit-king/lib/Urbit/Vere/Serf/Types.hs   |  5 +--
 6 files changed, 50 insertions(+), 45 deletions(-)

diff --git a/bin/solid.pill b/bin/solid.pill
index 73512ca328..35c5e5f636 100644
--- a/bin/solid.pill
+++ b/bin/solid.pill
@@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:d9ec1e0a325bc754493e32c3f2d62d13620db1b1afac40ef45b1718eb10ff8f3
-size 10037688
+oid sha256:0cdea6bdb29cfdf3bda2ef068a2389b0cfc5a38a42d60fb0061f59deaebbf0c9
+size 8041008
diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
index 4794e0322a..e445ef380c 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
@@ -50,7 +50,7 @@ newtype ServId = ServId { unServId :: UV }
 
 -- Information about the king runtime passed to Arvo.
 data Vere = Vere { vereName :: Term,
-                   vereRev  :: (Term, UD, UD, UD),
+                   vereRev  :: [Cord],
                    vereWynn :: Wynn }
   deriving (Eq, Ord, Show)
 
@@ -63,7 +63,7 @@ instance FromNoun Vere where
     pure $ Vere {..}
 
 -- A list of names and their kelvin numbers, used in version negotiations.
-newtype Wynn = Wynn { unWynn :: [(Term, UD)] }
+newtype Wynn = Wynn { unWynn :: [(Term, Noun)] }
   deriving newtype (Eq, Ord, Show, FromNoun, ToNoun)
 
 -- Http Common -----------------------------------------------------------------
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
index 158ba43507..2c676e2193 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@@ -350,7 +350,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)
 
@@ -377,7 +377,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)
 
@@ -426,18 +426,36 @@ doVersionNegotiation
   -> RAcquire e ()
 doVersionNegotiation compute = do
   -- What we want to do is actually inspect the effects here.
-  arvoVer <- fromNounExn $ toNoun $ Cord "arvo-kelvin"
-  let k   = Wynn [("zuse", 309),
-                  ("arvo", arvoVer),
-                  ("hoon", 141),
-                  ("nock", 4)]
-      sen = MkTerm "121331"  -- TODO: What is sen? I can just generate a nonce here.
-      v   = Vere sen ("KingHaskell", 0, 10, 9) k
+  let k   = Wynn [("zuse", toNoun $ UD 309),
+                  ("lull", toNoun $ UD 303),
+                  ("arvo", toNoun $ UD 240),
+                  ("hoon", toNoun $ UD 141),
+                  ("nock", toNoun $ UD 4)]
+      sen = MkTerm "121331"  -- TODO: I can just generate a nonce here.
+      v   = Vere sen [Cord "KingHaskell", Cord "1.0"] k
+      ev  = EvBlip $ BlipEvArvo $ ArvoEvWyrd v
+
+  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)
+
+  -- OK, we are actually getting an exception from the remote side here.
+  logDebug "About to inject wyrd"
+  io inject
+  logDebug "Injected wyrd"
+
+  takeMVar okaySig >>= \case
+    Left goof -> logError $ display @Text ("Goof in wyrd event: " <>
+                                           tshow goof)
+    Right fx  -> do
+      -- TODO: We need to actually iterate over the fx list to search for
+      -- version negotiation events.
+      logDebug $ display @Text ("FX list: " <> tshow fx)
 
-  retVar <- newEmptyTMVarIO
-  atomically $ compute $ RRWyrd v (putTMVar retVar)
-  ret <- atomically $ takeTMVar retVar
-  pure ()
 
 -- Start All Drivers -----------------------------------------------------------
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
index ab5adba732..be03833ccb 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
@@ -44,6 +44,15 @@ instance Show Nock where
 
 --------------------------------------------------------------------------------
 
+-- A Pill is a pair of [pil_p pil_q], where pil_p is cued and pil_q is an
+-- optional set of userspace ovums.
+--
+-- The cued pil_p is a trel of [mot tag dat], where mot is 0 (version number?),
+-- tag is a cord about the type of pill, and dat is the traditional trel of
+-- [pBootForumlas pKernelOvums pUserspaceOvums].
+--
+-- So what's with pil_q? It looks like it is search for the %into.
+
 data Pill = Pill
   { pBootFormulas   :: ![Nock]
   , pKernelOvums    :: ![Ev]
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
index bbb8612a83..fab6070d02 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
@@ -84,7 +84,7 @@ import Foreign.Ptr                  (castPtr)
 import Foreign.Storable             (peek, poke)
 import RIO.Prelude                  (decodeUtf8Lenient)
 import System.Posix.Signals         (sigINT, sigKILL, signalProcess)
-import Urbit.Arvo                   (FX, Vere, Wynn)
+import Urbit.Arvo                   (FX)
 import Urbit.Arvo.Event
 import Urbit.Noun.Time              (Wen)
 
@@ -164,6 +164,7 @@ sendWrit s = sendBytes s . jamBS . toNoun
 recvPlea :: Serf -> IO Plea
 recvPlea w = do
   b <- recvResp w
+  putStrLn "recvPleas recvResp"
   n <- fromRightExn (cueBS b) (const $ BadPleaAtom $ bytesAtom b)
   p <- fromRightExn (fromNounErr @Plea n) (\(p, m) -> BadPleaNoun n p m)
   pure p
@@ -368,24 +369,6 @@ compact serf = withSerfLockIO serf $ \ss -> do
   sendCompactionRequest serf
   pure (ss, ())
 
-{-|
-  Tells the serf our version number and puts any returned version information
-  into the passed in d
--}
-wyrd :: Vere -> (Maybe Wynn -> STM ()) -> Serf -> IO ()
-wyrd v ret serf = withSerfLockIO serf $ \ss -> do
-  now <- Time.now
-  sendWrit serf (WWork 0 now $ EvBlip $ BlipEvArvo $ ArvoEvWyrd v)
-  recvWork serf >>= \case
-    WBail goofs -> do
-      throwIO (BailDuringWyrd goofs)
-    WSwap eid hash (wen, noun) fx -> do
-      throwIO (SwapDuringWyrd hash (wen, noun) fx)
-    WDone eid hash fx -> do
-      -- TODO: fish around in the fx for the upgrade event here. The equivalent
-      -- of _pier_on_lord_wyrd_done().
-      pure (ss, ())
-
 {-|
   Peek into the serf state.
 -}
@@ -511,15 +494,11 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
     RRSave ()      -> doSave
     RRKill ()      -> doKill
     RRPack ()      -> doPack
-    RRWyrd v ret   -> doWyrd v ret
     RRScry w g p k -> doScry w g p k
 
   doPack :: IO ()
   doPack = compact serf >> topLoop
 
-  doWyrd :: Vere -> (Maybe Wynn -> STM ()) -> IO ()
-  doWyrd v w = wyrd v w serf >> topLoop
-
   waitForLog :: IO ()
   waitForLog = do
     serfLast <- serfLastEventBlocking serf
@@ -552,13 +531,12 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
     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)
-    RRWyrd v ret   -> atomically (closeTBMQueue que) >> pure (doWyrd v ret)
     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)
@@ -566,6 +544,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
     WBail goofs -> do
       io $ err (RunBail goofs)
 
+
 {-|
   Given:
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs
index 5de79b269b..4bffdf0fd4 100644
--- 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, Vere, Wynn)
+import Urbit.Arvo      (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,6 @@ data RunReq
   | RRSave ()
   | RRKill ()
   | RRPack ()
-  | RRWyrd Vere (Maybe Wynn -> STM ())
   | RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ())
 
 

From 44d8119119344dc2f0393f913a314a6beccce0a7 Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <glaysher@umich.edu>
Date: Wed, 16 Dec 2020 11:46:54 -0500
Subject: [PATCH 07/16] That was it. Fixed the wyrd:insane issue.

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs |  2 +-
 pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs  |  2 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs   | 14 +++++++-------
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
index e445ef380c..d62a445c1d 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
@@ -63,7 +63,7 @@ instance FromNoun Vere where
     pure $ Vere {..}
 
 -- A list of names and their kelvin numbers, used in version negotiations.
-newtype Wynn = Wynn { unWynn :: [(Term, Noun)] }
+newtype Wynn = Wynn { unWynn :: [(Term, Word)] }
   deriving newtype (Eq, Ord, Show, FromNoun, ToNoun)
 
 -- Http Common -----------------------------------------------------------------
diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
index b2208d242b..4ede406253 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
@@ -219,7 +219,7 @@ data ArvoEv
     = ArvoEvWhom ()   Ship
     | ArvoEvWack ()   Entropy
     | ArvoEvCrud Path Noun
-    | ArvoEvWyrd Vere
+    | ArvoEvWyrd ()   Vere
   deriving (Eq, Ord, Show)
 
 deriveNoun ''ArvoEv
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
index 2c676e2193..8eb1fe265a 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@@ -426,14 +426,14 @@ doVersionNegotiation
   -> RAcquire e ()
 doVersionNegotiation compute = do
   -- What we want to do is actually inspect the effects here.
-  let k   = Wynn [("zuse", toNoun $ UD 309),
-                  ("lull", toNoun $ UD 303),
-                  ("arvo", toNoun $ UD 240),
-                  ("hoon", toNoun $ UD 141),
-                  ("nock", toNoun $ UD 4)]
+  let k   = Wynn [("zuse", 420),
+                  ("lull", 330),
+                  ("arvo", 240),
+                  ("hoon", 140),
+                  ("nock", 4)]
       sen = MkTerm "121331"  -- TODO: I can just generate a nonce here.
-      v   = Vere sen [Cord "KingHaskell", Cord "1.0"] k
-      ev  = EvBlip $ BlipEvArvo $ ArvoEvWyrd v
+      v   = Vere sen [Cord "kh", Cord "1.0"] k
+      ev  = EvBlip $ BlipEvArvo $ ArvoEvWyrd () v
 
   okaySig :: MVar (Either [Goof] FX) <- newEmptyMVar
   let inject = atomically $ compute $ RRWork $ EvErr ev $ cb

From 3451e02cd1c2d273890b08554313a35854eb99c3 Mon Sep 17 00:00:00 2001
From: Elliot Glaysher <glaysher@umich.edu>
Date: Wed, 16 Dec 2020 16:53:25 -0500
Subject: [PATCH 08/16] OK, and now we are walking through the effects

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs   |  5 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs     | 51 ++++++++++++++------
 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs |  1 -
 3 files changed, 39 insertions(+), 18 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs
index 50bf0d7f18..5a57829124 100644
--- 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,6 +259,7 @@ 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
@@ -275,6 +276,7 @@ instance ToNoun Ef where
     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 = tack >>> parseNoun >=> \case
@@ -282,6 +284,7 @@ instance FromNoun Ef where
     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"
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
index 8eb1fe265a..57685687bc 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@@ -37,6 +37,7 @@ 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
@@ -316,9 +317,9 @@ 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 stat runtimeSubsite
@@ -335,9 +336,7 @@ pier (serf, log) vSlog startedSig injected = do
 
   tSerf <- acquireWorker "Serf" (runCompute serf computeConfig)
 
-  -- TODO: Go through the version negotionation with the serf. Before we start
-  -- the drivers, we send a %wyrd event and wait for a %wynn
-  doVersionNegotiation compute
+  doVersionNegotiation compute err
 
   -- Run all born events and retry them until they succeed.
   wackEv <- EvBlip . BlipEvArvo . ArvoEvWack () <$> genEntropy
@@ -420,18 +419,26 @@ death tag tid = do
 
 -- %wyrd version negotiation ---------------------------------------------------
 
+data PierVersionNegotiationFailed = PierVersionNegotiationFailed
+ deriving (Show, Exception)
+
+zuseVersion :: Word
+zuseVersion = 420
+
 doVersionNegotiation
   :: HasPierEnv e
   => (RunReq -> STM ())
+  -> (Text -> RIO e ())
   -> RAcquire e ()
-doVersionNegotiation compute = do
-  -- What we want to do is actually inspect the effects here.
-  let k   = Wynn [("zuse", 420),
+doVersionNegotiation compute stderr = do
+  king <- tshow <$> view kingIdL
+
+  let k   = Wynn [("zuse", zuseVersion),
                   ("lull", 330),
                   ("arvo", 240),
                   ("hoon", 140),
                   ("nock", 4)]
-      sen = MkTerm "121331"  -- TODO: I can just generate a nonce here.
+      sen = MkTerm king
       v   = Vere sen [Cord "kh", Cord "1.0"] k
       ev  = EvBlip $ BlipEvArvo $ ArvoEvWyrd () v
 
@@ -443,18 +450,29 @@ doVersionNegotiation compute = do
         RunSwap _ _ _ _ fx -> putMVar okaySig (Right fx)
         RunBail goofs      -> putMVar okaySig (Left goofs)
 
-  -- OK, we are actually getting an exception from the remote side here.
-  logDebug "About to inject wyrd"
+  rio $ stderr "vere: checking version compatibility"
   io inject
-  logDebug "Injected wyrd"
 
   takeMVar okaySig >>= \case
-    Left goof -> logError $ display @Text ("Goof in wyrd event: " <>
-                                           tshow goof)
+    Left goof -> do
+      rio $ stderr "pier: version negotation failed"
+      logError $ display @Text ("Goof in wyrd event: " <> tshow goof)
+      throwIO PierVersionNegotiationFailed
+
     Right fx  -> do
-      -- TODO: We need to actually iterate over the fx list to search for
-      -- version negotiation events.
-      logDebug $ display @Text ("FX list: " <> tshow fx)
+      -- 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 -----------------------------------------------------------
@@ -544,6 +562,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)
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
index fab6070d02..a6aa8c7a55 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
@@ -164,7 +164,6 @@ sendWrit s = sendBytes s . jamBS . toNoun
 recvPlea :: Serf -> IO Plea
 recvPlea w = do
   b <- recvResp w
-  putStrLn "recvPleas recvResp"
   n <- fromRightExn (cueBS b) (const $ BadPleaAtom $ bytesAtom b)
   p <- fromRightExn (fromNounErr @Plea n) (\(p, m) -> BadPleaNoun n p m)
   pure p

From 29cc12d206c41e22a3859245613af1e195006673 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Fri, 18 Dec 2020 17:00:56 -0800
Subject: [PATCH 09/16] king: various fixes and improvements

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs    |  2 +-
 pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs     |  8 +++-
 pkg/hs/urbit-king/lib/Urbit/King/Main.hs      |  2 +-
 pkg/hs/urbit-king/lib/Urbit/King/Scry.hs      | 36 ++++++++--------
 pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs      | 19 +++++----
 .../lib/Urbit/Vere/Eyre/KingSubsite.hs        |  6 +--
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs      | 42 +++++++++++--------
 .../urbit-king/lib/Urbit/Vere/Pier/Types.hs   |  9 +++-
 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs  | 35 +++++++++-------
 .../lib/Urbit/Vere/Serf/IPC/Types.hs          |  3 +-
 .../urbit-king/lib/Urbit/Vere/Serf/Types.hs   | 16 ++++++-
 pkg/hs/urbit-king/package.yaml                |  2 +-
 pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs   |  7 +++-
 13 files changed, 112 insertions(+), 75 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
index d62a445c1d..bf504c2a1f 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
@@ -132,7 +132,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)
diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
index 4ede406253..3b97d599b6 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs
@@ -9,7 +9,7 @@
 -}
 module Urbit.Arvo.Event where
 
-import Urbit.Prelude hiding (Term)
+import Urbit.Prelude
 
 import Control.Monad.Fail (fail)
 import Urbit.Arvo.Common (KingId(..), ServId(..), Vere(..))
@@ -218,8 +218,12 @@ instance Show Entropy where
 data ArvoEv
     = ArvoEvWhom ()   Ship
     | ArvoEvWack ()   Entropy
-    | ArvoEvCrud Path Noun
     | ArvoEvWyrd ()   Vere
+    | ArvoEvCrud Path Noun
+    | ArvoEvTrim UD
+    | ArvoEvWhat [Noun]
+    | ArvoEvWhey ()
+    | ArvoEvVerb (Maybe Bool)
   deriving (Eq, Ord, Show)
 
 deriveNoun ''ArvoEv
diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs
index 5960154281..e93a671b4c 100644
--- 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
diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Scry.hs b/pkg/hs/urbit-king/lib/Urbit/King/Scry.hs
index f2a989be39..8692374770 100644
--- 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
 
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
index 511821cff5..b025d6ec2a 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
@@ -15,19 +15,17 @@ import Urbit.Arvo                  hiding (Fake)
 import Urbit.King.Config
 import Urbit.King.Scry
 import Urbit.Vere.Ames.LaneCache
-import Urbit.Vere.Ames.Packet
+--import Urbit.Vere.Ames.Packet
 import Urbit.Vere.Pier.Types
 import Urbit.Vere.Ports
 
-import Data.Serialize      (decode, encode)
+-- import Data.Serialize      (decode, encode)
 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 -------------------------------------------------------------------
 
@@ -143,7 +141,7 @@ ames'
   => Ship
   -> Bool
   -> AmesStat
-  -> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+  -> ScryFunc
   -> (Text -> RIO e ())
   -> RIO e ([Ev], RAcquire e (DriverApi NewtEf))
 ames' who isFake stat scry stderr = do
@@ -198,7 +196,7 @@ ames
   -> Ship
   -> Bool
   -> AmesStat
-  -> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+  -> ScryFunc
   -> (EvErr -> STM PacketOutcome)
   -> (Text -> RIO e ())
   -> ([Ev], RAcquire e (NewtEf -> IO ()))
@@ -269,7 +267,9 @@ ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
       -- port number, host address, bytestring
     (p, a, b) <- atomically (bump' asRcv >> usRecv)
     ver <- readTVarIO vers
-
+    -- TODO
+    serfsUp p a b
+    {-
     case decode b of
       Right (pkt@Packet {..}) | ver == Nothing || ver == Just pktVersion -> do
         logDebug $ displayShow ("ames: bon packet", pkt, showUD $ bytesAtom b)
@@ -315,6 +315,7 @@ ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
       Left e -> do
         bump asDml
         logInfo $ displayShow ("ames: dropping malformed", e)
+    -}
 
     where
       serfsUp p a b =
@@ -362,12 +363,12 @@ ames env who isFake stat 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)
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/KingSubsite.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/KingSubsite.hs
index 960035c3b5..c75d78c0db 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/KingSubsite.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/KingSubsite.hs
@@ -13,7 +13,6 @@ 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)
@@ -23,7 +22,6 @@ 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 }
 
@@ -44,7 +42,7 @@ 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
@@ -118,7 +116,7 @@ kingSubsite who scry stat 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 ->
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
index 28a2d40c58..5600496792 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
@@ -32,7 +32,6 @@ 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)
 
@@ -79,11 +78,13 @@ data CannotBootFromIvoryPill = CannotBootFromIvoryPill
 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
+           => Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq
 genBootSeq _    PillIvory {}   _    _    = throwIO CannotBootFromIvoryPill
-genBootSeq ship PillPill  {..} lite boot = io $ do
-  ent <- genEntropy
-  let ova = preKern ent <> pKernelOva <> postKern <> pUserspaceOva
+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 pBootFormulae)
@@ -301,9 +302,9 @@ 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.
@@ -429,12 +430,8 @@ data PierVersionNegotiationFailed = PierVersionNegotiationFailed
 zuseVersion :: Word
 zuseVersion = 420
 
-doVersionNegotiation
-  :: HasPierEnv e
-  => (RunReq -> STM ())
-  -> (Text -> RIO e ())
-  -> RAcquire e ()
-doVersionNegotiation compute stderr = do
+wyrd :: HasKingEnv e => RIO e Ev
+wyrd = do
   king <- tshow <$> view kingIdL
 
   let k   = Wynn [("zuse", zuseVersion),
@@ -443,8 +440,17 @@ doVersionNegotiation compute stderr = do
                   ("hoon", 140),
                   ("nock", 4)]
       sen = MkTerm king
-      v   = Vere sen [Cord "kh", Cord "1.0"] k
-      ev  = EvBlip $ BlipEvArvo $ ArvoEvWyrd () v
+      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
@@ -496,7 +502,7 @@ drivers
   -> Ship
   -> Bool
   -> (RunReq -> STM ())
-  -> (Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
+  -> ScryFunc
   -> (TermSize, Term.Client)
   -> (Text -> RIO e ())
   -> IO ()
@@ -602,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 ()
@@ -616,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
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
index ff69a93332..148d935d0a 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
@@ -14,6 +14,7 @@ module Urbit.Vere.Pier.Types
   , jobId
   , jobMug
   , DriverApi(..)
+  , ScryFunc
   )
 where
 
@@ -56,8 +57,8 @@ instance Show Nock where
 data Pill
   = PillIvory [Noun]
   | PillPill
-    { pName         :: Term
-    , pBootFormulae :: ![Nock]
+    { pName         :: Noun
+    , pBootFormulae :: ![Nock]  -- XX not actually nock, semantically
     , pKernelOva    :: ![Ev]
     , pUserspaceOva :: ![Ev]
     }
@@ -99,6 +100,10 @@ data DriverApi ef = DriverApi
   }
 
 
+-- Scrying  --------------------------------------------------------------------
+
+type ScryFunc = Gang -> ScryReq -> IO (Maybe (Term, Noun))
+
 -- Instances -------------------------------------------------------------------
 
 instance ToNoun Work where
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs
index a6aa8c7a55..f977907a2b 100644
--- 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)]
         ==  ==
     ==
+  --
   ```
 -}
 
@@ -172,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 --------------------------------------------------
 
@@ -220,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 ()
@@ -371,9 +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,7 +532,7 @@ 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 ()
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC/Types.hs
index 88fed803e8..09f1b36a99 100644
--- 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
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs
index 4bffdf0fd4..c0979a8787 100644
--- 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)
 
 
@@ -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 ------------------------------------------------------------------
diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml
index 4879b06701..728845bcc0 100644
--- 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.0
 license: MIT
 license-file: LICENSE
 data-files:
diff --git a/pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs
index f2a97569a5..54ba660d5d 100644
--- 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

From 958ebc5a24658bece75dc20c052debe54c486341 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Sun, 10 Jan 2021 21:19:40 -0800
Subject: [PATCH 10/16] king: ted's new packet format

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs    |  10 +-
 pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs      |  17 +-
 .../urbit-king/lib/Urbit/Vere/Ames/Packet.hs  | 170 ++++++++++++------
 pkg/hs/urbit-king/test/AmesTests.hs           |   3 +-
 4 files changed, 140 insertions(+), 60 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
index bf504c2a1f..d91362c243 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
@@ -25,6 +25,7 @@ module Urbit.Arvo.Common
 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
@@ -166,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 }
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
index b025d6ec2a..bb62eff36e 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
@@ -15,11 +15,11 @@ import Urbit.Arvo                  hiding (Fake)
 import Urbit.King.Config
 import Urbit.King.Scry
 import Urbit.Vere.Ames.LaneCache
---import Urbit.Vere.Ames.Packet
+import Urbit.Vere.Ames.Packet
 import Urbit.Vere.Pier.Types
 import Urbit.Vere.Ports
 
--- import Data.Serialize      (decode, encode)
+import Data.Serialize      (decode, encode)
 import Urbit.King.App      (HasKingId(..), HasPierEnv(..))
 import Urbit.Vere.Ames.DNS (NetworkMode(..), ResolvServ(..))
 import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ)
@@ -145,6 +145,12 @@ ames'
   -> (Text -> RIO e ())
   -> RIO e ([Ev], RAcquire e (DriverApi NewtEf))
 ames' who isFake stat scry stderr = do
+  stderr "YO-HOI"
+  stderr $ tshow (AAIpv4 (Ipv4 16777343) 60008)
+  -- stderr $ pack $ showUD $ bytesAtom $ encode
+  --        $ Packet 0 (Ship 1) (Ship 0) 2 3 Nothing "hi"
+  -- stderr $ pack $ showUD $ bytesAtom $ encode
+  --        $ Packet 0 (Ship 1) (Ship 0) 2 3 (Just $ AAIpv4 (Ipv4 0xffeeffee) 0xaacc) "hi"
   -- 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.
@@ -267,9 +273,6 @@ ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
       -- port number, host address, bytestring
     (p, a, b) <- atomically (bump' asRcv >> usRecv)
     ver <- readTVarIO vers
-    -- TODO
-    serfsUp p a b
-    {-
     case decode b of
       Right (pkt@Packet {..}) | ver == Nothing || ver == Just pktVersion -> do
         logDebug $ displayShow ("ames: bon packet", pkt, showUD $ bytesAtom b)
@@ -284,7 +287,8 @@ ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
               -> do
                 bump asFwd
                 forward dest $ encode pkt
-                  { pktOrigin = pktOrigin <|> Just (ipDest p a) }
+                  { pktOrigin = pktOrigin
+                            <|> Just (AAIpv4 (Ipv4 a) (fromIntegral p)) }
               where
                 notSelf (EachYes g) = who /= Ship (fromIntegral g)
                 notSelf (EachNo  _) = True
@@ -315,7 +319,6 @@ ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
       Left e -> do
         bump asDml
         logInfo $ displayShow ("ames: dropping malformed", e)
-    -}
 
     where
       serfsUp p a b =
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/Packet.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/Packet.hs
index 4c1ebb6bd3..8c90bd169e 100644
--- 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
diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs
index 01cfbcb97d..11c31f5c85 100644
--- 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 {..}

From fbe13d411d39192755ad51b1c64d344532cae119 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Thu, 21 Jan 2021 14:55:03 -0800
Subject: [PATCH 11/16] king: elim zigzag in --stderr (still interlacing)

---
 pkg/hs/urbit-king/lib/Urbit/King/App.hs  | 18 ++++++++++++++++++
 pkg/hs/urbit-king/lib/Urbit/King/Main.hs |  5 ++++-
 pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs |  6 ------
 3 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs
index 10fc2be305..7c2ac9f9ea 100644
--- 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
diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs
index e93a671b4c..1a394110b6 100644
--- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs
@@ -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
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
index bb62eff36e..7efea95f71 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs
@@ -145,12 +145,6 @@ ames'
   -> (Text -> RIO e ())
   -> RIO e ([Ev], RAcquire e (DriverApi NewtEf))
 ames' who isFake stat scry stderr = do
-  stderr "YO-HOI"
-  stderr $ tshow (AAIpv4 (Ipv4 16777343) 60008)
-  -- stderr $ pack $ showUD $ bytesAtom $ encode
-  --        $ Packet 0 (Ship 1) (Ship 0) 2 3 Nothing "hi"
-  -- stderr $ pack $ showUD $ bytesAtom $ encode
-  --        $ Packet 0 (Ship 1) (Ship 0) 2 3 (Just $ AAIpv4 (Ipv4 0xffeeffee) 0xaacc) "hi"
   -- 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.

From 8db4e2ad7ec36fdc98ceff6a77ddf989160e2470 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Thu, 21 Jan 2021 19:41:19 -0800
Subject: [PATCH 12/16] king: new mug

---
 pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs | 24 ++++++++++++--------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
index 3847ed6419..a15095042d 100644
--- 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)
\ No newline at end of file

From 9ed4f9fbe0c343b718138315af6f99f41417aa9f Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Fri, 22 Jan 2021 11:53:22 -0800
Subject: [PATCH 13/16] king: fix dat gold (again)

---
 pkg/hs/urbit-king/test/gold/hoontree.gold | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pkg/hs/urbit-king/test/gold/hoontree.gold b/pkg/hs/urbit-king/test/gold/hoontree.gold
index c788a9e2d4..0b4589065a 100644
--- a/pkg/hs/urbit-king/test/gold/hoontree.gold
+++ b/pkg/hs/urbit-king/test/gold/hoontree.gold
@@ -1 +1 @@
-2082167031
\ No newline at end of file
+233234490
\ No newline at end of file

From d90370cfc042970edc102388d66992d257afd485 Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Mon, 25 Jan 2021 17:34:46 -0800
Subject: [PATCH 14/16] king: restore king to rightful place in default.nix

---
 default.nix | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/default.nix b/default.nix
index 668b017025..ac85d95ee0 100644
--- 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";
       };
     };
 

From 2fdc5ad351863a3dc122ec198065723fa84905ac Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Fri, 29 Jan 2021 13:37:50 -0800
Subject: [PATCH 15/16] king: version number 1.1

---
 pkg/hs/urbit-king/package.yaml | 2 +-
 pkg/urbit/version              | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml
index 728845bcc0..647dda006a 100644
--- a/pkg/hs/urbit-king/package.yaml
+++ b/pkg/hs/urbit-king/package.yaml
@@ -1,5 +1,5 @@
 name: urbit-king
-version: 1.0
+version: 1.1
 license: MIT
 license-file: LICENSE
 data-files:
diff --git a/pkg/urbit/version b/pkg/urbit/version
index 9f8e9b69a3..b123147e2a 100644
--- a/pkg/urbit/version
+++ b/pkg/urbit/version
@@ -1 +1 @@
-1.0
\ No newline at end of file
+1.1
\ No newline at end of file

From 1042422bbe8bafb49eda7a94f1cfdcaf89a25a9c Mon Sep 17 00:00:00 2001
From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com>
Date: Fri, 29 Jan 2021 14:14:57 -0800
Subject: [PATCH 16/16] king: address joe's comments again

---
 pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs | 9 ---------
 pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs   | 2 +-
 2 files changed, 1 insertion(+), 10 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
index 148d935d0a..5f3fd11eaa 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs
@@ -45,15 +45,6 @@ instance Show Nock where
 
 --------------------------------------------------------------------------------
 
--- A Pill is a pair of [pil_p pil_q], where pil_p is cued and pil_q is an
--- optional set of userspace ovums.
---
--- The cued pil_p is a trel of [mot tag dat], where mot is 0 (version number?),
--- tag is a cord about the type of pill, and dat is the traditional trel of
--- [pBootForumlas pKernelOvums pUserspaceOvums].
---
--- So what's with pil_q? It looks like it is search for the %into.
-
 data Pill
   = PillIvory [Noun]
   | PillPill
diff --git a/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
index a15095042d..005f822324 100644
--- a/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
+++ b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
@@ -35,4 +35,4 @@ mum syd fal key = go syd 0
           ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)
       in if ham /= 0
         then ham
-        else go (syd + 1) (i + 1)
\ No newline at end of file
+        else go (syd + 1) (i + 1)