Merge c888af3a30 into release/next-js

pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs

@@ -26,6 +26,7 @@ import Urbit.Prelude
 
 import Control.Monad.Fail (fail)
 import Data.Bits
+import Data.Serialize
 
 import qualified Network.HTTP.Types.Method as H
 import qualified Urbit.Ob                  as Ob
@@ -171,9 +172,9 @@ newtype Ipv4 = Ipv4 { unIpv4 :: Word32 }
 
 instance Show Ipv4 where
   show (Ipv4 i) =
-    show ((shiftL i 24) .&. 0xff) ++ "." ++
-    show ((shiftL i 16) .&. 0xff) ++ "." ++
-    show ((shiftL i  8) .&. 0xff) ++ "." ++
+    show ((shiftR i 24) .&. 0xff) ++ "." ++
+    show ((shiftR i 16) .&. 0xff) ++ "." ++
+    show ((shiftR i  8) .&. 0xff) ++ "." ++
     show (i .&. 0xff)
 
 -- @is
@@ -185,14 +186,27 @@ type Galaxy = Patp Word8
 instance Integral a => Show (Patp a) where
   show = show . Ob.renderPatp . Ob.patp . fromIntegral . unPatp
 
-data AmesAddress
-    = AAIpv4 Ipv4 Port
-    | AAVoid Void
+data AmesAddress = AAIpv4 Ipv4 Port
   deriving (Eq, Ord, Show)
 
-deriveNoun ''AmesAddress
+instance Serialize AmesAddress where
+  get = AAIpv4 <$> (Ipv4 <$> getWord32le) <*> (Port <$> getWord16le)
+  put (AAIpv4 (Ipv4 ip) (Port port)) = putWord32le ip >> putWord16le port
 
-type AmesDest = Each Galaxy (Jammed AmesAddress)
+instance FromNoun AmesAddress where
+  parseNoun = named "AmesAddress" . \case
+    A (atomBytes -> bs)
+      -- Atoms lose leading 0s, but since lsb, these become trailing NULs
+      | length bs <= 6  -> case decode $ bs <> replicate (6 - length bs) 0 of
+        Right aa -> pure aa
+        Left msg -> fail msg
+      | otherwise      -> fail ("putative address " <> show bs <> " too long")
+    C{} -> fail "unexpected cell in ames address"
+
+instance ToNoun AmesAddress where
+  toNoun = A . bytesAtom . encode
+
+type AmesDest = Each Galaxy AmesAddress
 
 
 -- Path+Tagged Restructuring ---------------------------------------------------

pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs

@@ -80,15 +80,13 @@ modeAddress = \case
 
 okFakeAddr :: AmesDest -> Bool
 okFakeAddr = \case
-  EachYes _                            -> True
-  EachNo  (Jammed (AAIpv4 (Ipv4 a) _)) -> a == localhost
-  EachNo  (Jammed (AAVoid v         )) -> absurd v
+  EachYes _                   -> True
+  EachNo  (AAIpv4 (Ipv4 a) _) -> a == localhost
 
 localAddr :: NetworkMode -> AmesDest -> SockAddr
 localAddr mode = \case
-  EachYes g                     -> SockAddrInet (galaxyPort mode g) localhost
-  EachNo  (Jammed (AAIpv4 _ p)) -> SockAddrInet (fromIntegral p) localhost
-  EachNo  (Jammed (AAVoid v  )) -> absurd v
+  EachYes g            -> SockAddrInet (galaxyPort mode g) localhost
+  EachNo  (AAIpv4 _ p) -> SockAddrInet (fromIntegral p) localhost
 
 bornEv :: KingId -> Ev
 bornEv inst = EvBlip $ BlipEvNewt $ NewtEvBorn (fromIntegral inst, ()) ()
@@ -98,7 +96,7 @@ hearEv p a bs =
   EvBlip $ BlipEvAmes $ AmesEvHear () (ipDest p a) (MkBytes bs)
 
 ipDest :: PortNumber -> HostAddress -> AmesDest
-ipDest p a = EachNo $ Jammed $ AAIpv4 (Ipv4 a) (fromIntegral p)
+ipDest p a = EachNo $ AAIpv4 (Ipv4 a) (fromIntegral p)
 
 
 --------------------------------------------------------------------------------
@@ -367,5 +365,4 @@ ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
            -> RIO e (Maybe [AmesDest])
   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)
+  ipv4Addr (AAIpv4 a p) = SockAddrInet (fromIntegral p) (unIpv4 a)

