mirror of
https://github.com/urbit/shrub.git
synced 2024-12-21 01:41:37 +03:00
Thread isFake bit to Ames and condition how we send messages on it.
This commit is contained in:
parent
8cd9c690db
commit
26046b63ef
@ -95,9 +95,9 @@ _turfText = intercalate "." . reverse . fmap unCord . unTurf
|
||||
TODO verify that the KingIds match on effects.
|
||||
-}
|
||||
ames :: forall e. HasLogFunc e
|
||||
=> KingId -> Ship -> Maybe Port -> QueueEv
|
||||
=> KingId -> Ship -> Bool -> Maybe Port -> QueueEv
|
||||
-> ([Ev], RAcquire e (EffCb e NewtEf))
|
||||
ames inst who mPort enqueueEv =
|
||||
ames inst who isFake mPort enqueueEv =
|
||||
(initialEvents, runAmes)
|
||||
where
|
||||
initialEvents :: [Ev]
|
||||
@ -120,10 +120,8 @@ ames inst who mPort enqueueEv =
|
||||
aSendingThread <- async (sendingThread aSendingQueue aSocket)
|
||||
pure $ AmesDrv{..}
|
||||
|
||||
-- TODO: This switch needs to reflect the network mode flag; are we a fake
|
||||
-- network? Do we have all networking disabled?
|
||||
netMode :: NetworkMode
|
||||
netMode = Fake
|
||||
netMode = if isFake then Fake else Real
|
||||
|
||||
stop :: AmesDrv -> RIO e ()
|
||||
stop AmesDrv{..} = do
|
||||
@ -190,14 +188,10 @@ ames inst who mPort enqueueEv =
|
||||
|
||||
atomically $ writeTQueue queue bs
|
||||
|
||||
sendPacket AmesDrv{..} Real ip@(ADIpv4 _ _ _) bs = do
|
||||
logTrace $ displayShow
|
||||
("(ames) sendPacket Real Other ", ip, (destSockAddr Real ip))
|
||||
atomically $ writeTQueue aSendingQueue ((destSockAddr Real ip), bs)
|
||||
|
||||
-- Maybe the entire socket usage in this example is wrong. We're using the
|
||||
-- receiving socket as the sending socket, too. Can we not do that?
|
||||
|
||||
sendPacket AmesDrv{..} Real (ADIpv4 _ p a) bs = do
|
||||
let addr = SockAddrInet (fromIntegral p) (unIpv4 a)
|
||||
logTrace $ displayShow ("(ames) sendPacket Real Other ", addr)
|
||||
atomically $ writeTQueue aSendingQueue (addr, bs)
|
||||
|
||||
-- An outbound queue of messages. We can only write to a socket from one
|
||||
-- thread, so coalesce those writes here.
|
||||
|
@ -184,10 +184,11 @@ pier pierPath mPort (serf, log, ss) = do
|
||||
|
||||
swapMVar (sStderr serf) (atomically . Term.trace muxed)
|
||||
|
||||
let ship = who (Log.identity log)
|
||||
let logId = Log.identity log
|
||||
let ship = who logId
|
||||
|
||||
let (bootEvents, startDrivers) =
|
||||
drivers pierPath inst ship mPort
|
||||
drivers pierPath inst ship (isFake logId) mPort
|
||||
(writeTQueue computeQ)
|
||||
shutdownEvent
|
||||
(sz, muxed)
|
||||
@ -246,14 +247,15 @@ data Drivers e = Drivers
|
||||
}
|
||||
|
||||
drivers :: HasLogFunc e
|
||||
=> FilePath -> KingId -> Ship -> Maybe Port -> (Ev -> STM ()) -> STM()
|
||||
=> FilePath -> KingId -> Ship -> Bool -> Maybe Port -> (Ev -> STM ())
|
||||
-> STM()
|
||||
-> (TSize.Window Word, Term.Client)
|
||||
-> ([Ev], RAcquire e (Drivers e))
|
||||
drivers pierPath inst who mPort plan shutdownSTM termSys =
|
||||
drivers pierPath inst who isFake mPort plan shutdownSTM termSys =
|
||||
(initialEvents, runDrivers)
|
||||
where
|
||||
(behnBorn, runBehn) = behn inst plan
|
||||
(amesBorn, runAmes) = ames inst who mPort plan
|
||||
(amesBorn, runAmes) = ames inst who isFake mPort plan
|
||||
(httpBorn, runHttp) = serv pierPath inst plan
|
||||
(clayBorn, runClay) = clay pierPath inst plan
|
||||
(irisBorn, runIris) = client inst plan
|
||||
|
Loading…
Reference in New Issue
Block a user