LGTM, thanks. (Thinking about file paths, perhaps it'd be a good idea to replace String/FilePath in the future with designated types for them, to distinguish them at the type level to prevent accidental errors with absolute/relative/file/directory paths. What do you think? I looked on hackage and I found this package, which aims to solve the problem: http://hackage.haskell.org/package/pathtype . It you think it'd make sense, I could file an issue for this as a Haskell small task.)
On Fri, Jan 17, 2014 at 5:28 PM, Klaus Aehlig <[email protected]> wrote: > When replicating parts of the job queue, allow for virtual > paths in the RPC call. In this way, replication will also > work correctly in a vcluster setup. Note that makeVirtualPath > lives in IO, and hence cannot be part of the pure encoding > function of the RPC. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/JQueue.hs | 7 +++++-- > 1 file changed, 5 insertions(+), 2 deletions(-) > > diff --git a/src/Ganeti/JQueue.hs b/src/Ganeti/JQueue.hs > index c847c82..8afefab 100644 > --- a/src/Ganeti/JQueue.hs > +++ b/src/Ganeti/JQueue.hs > @@ -92,6 +92,7 @@ import Ganeti.Rpc (executeRpcCall, ERpcError, > logRpcErrors, > import Ganeti.THH > import Ganeti.Types > import Ganeti.Utils > +import Ganeti.VCluster (makeVirtualPath) > > -- * Data types > > @@ -397,8 +398,9 @@ replicateJob :: FilePath -> [Node] -> QueuedJob -> IO > [(Node, ERpcError ())] > replicateJob rootdir mastercandidates job = do > let filename = liveJobFile rootdir . qjId $ job > content = Text.JSON.encode . Text.JSON.showJSON $ job > + filename' <- makeVirtualPath filename > callresult <- executeRpcCall mastercandidates > - $ RpcCallJobqueueUpdate filename content > + $ RpcCallJobqueueUpdate filename' content > let result = map (second (() <$)) callresult > logRpcErrors result > return result > @@ -442,8 +444,9 @@ allocateJobIds mastercandidates lock n = > logError msg > return . Bad $ msg > Right () -> do > + serial' <- makeVirtualPath serial > _ <- executeRpcCall mastercandidates > - $ RpcCallJobqueueUpdate serial serial_content > + $ RpcCallJobqueueUpdate serial' serial_content > putMVar lock () > return $ mapM makeJobId [(current+1)..(current+n)] > > -- > 1.8.5.2 > >
