capnp 0.6.0.2 → 0.6.0.3
raw patch · 4 files changed
+103/−63 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- capnp.cabal +1/−1
- lib/Capnp/Rpc/Untyped.hs +73/−49
- lib/Internal/Finalizer.hs +24/−13
CHANGELOG.md view
@@ -1,3 +1,8 @@+# 0.6.0.3++* Fix a race condition [(#74)][issue74] causing remote objects to very+ occasionally be released too early.+ # 0.6.0.2 * Fix a bug [(#71)][issue71] which sometimes caused the code generator
capnp.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: capnp-version: 0.6.0.2+version: 0.6.0.3 category: Data, Serialization, Network, Rpc copyright: 2016-2020 haskell-capnp contributors (see CONTRIBUTORS file). author: Ian Denhardt
lib/Capnp/Rpc/Untyped.hs view
@@ -683,7 +683,7 @@ -- * They don't have unknown variants -- * PromisedAnswer's transform field is just a list of pointer offsets, -- rather than a union with no other actually-useful variants.--- * PromisedAnswer's transform field is a SnocList, efficient appending.+-- * PromisedAnswer's transform field is a SnocList, for efficient appending. data MsgTarget = ImportTgt !IEId | AnswerTgt PromisedAnswer@@ -728,13 +728,15 @@ RemoteDest AnswerDest { conn, answer } -> callRemote conn info $ AnswerTgt answer - RemoteDest (ImportDest (Fin.get -> ImportRef { conn, importId })) ->+ RemoteDest (ImportDest cell) -> do+ ImportRef { conn, importId } <- Fin.get cell callRemote conn info (ImportTgt importId) Error exn -> breakPromise response exn - ImportClient (Fin.get -> ImportRef { conn, importId }) ->+ ImportClient cell -> do+ ImportRef { conn, importId } <- Fin.get cell callRemote conn info (ImportTgt importId) -- | Send a call to a remote capability.@@ -909,7 +911,7 @@ , unwrapper = Server.handleCast ops } superviseSTM sup $ do- Fin.addFinalizer finalizerKey $ atomically $ Rc.release qCall+ Fin.addFinalizer finalizerKey $ Rc.release qCall Server.runServer q ops pure $ Client (Just client') @@ -1314,13 +1316,20 @@ disembargoPromise _ = abortDisembargo "targets something that is not a promise." - disembargoClient (ImportClient (Fin.get -> ImportRef {conn=targetConn, importId}))- | conn == targetConn =- sendPureMsg conn' $ R.Message'disembargo R.Disembargo- { context = R.Disembargo'context'receiverLoopback embargoId- , target = R.MessageTarget'importedCap (ieWord importId)- }- disembargoClient _ =+ disembargoClient (ImportClient cell) = do+ client <- Fin.get cell+ case client of+ ImportRef {conn=targetConn, importId}+ | conn == targetConn ->+ sendPureMsg conn' $ R.Message'disembargo R.Disembargo+ { context = R.Disembargo'context'receiverLoopback embargoId+ , target = R.MessageTarget'importedCap (ieWord importId)+ }+ _ ->+ abortDisembargoClient+ disembargoClient _ = abortDisembargoClient++ abortDisembargoClient = abortDisembargo $ "targets a promise which has not resolved to a capability" <> " hosted by the sender."@@ -1625,6 +1634,10 @@ -- clarification on the mailing list. disembargoAndResolve dest + -- Local promises never need embargos; we can just forward:+ ( _, LocalDest LocalBuffer { callBuffer } ) ->+ flushAndResolve callBuffer+ -- These cases are slightly subtle; despite resolving to a -- client that points at a "remote" target, if it points into a -- _different_ connection, we must be proxying it, so we treat@@ -1634,25 +1647,27 @@ -- -- If it's pointing into the same connection, we don't need to -- do a disembargo.- ( Just PromiseClient { origTarget=RemoteDest newDest }, RemoteDest oldDest )- | destConn newDest /= destConn oldDest ->- disembargoAndResolve oldDest- | otherwise ->- releaseAndResolve- ( Just (ImportClient (Fin.get -> ImportRef { conn=newConn })), RemoteDest oldDest )- | newConn /= destConn oldDest ->- disembargoAndResolve oldDest- | otherwise ->- releaseAndResolve-- -- Local promises never need embargos; we can just forward:- ( _, LocalDest LocalBuffer { callBuffer } ) ->- flushAndResolve callBuffer+ ( Just PromiseClient { origTarget=RemoteDest newDest }, RemoteDest oldDest ) -> do+ newConn <- destConn newDest+ oldConn <- destConn oldDest+ if newConn == oldConn+ then releaseAndResolve+ else disembargoAndResolve oldDest+ ( Just (ImportClient cell), RemoteDest oldDest ) -> do+ ImportRef { conn=newConn } <- Fin.get cell+ oldConn <- destConn oldDest+ if newConn == oldConn+ then releaseAndResolve+ else disembargoAndResolve oldDest where- destConn AnswerDest { conn } = conn- destConn (ImportDest (Fin.get -> ImportRef { conn })) = conn- destTarget AnswerDest { answer } = AnswerTgt answer- destTarget (ImportDest (Fin.get -> ImportRef { importId })) = ImportTgt importId+ destConn AnswerDest { conn } = pure conn+ destConn (ImportDest cell) = do+ ImportRef { conn } <- Fin.get cell+ pure conn+ destTarget AnswerDest { answer } = pure $ AnswerTgt answer+ destTarget (ImportDest cell) = do+ ImportRef { importId } <- Fin.get cell+ pure $ ImportTgt importId releaseAndResolve = do releaseTmpDest tmpDest@@ -1666,11 +1681,13 @@ flushAndRaise callBuffer e = flushTQueue callBuffer >>= traverse_ (\Server.CallInfo{response} -> breakPromise response e)- disembargoAndResolve dest@(destConn -> Conn{liveState}) =+ disembargoAndResolve dest = do+ Conn{liveState} <- destConn dest readTVar liveState >>= \case Live conn' -> do callBuffer <- newTQueue- disembargo conn' (destTarget dest) $ \case+ target <- destTarget dest+ disembargo conn' target $ \case Right () -> flushAndResolve callBuffer Left e ->@@ -1752,7 +1769,7 @@ -- bump the refcount. getConnExport :: Conn -> Client' -> STM IEId getConnExport conn client = getLive conn >>= \conn'@Conn'{exports} -> do- let ExportMap m = clientExportMap client+ ExportMap m <- clientExportMap client val <- M.lookup conn m case val of Just eid -> do@@ -1770,7 +1787,7 @@ -- freeing the export id, and dropping the client's refcount. dropConnExport :: Conn -> Client' -> STM () dropConnExport conn client' = do- let ExportMap eMap = clientExportMap client'+ ExportMap eMap <- clientExportMap client' val <- M.lookup conn eMap case val of Just eid -> do@@ -1781,10 +1798,12 @@ Nothing -> error "BUG: tried to drop an export that doesn't exist." -clientExportMap :: Client' -> ExportMap-clientExportMap LocalClient{exportMap} = exportMap-clientExportMap PromiseClient{exportMap} = exportMap-clientExportMap (ImportClient (Fin.get -> ImportRef{proxies})) = proxies+clientExportMap :: Client' -> STM ExportMap+clientExportMap LocalClient{exportMap} = pure exportMap+clientExportMap PromiseClient{exportMap} = pure exportMap+clientExportMap (ImportClient cell) = do+ ImportRef{proxies} <- Fin.get cell+ pure proxies -- | insert the client into the exports table, bumping the refcount if it is -- already there. If a different client is already in the table at the same@@ -1815,16 +1834,20 @@ Pending { tmpDest = RemoteDest AnswerDest { conn, answer } } | conn == targetConn -> pure $ R.CapDescriptor'receiverAnswer (marshalPromisedAnswer answer)- Pending { tmpDest = RemoteDest (ImportDest (Fin.get -> ImportRef { conn, importId = IEId iid })) }- | conn == targetConn ->- pure $ R.CapDescriptor'receiverHosted iid+ Pending { tmpDest = RemoteDest (ImportDest cell) } -> do+ ImportRef { conn, importId = IEId iid } <- Fin.get cell+ if conn == targetConn+ then pure (R.CapDescriptor'receiverHosted iid)+ else newSenderPromise _ ->- R.CapDescriptor'senderPromise . ieWord <$> getConnExport targetConn client'- ImportClient (Fin.get -> ImportRef { conn=hostConn, importId })- | hostConn == targetConn ->- pure (R.CapDescriptor'receiverHosted (ieWord importId))- | otherwise ->- R.CapDescriptor'senderHosted . ieWord <$> getConnExport targetConn client'+ newSenderPromise+ ImportClient cell -> do+ ImportRef { conn=hostConn, importId } <- Fin.get cell+ if hostConn == targetConn+ then pure (R.CapDescriptor'receiverHosted (ieWord importId))+ else R.CapDescriptor'senderHosted . ieWord <$> getConnExport targetConn client'+ where+ newSenderPromise = R.CapDescriptor'senderPromise . ieWord <$> getConnExport targetConn client' -- | 'acceptCap' is a dual of 'emitCap'; it derives a Client from a CapDescriptor -- received via the connection. May update connection state as necessary.@@ -1848,7 +1871,7 @@ , importId , proxies }- queueIO conn' $ Fin.addFinalizer cell $ atomically (Rc.decr localRc)+ queueIO conn' $ Fin.addFinalizer cell $ Rc.decr localRc pure $ Client $ Just $ ImportClient cell Nothing ->@@ -1869,7 +1892,8 @@ , origTarget } Nothing -> do- rec imp@(Fin.get -> ImportRef{proxies}) <- newImport importId conn (Just (pState, tmpDest))+ rec imp <- newImport importId conn (Just (pState, tmpDest))+ ImportRef{proxies} <- Fin.get imp let tmpDest = RemoteDest (ImportDest imp) pState <- newTVar Pending { tmpDest } pure $ Client $ Just PromiseClient@@ -1916,7 +1940,7 @@ importId imports cell <- Fin.newCell importRef- queueIO conn' $ Fin.addFinalizer cell $ atomically (Rc.decr localRc)+ queueIO conn' $ Fin.addFinalizer cell $ Rc.decr localRc pure cell -- | Release the identified import. Removes it from the table and sends a release
lib/Internal/Finalizer.hs view
@@ -23,9 +23,11 @@ So instead, we provide a 'Cell' type, which: * Wraps simple value-* Can be created inside STM, and+* Can be created and read inside STM, and * May safely have finalizers, using the 'addFinalizer' function in this module.+* Ensures that the finalizers will not be run before any transaction that+ reads data is complete. Note that it is *not* safe to use the primitives from "Sys.Mem.Weak" to add finalizers.@@ -35,13 +37,23 @@ module Internal.Finalizer (Cell, get, newCell, addFinalizer) where import Control.Concurrent.MVar (MVar, mkWeakMVar, newEmptyMVar)-import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar', newTVar)+import Control.Concurrent.STM+ (STM, TVar, atomically, modifyTVar', newTVar, readTVar) -- | A cell, containing a value and possibly finalizers.-data Cell a = Cell+newtype Cell a+ = Cell (TVar (CellData a))+ deriving(Eq)++-- The actual contents of a cell. This is wrapped in a 'TVar' to force accesses+-- to add the a reference the transaction log from which the finalizers are+-- reachable, thus preventing them from running before the completion of any+-- transaction that examines the value.+data CellData a = CellData { value :: a -- ^ The value wrapped by the cell.- , finalizers :: TVar [MVar ()]++ , finalizers :: [MVar ()] -- ^ Experimentally, TVars appear not to be safe for finalizers, so -- instead we create MVars for the finalizers, and store them this -- list so that we maintain a reference to them.@@ -49,19 +61,18 @@ deriving(Eq) -- | Get the value from a cell-get :: Cell a -> a-get = value+get :: Cell a -> STM a+get (Cell state) = value <$> readTVar state -- Create a new cell, initially with no finalizers. newCell :: a -> STM (Cell a)-newCell value = do- finalizers <- newTVar []- pure Cell { value, finalizers }+newCell value = Cell <$> newTVar CellData { value, finalizers = [] } -- Add a new finalizer to the cell. Cells may have many finalizers -- attached.-addFinalizer :: Cell a -> IO () -> IO ()-addFinalizer Cell{finalizers} fin = do+addFinalizer :: Cell a -> STM () -> IO ()+addFinalizer (Cell stateVar) fin = do mvar <- newEmptyMVar- _ <- mkWeakMVar mvar fin- atomically $ modifyTVar' finalizers (mvar:)+ _ <- mkWeakMVar mvar $ atomically fin+ atomically $ modifyTVar' stateVar $ \state@CellData{finalizers} ->+ state { finalizers = mvar : finalizers }