pkg/hs/urbit-king/lib/Urbit/Vere/LockFile.hs

@@ -6,25 +6,42 @@ module Urbit.Vere.LockFile (lockFile) where
 
 import Urbit.Prelude
 
+import Urbit.King.App.Class
+
 import Data.Default                (def)
 import RIO.Directory               (createDirectoryIfMissing)
 import System.IO.LockFile.Internal (LockingParameters(..), RetryStrategy(..),
-                                    lock, unlock)
+                                    LockingException(..), lock, unlock)
 
 --------------------------------------------------------------------------------
 
-lockFile :: HasLogFunc e => FilePath -> RAcquire e ()
+lockFile :: (HasLogFunc e, HasStderrLogFunc e) => FilePath -> RAcquire e ()
 lockFile pax = void $ mkRAcquire start stop
   where
     fil = pax <> "/.vere.lock"
 
     stop handle = do
-        logInfo $ display @Text $ ("Releasing lock file: " <> pack fil)
-        io $ unlock fil handle
+      logInfo $ display @Text $ ("Releasing lock file: " <> pack fil)
+      io $ unlock fil handle
 
     params = def { retryToAcquireLock = No }
 
     start = do
         createDirectoryIfMissing True pax
         logInfo $ display @Text $ ("Taking lock file: " <> pack fil)
-        io (lock params fil)
+        handle failure $ io (lock params fil)
+
+    failure (e :: LockingException) = do
+      logStderr $ logError $ display @Text $
+        "Cannot acquire lock file " <> pack fil <> "."
+      logStderr $ logError $
+        "Please make sure there are no other instances of this ship running, "
+        <> "then try again."
+      logStderr $ logError $
+        "If you are sure, you can delete the file and try again."
+      throwIO e
+
+logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a
+logStderr action = do
+  logFunc <- view stderrLogFuncL
+  runRIO logFunc action

pkg/hs/urbit-king/package.yaml

@@ -1,5 +1,5 @@
 name: urbit-king
-version: 1.1
+version: 1.2
 license: MIT
 license-file: LICENSE
 data-files:

pkg/hs/urbit-king/test/ArvoTests.hs

@@ -15,6 +15,9 @@ import Urbit.Noun.Time
 import Urbit.Prelude
 import Urbit.Vere.Pier.Types
 
+import System.IO.Unsafe
+import Data.Serialize
+
 import Control.Concurrent (runInBoundThread, threadDelay)
 import Data.LargeWord     (LargeKey(..))
 import GHC.Natural        (Natural)

pkg/hs/urbit-noun/lib/Urbit/Noun/Conversions.hs

@@ -494,7 +494,7 @@ instance Show BigTape where
 -- Bytes -----------------------------------------------------------------------
 
 newtype Bytes = MkBytes { unBytes :: ByteString }
-  deriving newtype (Eq, Ord, Show)
+  deriving newtype (Eq, Ord, Show, IsString)
 
 instance ToNoun Bytes where
     toNoun = Atom . bytesAtom . unBytes

pkg/urbit/vere/io/ames.c

@@ -398,14 +398,17 @@ _ames_send(u3_pact* pac_u)
   }
 }
 
-/* u3_ames_decode_lane(): deserialize noun to lane
+/* u3_ames_decode_lane(): deserialize noun to lane; 0.0.0.0:0 if invalid
 */
 u3_lane
 u3_ames_decode_lane(u3_atom lan) {
   u3_lane lan_u;
   c3_d lan_d;
 
-  c3_assert( c3y == u3r_safe_chub(lan, &lan_d) );
+  if ( c3n == u3r_safe_chub(lan, &lan_d) || (lan_d >> 48) != 0 ) {
+    return (u3_lane){0, 0};
+  }
+
   u3z(lan);
 
   lan_u.pip_w = (c3_w)lan_d;
@@ -727,6 +730,14 @@ _ames_ef_send(u3_ames* sam_u, u3_noun lan, u3_noun pac)
     if ( (c3n == u3_Host.ops_u.net) && (0x7f000001 != lan_u.pip_w) ) {
       _ames_pact_free(pac_u);
     }
+    //  if the lane is uninterpretable, silently drop the packet
+    //
+    else if ( 0 == lan_u.por_s ) {
+      if ( u3C.wag_w & u3o_verbose ) {
+        u3l_log("ames: inscrutable lane\n");
+      }
+      _ames_pact_free(pac_u);
+    }
     //  otherwise, mutate destination and send packet
     //
     else {

pkg/urbit/version

@@ -1 +1 @@
-1.1
+1.2