Thread isFake bit to Ames and condition how we send messages on it.

This commit is contained in:
Elliot Glaysher 2019-10-08 16:18:52 -07:00
parent 8cd9c690db
commit 26046b63ef
2 changed files with 14 additions and 18 deletions

View File

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

View File

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