mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 18:12:47 +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.
|
TODO verify that the KingIds match on effects.
|
||||||
-}
|
-}
|
||||||
ames :: forall e. HasLogFunc e
|
ames :: forall e. HasLogFunc e
|
||||||
=> KingId -> Ship -> Maybe Port -> QueueEv
|
=> KingId -> Ship -> Bool -> Maybe Port -> QueueEv
|
||||||
-> ([Ev], RAcquire e (EffCb e NewtEf))
|
-> ([Ev], RAcquire e (EffCb e NewtEf))
|
||||||
ames inst who mPort enqueueEv =
|
ames inst who isFake mPort enqueueEv =
|
||||||
(initialEvents, runAmes)
|
(initialEvents, runAmes)
|
||||||
where
|
where
|
||||||
initialEvents :: [Ev]
|
initialEvents :: [Ev]
|
||||||
@ -120,10 +120,8 @@ ames inst who mPort enqueueEv =
|
|||||||
aSendingThread <- async (sendingThread aSendingQueue aSocket)
|
aSendingThread <- async (sendingThread aSendingQueue aSocket)
|
||||||
pure $ AmesDrv{..}
|
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 :: NetworkMode
|
||||||
netMode = Fake
|
netMode = if isFake then Fake else Real
|
||||||
|
|
||||||
stop :: AmesDrv -> RIO e ()
|
stop :: AmesDrv -> RIO e ()
|
||||||
stop AmesDrv{..} = do
|
stop AmesDrv{..} = do
|
||||||
@ -190,14 +188,10 @@ ames inst who mPort enqueueEv =
|
|||||||
|
|
||||||
atomically $ writeTQueue queue bs
|
atomically $ writeTQueue queue bs
|
||||||
|
|
||||||
sendPacket AmesDrv{..} Real ip@(ADIpv4 _ _ _) bs = do
|
sendPacket AmesDrv{..} Real (ADIpv4 _ p a) bs = do
|
||||||
logTrace $ displayShow
|
let addr = SockAddrInet (fromIntegral p) (unIpv4 a)
|
||||||
("(ames) sendPacket Real Other ", ip, (destSockAddr Real ip))
|
logTrace $ displayShow ("(ames) sendPacket Real Other ", addr)
|
||||||
atomically $ writeTQueue aSendingQueue ((destSockAddr Real ip), bs)
|
atomically $ writeTQueue aSendingQueue (addr, 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?
|
|
||||||
|
|
||||||
|
|
||||||
-- An outbound queue of messages. We can only write to a socket from one
|
-- An outbound queue of messages. We can only write to a socket from one
|
||||||
-- thread, so coalesce those writes here.
|
-- thread, so coalesce those writes here.
|
||||||
|
@ -184,10 +184,11 @@ pier pierPath mPort (serf, log, ss) = do
|
|||||||
|
|
||||||
swapMVar (sStderr serf) (atomically . Term.trace muxed)
|
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) =
|
let (bootEvents, startDrivers) =
|
||||||
drivers pierPath inst ship mPort
|
drivers pierPath inst ship (isFake logId) mPort
|
||||||
(writeTQueue computeQ)
|
(writeTQueue computeQ)
|
||||||
shutdownEvent
|
shutdownEvent
|
||||||
(sz, muxed)
|
(sz, muxed)
|
||||||
@ -246,14 +247,15 @@ data Drivers e = Drivers
|
|||||||
}
|
}
|
||||||
|
|
||||||
drivers :: HasLogFunc e
|
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)
|
-> (TSize.Window Word, Term.Client)
|
||||||
-> ([Ev], RAcquire e (Drivers e))
|
-> ([Ev], RAcquire e (Drivers e))
|
||||||
drivers pierPath inst who mPort plan shutdownSTM termSys =
|
drivers pierPath inst who isFake mPort plan shutdownSTM termSys =
|
||||||
(initialEvents, runDrivers)
|
(initialEvents, runDrivers)
|
||||||
where
|
where
|
||||||
(behnBorn, runBehn) = behn inst plan
|
(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
|
(httpBorn, runHttp) = serv pierPath inst plan
|
||||||
(clayBorn, runClay) = clay pierPath inst plan
|
(clayBorn, runClay) = clay pierPath inst plan
|
||||||
(irisBorn, runIris) = client inst plan
|
(irisBorn, runIris) = client inst plan
|
||||||
|
Loading…
Reference in New Issue
Block a user