transient-universe 0.4.1 → 0.4.4
raw patch · 7 files changed
+509/−247 lines, 7 filesdep ~transient
Dependency ranges changed: transient
Files
- README.md +4/−9
- src/Transient/Move.hs +76/−26
- src/Transient/Move/Internals.hs +405/−187
- src/Transient/Move/Services.hs +8/−10
- src/Transient/Move/Utils.hs +13/−4
- tests/TestSuite.hs +0/−8
- transient-universe.cabal +3/−3
README.md view
@@ -1,10 +1,10 @@- + ========= [](http://hackage.haskell.org/package/transient-universe) [](http://stackage.org/lts/package/transient-universe) [](http://stackage.org/nightly/package/transient-universe) -[](https://travis-ci.org/agocorona/transient-universe) +[](https://travis-ci.org/transient-haskell/transient-universe) [](https://gitter.im/Transient-Transient-Universe-HPlay/Lobby?utm_source=share-link&utm_medium=link&utm_campaign=share-link) See the [Wiki](https://github.com/agocorona/transient/wiki) @@ -24,13 +24,13 @@ ------- Browser nodes can integrate Hplayground for ghcjs, a reactive client side library based in trasient (package ghcjs-hplay) they can create widgets with HTML form elements and control the server nodes. A computation can move from browser to server and back at runtime despite the different architecture. -Widgets with code running in browser and servers can compose with other widgets. A Browser node can gain access to many server nodes trough the server that delivered the web application. +Widgets with code running in browser and servers can compose with other widgets. A Browser node can gain access to many server nodes trough the server that delivered the web application. These features can make transient ideal for client as well as server side-driven applications, whenever distribution and push-driven reactivity is necessary either in the servers or in the browser clients. New === -The last release add +The last release add - Hooks for secure communications: with [transient-universe-tls package](https://github.com/transient-haskell/transient-universe-tls), a node can use TLS to connect with other nodes, including web nodes. If the connection of a web node is initiated with "https" the websocket connection uses secure communications (wss). The only primitive added is `initTLS`. - Client websocket connections to connect with nodes within firewalled servers: a server node can connect with another situated after a HTTP server. All the process is transparent and add no new primitive; First `connect` tries a TCP socket connection if it receives other message than "OK", it tries a connection as a websocket client. This is important for P2P connections where a central server acts as coordinator. websocket connections can use TLS communications too. @@ -98,8 +98,3 @@ -I plan to improve map-reduce to create a viable platform for serious data analysis and machine learning using haskell. It will have a web notebook running in the browser. -Create services and examples for general Web applications with distributed servers and create services for them - - - - -
src/Transient/Move.hs view
@@ -2,41 +2,89 @@ -- -- Module : Transient.Move -- Copyright : --- License : GPL-3 +-- License : MIT -- -- Maintainer : agocorona@gmail.com -- Stability : -- Portability : -- --- | see <https://www.fpcomplete.com/user/agocorona/moving-haskell-processes-between-nodes-transient-effects-iv> +-- | @transient-universe@ extends the seamless composability of concurrent +-- multi-threaded programs provided by +-- <https://github.com/transient-haskell/transient transient> +-- to a multi-node cloud. Distributed concurrent programs are created and +-- composed seamlessly and effortlessly as if they were written for a single +-- node. @transient-universe@ has diverse applications from simple distributed +-- applications to massively parallel and distributed map-reduce problems. If +-- you are considering Apache Spark or Cloud Haskell then transient might be a +-- simpler yet better solution for you. +-- +-- Transient makes it easy to write composable, distributed event driven +-- reactive UI applications with client side and server side code composed +-- freely in the same application. For example, +-- <https://hackage.haskell.org/package/axiom Axiom> is a transient based +-- unified client and server side web application framework that provides a +-- better programming model and composability compared to frameworks like +-- ReactJS. +-- +-- = Overview +-- +-- The 'Cloud' monad adds the following facilities to complement the 'TransIO' +-- monad: +-- +-- * Create a distributed compute cluster of nodes +-- * Move computations across nodes at any point during computation +-- * Run computations on multiple nodes in parallel +-- +-- = Further Reading +-- +-- * <https://github.com/transient-haskell/transient/wiki/Transient-tutorial Tutorial> +-- * <https://github.com/transient-haskell/transient-examples Examples> +-- * <https://www.fpcomplete.com/user/agocorona/moving-haskell-processes-between-nodes-transient-effects-iv Blog post> +-- ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} module Transient.Move( --- * running the Cloud monad -Cloud(..),runCloud, runCloudIO, runCloudIO', local, onAll, lazy, loggedc, lliftIO,localIO, -listen, Transient.Move.Internals.connect, connect', fullStop, +-- * Running the Monad +Cloud(..),runCloud, runCloudIO, runCloudIO', --- * primitives for communication -wormhole, teleport, copyData, +-- * Node & Cluster Management +-- $cluster +Node(..), +-- ** Creating nodes +Service(), createNodeServ, createNode, createWebNode, +-- ** Joining the cluster +Transient.Move.Internals.connect, connect', listen, +-- Low level APIs +addNodes, shuffleNodes, +Connection(..), ConnectionData(..), defConnection, +-- ** Querying nodes +getMyNode, getWebServerNode, getNodes, nodeList, isBrowserInstance, --- * single node invocation + +-- * Running Local Computations +local, onAll, lazy, loggedc, lliftIO, localIO, fullStop, + +-- * Moving Computations +wormhole, teleport, copyData, + +-- * Running at a Remote Node beamTo, forkTo, callTo, runAt, atRemote, --- * invocation of many nodes +-- * Running at Multiple Nodes clustered, mclustered, callNodes, --- * messaging +-- * Messaging putMailbox, putMailbox',getMailbox,getMailbox',cleanMailbox,cleanMailbox', --- * thread control +-- * Thread Control single, unique, #ifndef ghcjs_HOST_OS --- * buffering control +-- * Buffering Control setBuffSize, getBuffSize, #endif @@ -44,17 +92,9 @@ -- * REST API api, HTTPMethod(..), PostParams, #endif --- * node management -createNode, createWebNode, createNodeServ, getMyNode, getNodes, -addNodes, shuffleNodes, --- * low level - - getWebServerNode, Node(..), nodeList, Connection(..), Service(), - isBrowserInstance, +-- * Low Level APIs - defConnection, - ConnectionData(..), #ifndef ghcjs_HOST_OS ParseContext(..) #endif @@ -63,8 +103,18 @@ import Transient.Move.Internals - - - - - +-- $cluster +-- +-- To join the cluster a node 'connect's to a well known node already part of +-- the cluster. +-- +-- @ +-- import Transient.Move (runCloudIO, lliftIO, createNode, connect, getNodes, onAll) +-- +-- main = runCloudIO $ do +-- this <- lliftIO (createNode "192.168.1.2" 8000) +-- master <- lliftIO (createNode "192.168.1.1" 8000) +-- connect this master +-- onAll getNodes >>= lliftIO . putStrLn . show +-- @ +--
src/Transient/Move/Internals.hs view
@@ -20,7 +20,7 @@ import Transient.Internals import Transient.Logged -import Transient.Indeterminism(choose) +import Transient.Indeterminism import Transient.Backtrack import Transient.EVars @@ -123,6 +123,9 @@ newtype Cloud a= Cloud {runCloud' ::TransIO a} deriving (Functor,Applicative,Monoid,Alternative, Monad, Num, MonadState EventF) +-- | Execute a distributed computation in the 'TransIO' monad. +-- Note that all the computations inside the 'TransIO' monad that enclose the +-- cloud computation must be `logged`. runCloud x= do closRemote <- getSData <|> return (Closure 0) runCloud' x <*** setData closRemote @@ -138,6 +141,7 @@ --- empty Hooks for TLS +{-# NOINLINE tlsHooks #-} tlsHooks ::IORef (SData -> BS.ByteString -> IO () ,SData -> IO B.ByteString ,NS.Socket -> BS.ByteString -> TransIO () @@ -157,7 +161,7 @@ if ((not $ BL.null input) && BL.head input == 0x16) then do conn <- getSData - sendRaw conn $ BS.pack $ "HTTP/1.0 525 SSL Handshake Failed\nContent-Length: 0\nConnection: close\n\n" + sendRaw conn $ BS.pack $ "HTTP/1.0 525 SSL Handshake Failed\r\nContent-Length: 0\nConnection: close\r\n\r\n" else return () (sendTLSData,recvTLSData,maybeTLSServerHandshake,maybeClientTLSHandshake)= unsafePerformIO $ readIORef tlsHooks @@ -175,11 +179,12 @@ --stream= Cloud . transport -- #ifndef ghcjs_HOST_OS --- | run the cloud computation. +-- | Run a distributed computation inside the IO monad. Enables asynchronous +-- console input (see 'keep'). runCloudIO :: Typeable a => Cloud a -> IO (Maybe a) runCloudIO (Cloud mx)= keep mx --- | run the cloud computation with no console input +-- | Run a distributed computation inside the IO monad with no console input. runCloudIO' :: Typeable a => Cloud a -> IO (Maybe a) runCloudIO' (Cloud mx)= keep' mx @@ -265,7 +270,7 @@ -- | A connectionless version of callTo for long running remote calls callTo' :: (Show a, Read a,Typeable a) => Node -> Cloud a -> Cloud a callTo' node remoteProc= do - mynode <- local getMyNode + mynode <- local $ getNodes >>= return . head beamTo node r <- remoteProc beamTo mynode @@ -274,10 +279,11 @@ -- | Within an open connection to other node opened by `wormhole`, it run the computation in the remote node and return -- the result back to the original node. +atRemote :: Loggable a => Cloud a -> Cloud a atRemote proc= loggedc' $ do - teleport -- !> "teleport 1111" + teleport -- !> "teleport 1111" r <- Cloud $ runCloud proc <** setData WasRemote - teleport -- !> "teleport 2222" + teleport -- !> "teleport 2222" return r -- | synonymous of `callTo` @@ -342,12 +348,12 @@ labelState $ "wormhole" ++ show node logdata@(Log rec log fulLog) <- getData `onNothing` return (Log False [][]) - mynode <- runTrans getMyNode -- debug + if not rec -- !> ("wormhole recovery", rec) then runTrans $ (do conn <- mconnect node - + liftIO $ writeIORef (remoteNode conn) $ Just node setData conn{calling= True} comp ) @@ -363,7 +369,7 @@ runTrans $ comp <*** do --- when (null log) $ setData WasRemote !> "NULLLOG" + when (isJust mclosure) . setData $ fromJust mclosure @@ -417,10 +423,14 @@ `onNothing` error "teleport: No connection defined: use wormhole" #ifndef ghcjs_HOST_OS case contype of - Just Self -> do - + Just Self -> runTrans $ do setData $ if (not calling) then WasRemote else WasParallel - runTrans $ async $ return () -- !> "SELF" -- call himself + abduce -- !> "SELF" -- call himself + liftIO $ do + remote <- readIORef $ remoteNode conn + writeIORef (myNode conn) $ fromMaybe (error "teleport: no connection?") remote + + _ -> do #else do @@ -435,18 +445,18 @@ _ -> 1) fulLog -- closLocal <- liftIO $ randomRIO (0,1000000) - node <- runTrans getMyNode +-- node <- runTrans getMyNode liftIO $ modifyMVar_ closures $ \map -> return $ M.insert closLocal (fulLog,cont) map let tosend= reverse $ if closRemote==0 then fulLog else log - runTrans $ msend conn $ SMore (closRemote,closLocal,tosend ) --- !> ("teleport sending", SMore (closRemote,closLocal,tosend)) + runTrans $ msend conn $ SMore $ ClosureData closRemote closLocal tosend +-- !> ("teleport sending", unsafePerformIO $ readIORef remoteNode , SMore (closRemote,closLocal,tosend)) -- !> "--------->------>---------->" --- !> ("fulLog", fulLog) + setData $ if (not calling) then WasRemote else WasParallel return Nothing @@ -477,10 +487,10 @@ -- while EVars are only visible by the process that initialized it and his children. -- Internally, the mailbox is in a well known EVar stored by `listen` in the `Connection` state. putMailbox :: Typeable a => a -> TransIO () -putMailbox = putMailbox' 0 +putMailbox = putMailbox' (0::Int) -- | write to a mailbox identified by an Integer besides the type -putMailbox' :: Typeable a => Int -> a -> TransIO () +putMailbox' :: (Typeable b, Ord b, Typeable a) => b -> a -> TransIO () putMailbox' idbox dat= do let name= MailboxId idbox $ typeOf dat Connection{comEvent= mv} <- getData `onNothing` errorMailBox @@ -506,10 +516,10 @@ -- This is reactive. it means that each new message trigger the execution of the continuation -- each message wake up all the `getMailbox` computations waiting for it. getMailbox :: Typeable a => TransIO a -getMailbox = getMailbox' 0 +getMailbox = getMailbox' (0 :: Int) -- | read from a mailbox identified by a number besides the type -getMailbox' :: Typeable a => Int -> TransIO a +getMailbox' :: (Typeable b, Ord b, Typeable a) => b -> TransIO a getMailbox' mboxid = x where x = do @@ -569,58 +579,62 @@ callNodes op init proc= loggedc' $ do - nodes <- local getNodes - let nodes' = filter (not . isWebNode) nodes - callNodes' nodes' op init proc - where - isWebNode Node {nodeServices=srvs} - | ("webnode","") `elem` srvs = True - | otherwise = False + nodes <- local getServerNodes + callNodes' nodes op init proc + callNodes' nodes op init proc= foldr op init $ map (\node -> runAt node proc) nodes ----- #ifndef ghcjs_HOST_OS -sendRaw (Connection _(Just (Node2Web sconn )) _ _ _ _ _ _) r= +sendRaw (Connection _ _ (Just (Node2Web sconn )) _ _ _ _ _ _) r= liftIO $ WS.sendTextData sconn r -- !> ("NOde2Web",r) -sendRaw (Connection _(Just (Node2Node _ sock _)) _ _ blocked _ _ _) r= +sendRaw (Connection _ _ (Just (Node2Node _ sock _)) _ _ blocked _ _ _) r= liftIO $ withMVar blocked $ const $ SBS.sendMany sock (BL.toChunks r ) -- !> ("NOde2Node",r) -sendRaw (Connection _(Just (TLSNode2Node ctx )) _ _ blocked _ _ _) r= +sendRaw (Connection _ _(Just (TLSNode2Node ctx )) _ _ blocked _ _ _) r= liftIO $ withMVar blocked $ const $ sendTLSData ctx r -- !> ("TLNode2Web",r) #else -sendRaw (Connection _ (Just (Web2Node sconn)) _ _ blocked _ _ _) r= liftIO $ +sendRaw (Connection _ _ (Just (Web2Node sconn)) _ _ blocked _ _ _) r= liftIO $ withMVar blocked $ const $ JavaScript.Web.WebSocket.send r sconn -- !!> "MSEND SOCKET" #endif +sendRaw _ _= error "No connection stablished" -msend :: Loggable a => Connection -> StreamData a -> TransIO () +data NodeMSG= ClosureData IdClosure IdClosure CurrentPointer + deriving (Typeable, Read, Show) + +msend :: MonadIO m => Connection -> StreamData NodeMSG -> m () + #ifndef ghcjs_HOST_OS -msend (Connection _(Just (Node2Node _ sock _)) _ _ blocked _ _ _) r= - liftIO $ withMVar blocked $ const $ SBS.sendAll sock $ BC.pack (show r) -- !> "N2N SEND" +msend (Connection _ _ (Just (Node2Node _ sock _)) _ _ blocked _ _ _) r= + liftIO $ withMVar blocked $ const $ SBS.sendAll sock $ BC.pack (show r) -- !> "N2N SEND" -msend (Connection _(Just (TLSNode2Node ctx)) _ _ blocked _ _ _) r= +msend (Connection _ _ (Just (TLSNode2Node ctx)) _ _ blocked _ _ _) r= liftIO $ sendTLSData ctx $ BS.pack (show r) -- !> "TLS SEND" -msend (Connection _(Just (Node2Web sconn)) _ _ blocked _ _ _) r=liftIO $ +msend (Connection _ _ (Just (Node2Web sconn)) _ _ blocked _ _ _) r=liftIO $ {-withMVar blocked $ const $ -} WS.sendTextData sconn $ BS.pack (show r) -- !> "websockets send" +msend((Connection _ rremote (Just (Relay req )) _ _ _ _ _ _)) r= writeEVar req r + + #else -msend (Connection _ (Just (Web2Node sconn)) _ _ blocked _ _ _) r= liftIO $ +msend (Connection _ _ (Just (Web2Node sconn)) _ _ blocked _ _ _) r= liftIO $ withMVar blocked $ const $ JavaScript.Web.WebSocket.send (JS.pack $ show r) sconn -- !!> "MSEND SOCKET" #endif -msend (Connection _ Nothing _ _ _ _ _ _) _= error "msend out of wormhole context" +msend (Connection _ _ Nothing _ _ _ _ _ _) _= error "msend out of wormhole context" mread :: Loggable a => Connection -> TransIO (StreamData a) @@ -628,7 +642,7 @@ #ifdef ghcjs_HOST_OS -mread (Connection _ (Just (Web2Node sconn)) _ _ _ _ _ _)= wsRead sconn +mread (Connection _ _ (Just (Web2Node sconn)) _ _ _ _ _ _)= wsRead sconn @@ -700,23 +714,29 @@ #else -mread (Connection _(Just (Node2Node _ _ _)) _ _ _ _ _ _) = parallelReadHandler -- !> "mread" +mread (Connection _ _(Just (Node2Node _ _ _)) _ _ _ _ _ _) = parallelReadHandler -- !> "mread" -mread (Connection _(Just (TLSNode2Node ctx)) _ _ _ _ _ _) = parallelReadHandler +mread (Connection _ _ (Just (TLSNode2Node ctx)) _ _ _ _ _ _) = parallelReadHandler -- parallel $ do -- s <- recvTLSData ctx -- return . read' $ BC.unpack s -mread (Connection node (Just (Node2Web sconn )) _ _ _ _ _ _)= +mread (Connection _ _ (Just (Node2Web sconn )) _ _ _ _ _ _)= parallel $ do s <- WS.receiveData sconn return . read' $ BS.unpack s --- !> ("WS MREAD RECEIVED ---->", s) +-- !> ("WS MREAD RECEIVED ----<----<------<--------", s) +mread (Connection _ rremote (Just (Relay _ )) _ _ _ _ _ _)= do + remote <- liftIO $ readIORef rremote + getMailbox' $ fromJust remote +-- return r !> ("GETMAILBOX RECEIVED", remote) + + getWebServerNode :: TransIO Node -getWebServerNode = getMyNode +getWebServerNode = getNodes >>= return . head #endif read' s= case readsPrec' 0 s of @@ -732,17 +752,17 @@ #ifndef ghcjs_HOST_OS -mclose (Connection _ +mclose (Connection _ _ (Just (Node2Node _ sock _ )) _ _ _ _ _ _)= NS.close sock -mclose (Connection node +mclose (Connection _ _ (Just (Node2Web sconn )) bufSize events blocked _ _ _)= WS.sendClose sconn ("closemsg" :: BS.ByteString) #else -mclose (Connection _ (Just (Web2Node sconn)) _ _ blocked _ _ _)= +mclose (Connection _ _(Just (Web2Node sconn)) _ _ blocked _ _ _)= JavaScript.Web.WebSocket.close Nothing Nothing sconn #endif @@ -755,8 +775,8 @@ let fnode = filter (==node) nodes case fnode of - [] -> addNodes [node] >> mconnect node - [Node host port pool _] -> do + [] -> mconnect1 node + [node'@(Node host port pool _)] -> do plist <- liftIO $ readMVar pool @@ -766,106 +786,149 @@ return handle -- !> ("REUSED!", node) - _ -> mconnect1 host port pool -- !> ("MCONNECT1",host,port) + _ -> mconnect1 node' -- !> ("MCONNECT1",host,port) where #ifndef ghcjs_HOST_OS - mconnect1 host port pool= do + mconnect1 (node@(Node host port pool _))= do - connectNode2Node host port <|> connectWebSockets host port - watchConnection +-- (do +-- liftIO $ when (host== "192.168.99.100" && (port == 8081 || port== 8080)) $ error "connnnn" !> "detected" + (conn,parseContext) <- connectNode2Node host port <|> timeout 1000000 (connectWebSockets host port) <|> checkRelay +-- `catcht` \(e :: SomeException) -> checkRelay + setState conn + setState parseContext +-- return () !> "CONNECTED AFTER TIMEOUT" + + -- write node connected in the connection + liftIO $ writeIORef (remoteNode conn) $ Just node + -- write connection in the node + liftIO $ modifyMVar_ (connection node) . const $ return [conn] + addNodes [node] + + watchConnection + delData $ Closure undefined + return conn + where - connectSockTLS host port= do - return () -- !> "connectSockTLS" - my <- getMyNode + timeout t proc=do + r <- collect' 1 t proc + case r of + [] -> empty + r:_ -> return r - let size=8192 - Connection{comEvent= ev} <- getSData <|> error "connect: listen not set for this node" + checkRelay= do +-- return () !> "CHECKRELAY" + case lookup "wsnode" $ nodeServices node of + Nothing -> empty + Just relay -> do + Connection{myNode=my,comEvent= ev} <- getSData <|> error "connect: listen not set for this node" + requests <- newEVar + conn' <- liftIO $ defConnection >>= \c -> + return c{myNode=my, comEvent= ev,connData= + Just $ Relay requests } + mynode <- liftIO $ readIORef my + putMailbox ((mynode ,node, read relay ,requests) :: + (Node, Node,Node, EVar (StreamData NodeMSG))) - sock <- liftIO $connectTo' size host $ PortNumber $ fromIntegral port + setState conn' +-- setState noParseContext + continue + return (conn', noParseContext) + noParseContext= (ParseContext (error "relay error") (error "relay error") + :: ParseContext BS.ByteString) + connectSockTLS host port= do +-- return () !> "connectSockTLS" + + let size=8192 + Connection{myNode=my,comEvent= ev} <- getSData <|> error "connect: listen not set for this node" + + sock <- liftIO $connectTo' size host $ PortNumber $ fromIntegral port + conn' <- liftIO $ defConnection >>= \c -> - return c{myNode=my,comEvent= ev,connData= - Just $ Node2Node u sock (error $ "addr: outgoing connection")} + return c{myNode=my, comEvent= ev,connData= + Just $ (Node2Node u sock (error $ "addr: outgoing connection"))} setData conn' input <- liftIO $ SBSL.getContents sock - setData $ ParseContext (error "listenResponses: Parse error") input + setData $ ParseContext (error "parse context: Parse error") input maybeClientTLSHandshake host sock input + `catcht` \(e :: SomeException) -> empty connectNode2Node host port= do + connectSockTLS host port -- return () !> "CONNECT NODE2NODE" + conn <- getSData <|> error "mconnect: no connection data" sendRaw conn "CLOS a b\r\n\r\n" - r <- -- async (threadDelay 2000000 >> return Nothing) <|> - liftIO $ readFrom conn --- (liftIO $ NS.recv sock 1000 >>= return . Just ) - --- return () !> ("READ",r) + r <- liftIO $ readFrom conn case r of - "OK" -> return() + "OK" -> do + parseContext <- getState + return (conn,parseContext) _ -> do let Connection{connData=cdata}= conn case cdata of Just(Node2Node _ s _) -> liftIO $ NS.close s -- since the HTTP firewall closes the connection --- TLSNode2Node c -> contextClose c -- TODO - empty --- close socket,tls +-- Just(TLSNode2Node c) -> contextClose c -- TODO + empty connectWebSockets host port = do - liftIO $ print "Trying WebSockets" connectSockTLS host port -- a new connection --- return () !> "connected" - never<- liftIO $ newEmptyMVar :: TransIO (MVar ()) - conn <- getSData <|> error "connectWebSockets: no connection" + + never <- liftIO $ newEmptyMVar :: TransIO (MVar ()) + conn <- getSData <|> error "connectWebSockets: no connection" stream <- liftIO $ makeWSStreamFromConn conn - wscon <- react (NWS.runClientWithStream stream host "/" - WS.defaultConnectionOptions []) (takeMVar never) + wscon <- react (NWS.runClientWithStream stream (host++(':': show port)) "/" + WS.defaultConnectionOptions []) (takeMVar never) - liftIO $ print "WebSockets connection" - modifyState $ \(Just c) -> Just c{connData= Just $ Node2Web wscon} + return (conn{connData= Just $ (Node2Web wscon)}, noParseContext) + -- noConnection= error $ show node ++ ": no connection" watchConnection= do conn <- getSData - parseContext <- getSData <|> error "NO PASE CONTEXT" + parseContext <- getSData <|> error "NO PARSE CONTEXT" :: TransIO (ParseContext BS.ByteString) chs <- liftIO $ newIORef M.empty let conn'= conn{closChildren= chs} - (liftIO $ modifyMVar_ pool $ \plist -> return $ conn':plist) -- !> (node,"ADDED TO POOL") + liftIO $ modifyMVar_ pool $ \plist -> return $ conn':plist -- !> (node,"ADDED TO POOL") -- tell listenResponses to watch incoming responses + putMailbox ((conn',parseContext,node) -- !> "PUTMAILBOX" :: (Connection,ParseContext BS.ByteString,Node)) - delData $ Closure undefined - return conn + liftIO $ threadDelay 100000 -- give time to initialize listenResponses + #else - mconnect1 host port pool= do - my <- getMyNode + mconnect1 (node@(Node host port pool _))= do +-- my <- getMyNode - Connection{comEvent= ev} <- getSData <|> error "connect: listen not set for this node" + Connection{myNode=my,comEvent= ev} <- getSData <|> error "connect: listen not set for this node" do ws <- connectToWS host $ PortNumber $ fromIntegral port -- !> "CONNECTWS" - conn <- defConnection >>= \c -> return c{comEvent= ev,connData= Just $ Web2Node ws} + conn <- defConnection >>= \c -> return c{comEvent= ev,connData= Just (Web2Node ws)} -- !> ("websocker CONNECION") let parseContext = ParseContext (error "parsecontext not available in the browser") @@ -919,21 +982,38 @@ #ifndef ghcjs_HOST_OS Node2Node{port :: PortID ,socket ::Socket - ,remoteNode :: NS.SockAddr + ,sockAddr :: NS.SockAddr } | TLSNode2Node{tlscontext :: SData} | Node2Web{webSocket :: WS.Connection} -- | WS2Node{webSocketNode :: WS.Connection} | Self + | Relay (EVar (StreamData NodeMSG)) #else Self | Web2Node{webSocket :: WebSocket} #endif -data MailboxId= MailboxId Int TypeRep deriving (Eq,Ord) -data Connection= Connection{myNode :: Node - ,connData :: Maybe(ConnectionData) + +data MailboxId = forall a .(Typeable a, Ord a) => MailboxId a TypeRep + +instance Eq MailboxId where + id1 == id2 = id1 `compare` id2== EQ + +instance Ord MailboxId where + MailboxId n t `compare` MailboxId n' t'= + case typeOf n `compare` typeOf n' of + EQ -> case n `compare` unsafeCoerce n' of + EQ -> t `compare` t' + LT -> LT + GT -> GT + GT -> GT + LT -> LT + +data Connection= Connection{myNode :: IORef Node + ,remoteNode :: IORef (Maybe Node) + ,connData :: Maybe ConnectionData ,bufferSize :: BuffSize -- Used by getMailBox, putMailBox ,comEvent :: IORef (M.Map MailboxId (EVar SData)) @@ -963,10 +1043,12 @@ -- #ifndef ghcjs_HOST_OS defConnection = liftIO $ do + my <- newIORef (error "node in default connection") x <- newMVar () y <- newMVar M.empty + noremote <- newIORef Nothing z <- return $ error "closchildren newIORef M.empty" - return $ Connection (error "node in default connection") Nothing 8192 + return $ Connection my noremote Nothing 8192 (error "defConnection: accessing network events out of listen") x False y z @@ -985,6 +1067,8 @@ +-- | Setup the node to start listening for incoming connections. +-- listen :: Node -> Cloud () listen (node@(Node _ port _ _ )) = onAll $ do addThreads 1 @@ -994,12 +1078,12 @@ conn' <- getSData <|> defConnection ev <- liftIO $ newIORef M.empty chs <- liftIO $ newIORef M.empty - let conn= conn'{connData=Just Self,myNode=node, comEvent=ev,closChildren=chs} - + let conn= conn'{connData=Just Self, comEvent=ev,closChildren=chs} + liftIO $ writeIORef (myNode conn) node setData conn liftIO $ modifyMVar_ (connection node) $ const $ return [conn] addNodes [node] - mlog <- listenNew (fromIntegral port) conn <|> listenResponses + mlog <- listenNew (fromIntegral port) conn <|> listenResponses :: TransIO (StreamData NodeMSG) execLog mlog @@ -1012,38 +1096,49 @@ liftIO $ do NS.setSocketOption sock NS.RecvBuffer bufSize NS.setSocketOption sock NS.SendBuffer bufSize + -- wait for connections. One thread per connection (sock,addr) <- waitEvents $ NS.accept sock - +-- return () !> addr chs <- liftIO $ newIORef M.empty -- case addr of -- NS.SockAddrInet port host -> liftIO $ print("connection from", port, host) -- NS.SockAddrInet6 a b c d -> liftIO $ print("connection from", a, b,c,d) - - let conn= conn'{closChildren=chs} + noNode <- liftIO $ newIORef Nothing + let conn= conn'{closChildren=chs, remoteNode= noNode} input <- liftIO $ SBSL.getContents sock - setData $ (ParseContext (error "parsing request") input - ::ParseContext BS.ByteString) - cutExceptions + cutExceptions onException $ \(e :: SomeException) -> do - liftIO $ print e - let Connection{closures=closures,closChildren= rmap}= conn + cutExceptions + liftIO $ putStr "listen: " >> print e + let Connection{remoteNode=rnode,closures=closures,closChildren= rmap} = conn + -- TODO How to close Connection by discriminating exceptions + mnode <- liftIO $ readIORef rnode + case mnode of + Nothing -> return () + Just node -> do + liftIO $ putStr "removing1 node: " >> print node + nodes <- getNodes + setNodes $ nodes \\ [node] liftIO $ do modifyMVar_ closures $ const $ return M.empty writeIORef rmap M.empty topState >>= showThreads killBranch + setData $ (ParseContext (NS.close sock >> error "Communication error" ) input + ::ParseContext BS.ByteString) + setState conn{connData=Just (Node2Node (PortNumber port) sock addr)} maybeTLSServerHandshake sock input (method,uri, headers) <- receiveHTTPHead - + maybeSetHost headers case method of "CLOS" -> @@ -1051,7 +1146,6 @@ conn <- getSData sendRaw conn "OK" -- !> "CLOS detected" - parallelReadHandler _ -> do @@ -1076,18 +1170,29 @@ _ -> return $ log -- ++ [Var $ IDynamic str] - return $ SMore (0,0, log' ) + return $ SMore $ ClosureData 0 0 log' else do + -- stay serving pages until a websocket request is received servePages (method, uri', headers) conn <- getSData sconn <- makeWebsocketConnection conn uri headers -- websockets mode - setData conn{connData= Just (Node2Web sconn) ,closChildren=chs} + + + let conn'= conn{connData= Just (Node2Web sconn) + , closChildren=chs} + setState conn' + onException $ \(e :: SomeException) -> do + liftIO $ putStr "listen websocket:" >> print e + continue + liftIO $ mclose conn' + killBranch + empty -- async (return (SMore (0,0,[Exec]))) <|> do do - return () -- !> "WEBSOCKET" +-- return () !> "WEBSOCKET" r <- parallel $ do msg <- WS.receiveData sconn -- return () !> ("Server WebSocket msg read",msg) @@ -1096,13 +1201,13 @@ case reads $ BS.unpack msg of [] -> do let log =Exec: [Var $ IDynamic (msg :: BS.ByteString)] - return $ SMore (0,0,log) - ((x ,_):_) -> return (x :: StreamData (Int,Int,[LogElem])) + return $ SMore (ClosureData 0 0 log) + ((x ,_):_) -> return (x :: StreamData NodeMSG) -- StreamData (Int,Int,[LogElem])) case r of SError e -> do -- liftIO $ WS.sendClose sconn ("error" :: BS.ByteString) - finish (Just e) + back e -- !> "FINISH1" _ -> return r @@ -1115,7 +1220,34 @@ in h: split t + maybeSetHost headers= do + setHost <- liftIO $ readIORef rsetHost + when setHost $ do + mnode <- liftIO $ do + let mhost= lookup "Host" headers + case mhost of + Nothing -> return Nothing + Just host -> atomically $ do + -- set the firt node (local node) as is called from outside + nodes <- readTVar nodeList + let (host1,port)= BC.span (/= ':') host + hostnode= (head nodes){nodeHost= BC.unpack host1 + ,nodePort= if BC.null port then 80 + else read $ BC.unpack $ BC.tail port} + writeTVar nodeList $ hostnode : tail nodes + return $ Just hostnode -- !> (host1,port) + + when (isJust mnode) $ do + conn <- getState + liftIO $ writeIORef (myNode conn) $fromJust mnode + liftIO $ writeIORef rsetHost False -- !> "HOSt SET" + +{-#NOINLINE rsetHost #-} +rsetHost= unsafePerformIO $ newIORef True + + + --instance Read PortNumber where -- readsPrec n str= let [(n,s)]= readsPrec n str in [(fromIntegral n,s)] @@ -1129,9 +1261,7 @@ (conn, parsecontext, node) <- getMailbox labelState $ "listen from: "++ show node - --- return () !> ("LISTEN FROM",node) - +-- return () !> ("LISTEN",case connData conn of Just (Relay _) -> "RELAY"; _ -> "OTHER") setData conn #ifndef ghcjs_HOST_OS @@ -1144,10 +1274,11 @@ cutExceptions onException (\(e:: SomeException) -> do - liftIO $ print e - liftIO $ putStr "removing2 node: " >> print node + liftIO $ putStr "ListenResponses: " >> print e + liftIO $ putStr "removing node: " >> print node nodes <- getNodes setNodes $ nodes \\ [node] + topState >>= showThreads killChilds let Connection{closures=closures}= conn liftIO $ modifyMVar_ closures $ const $ return M.empty) @@ -1155,11 +1286,41 @@ mread conn +-- | a bridge that forward messages to a third node trough a relay node. Used by the `Relay` connections +relayService= do + (msg,localnode, remotenode, relaynode) <- local $ do + (localnode,remotenode, relaynode, requests) <- getMailbox + :: TransIO (Node, Node,Node, EVar (StreamData NodeMSG)) +-- return () !> ("READING MESSAgES FROM",localnode,remotenode, relaynode) + msg <- readEVar requests -- !> "INSTALLED HANDLER READ EVAR" + return (msg,localnode,remotenode, relaynode) -- !> "MESSAGE READ IN ORIGIN NODE" + runAt relaynode . runAt remotenode $ do + -- start the listenResponses for this node the first time +-- return () !> "IN REMOTE NODE" + nodes <- local getNodes + let mnode = find (==localnode) nodes + case mnode of + Nothing -> localIO $ error $ "Relay: no node: "++ show localnode + Just nod -> do + noconnection <- localIO $ readMVar (connection nod) >>= return . null + if noconnection + then runAt nod empty <|> return () + else return () + + local $ putMailbox' localnode msg +-- !> "MESSAGE WRITTEN IN DESTINAION NODE" + empty -- no need to continue with a message back to the origin node + return () -- to type match + + + + type IdClosure= Int newtype Closure= Closure IdClosure deriving Show +execLog :: StreamData NodeMSG -> TransIO () execLog mlog = Transient $ case mlog of SError e -> do @@ -1171,43 +1332,47 @@ SLast r -> process r True where - process (closl,closr,log) deleteClosure= do - conn@Connection {closures=closures} <- getData `onNothing` error "Listen: myNode not set" - - if closl== 0 then do - - setData $ Log True log $ reverse log - setData $ Closure closr - - return $ Just () -- !> "executing top level closure" - - else do --- return () !> "execlog" - mcont <- liftIO $ modifyMVar closures - $ \map -> return (if deleteClosure then - M.delete closl map - else map, M.lookup closl map) - -- !> ("closures=", M.size map) - case mcont of - Nothing -> do - - runTrans $ msend conn $ SLast (closr,closl, [] :: [()] ) - -- to delete the remote closure - error ("request received for non existent closure: " - ++ show closl) - -- execute the closure - Just (fulLog,cont) -> liftIO $ runStateT (do - - let nlog= reverse log ++ fulLog - setData $ Log True log nlog + process (ClosureData closl closr log) deleteClosure= do + conn@Connection {closures=closures} <- getData `onNothing` error "Listen: myNode not set" + if closl== 0 then do + setData $ Log True log $ reverse log + setData $ Closure closr + return $ Just () -- !> "executing top level closure" + else do - setData $ Closure closr + mcont <- liftIO $ modifyMVar closures + $ \map -> return (if deleteClosure then + M.delete closl map + else map, M.lookup closl map) + -- !> ("closures=", M.size map) + case mcont of + Nothing -> do +-- +-- if closl == 0 -- add what is after execLog as closure 0 +-- then do +-- setData $ Log True log $ reverse log +-- setData $ Closure closr +-- cont <- get !> ("CLOSL","000000000") +-- liftIO $ modifyMVar closures +-- $ \map -> return (M.insert closl ([],cont) map,()) +-- return $ Just () --exec what is after execLog (closure 0) +-- +-- else do + runTrans $ msend conn $ SLast (ClosureData closr closl []) + -- to delete the remote closure + runTrans $ liftIO $ error ("request received for non existent closure: " + ++ show closl) + -- execute the closure + Just (fulLog,cont) -> do + liftIO $ runStateT (do + let nlog= reverse log ++ fulLog + setData $ Log True log nlog + setData $ Closure closr -- !> ("SETCLOSURE",closr) - runCont cont) cont --- !> ("executing closure",closl) + runContinuation cont ()) cont + return Nothing - return Nothing -- !> "FINISH CLOSURE" #ifdef ghcjs_HOST_OS @@ -1215,8 +1380,8 @@ addNodes [node] events <- liftIO $ newIORef M.empty - - conn <- defConnection >>= \c -> return c{myNode=node,comEvent=events} + rnode <- liftIO $ newIORef node + conn <- defConnection >>= \c -> return c{myNode=rnode,comEvent=events} setData conn r <- listenResponses execLog r @@ -1240,7 +1405,6 @@ parallelReadHandler :: Loggable a => TransIO (StreamData a) parallelReadHandler= do str <- giveData :: TransIO BS.ByteString - r <- choose $ readStream str -- rest <- liftIO $ newIORef $ BS.unpack str -- @@ -1332,6 +1496,7 @@ else do let file= if BC.null uri then "index.html" else uri + {- TODO renderin in server NEEDED: recodify View to use blaze-html in server. wlink to get path in server does file exist? @@ -1348,9 +1513,9 @@ case mcontent of Just content -> liftIO $ sendRaw conn $ - "HTTP/1.0 200 OK\nContent-Type: text/html\nConnection: close\nContent-Length: " - <> BS.pack (show $ BL.length content) <>"\n\n" <> content - -- (BL.toChunks content ) + "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\nContent-Length: " + <> BS.pack (show $ BL.length content) <>"\r\n\r\n" <> content + Nothing ->liftIO $ sendRaw conn $ BS.pack $ "HTTP/1.0 404 Not Found\nContent-Length: 0\nConnection: close\n\n" empty @@ -1361,7 +1526,6 @@ conn <- getSData <|> error "api: Need a connection opened with initNode, listen, simpleWebApp" let send= sendRaw conn r <- w - liftIO $ myThreadId >>= print send r -- !> r @@ -1482,7 +1646,7 @@ isBrowserInstance= True api _= empty #else --- | True if it is running in the browser +-- | Returns 'True' if we are running in the browser. isBrowserInstance= False #endif @@ -1496,6 +1660,8 @@ emptyPool= liftIO $ newMVar [] +-- | Create a node from a hostname (or IP address), port number and a list of +-- services. createNodeServ :: HostName -> Integer -> [Service] -> IO Node createNodeServ h p svs= do pool <- emptyPool @@ -1504,6 +1670,8 @@ +-- | Create a node from a hostname (or IP address) and port number. The node is +-- created without any services. createNode :: HostName -> Integer -> IO Node createNode h p= createNodeServ h p [] @@ -1512,6 +1680,9 @@ pool <- emptyPool return $ Node "webnode" ( fromInteger 0) pool [("webnode","")] +--createWSNode :: IO Node +-- pool <- emptyPool +-- return $ Node "wsnode" (fromInteger 0) pool [("wsnode","")] instance Eq Node where Node h p _ _ ==Node h' p' _ _= h==h' && p==p' @@ -1546,30 +1717,41 @@ errorMyNode f= error $ f ++ ": Node not set. initialize it with connect, listen, initNode..." +-- | Return the local node i.e. the node where this computation is running. getMyNode :: TransIO Node -- (MonadIO m, MonadState EventF m) => m Node getMyNode = do Connection{myNode= node} <- getSData <|> errorMyNode "getMyNode" :: TransIO Connection - return node + liftIO $ readIORef node --- | return the list of nodes connected to the local node +-- | Return the list of nodes in the cluster. getNodes :: MonadIO m => m [Node] getNodes = liftIO $ atomically $ readTVar nodeList --- | add nodes to the list of nodes +getServerNodes= do + nodes <- getNodes + return $ filter (not . isWebNode) nodes + + where + isWebNode Node {nodeServices=srvs} + | ("webnode","") `elem` srvs = True + | otherwise = False + +-- | Add a list of nodes to the list of existing cluster nodes. addNodes :: [Node] -> TransIO () -- (MonadIO m, MonadState EventF m) => [Node] -> m () addNodes nodes= do - my <- getMyNode -- mynode must be first +-- my <- getMyNode -- mynode must be first liftIO . atomically $ do prevnodes <- readTVar nodeList - writeTVar nodeList $ my: (( nub $ nodes ++ prevnodes) \\[my]) + writeTVar nodeList $ nub $ prevnodes ++ nodes -- | set the list of nodes setNodes nodes= liftIO $ atomically $ writeTVar nodeList $ nodes +-- | Shuffle the list of cluster nodes and return the shuffled list. shuffleNodes :: MonadIO m => m [Node] shuffleNodes= liftIO . atomically $ do nodes <- readTVar nodeList @@ -1612,51 +1794,87 @@ --- | set the rest of the computation as the code of a new node (first parameter) and connect it --- to an existing node (second parameter). then it uses `connect`` to synchronize the list of nodes +-- | Add a node (first parameter) to the cluster using a node that is already +-- part of the cluster (second parameter). The added node starts listening for +-- incoming connections and the rest of the computation is executed on this +-- newly added node. connect :: Node -> Node -> Cloud () #ifndef ghcjs_HOST_OS connect node remotenode = do listen node <|> return () connect' remotenode --- | synchronize the list of nodes with a remote node and all the nodes connected to it --- the final effect is that all the nodes reachable share the same list of nodes + + +-- | Reconcile the list of nodes in the cluster using a remote node already +-- part of the cluster. Reconciliation results in each node in the cluster +-- having exactly the same list of nodes. +connect' :: Node -> Cloud () connect' remotenode= do - nodes <- local getNodes - localIO $ putStrLn $ "connecting to: "++ show remotenode + nodes <- local getServerNodes + localIO $ putStr "connecting to: " >> print remotenode - newNodes <- runAt remotenode $ do - local $ do - conn@Connection{} <- getSData <|> + newNodes <- runAt remotenode $ interchange remotenode nodes + + local $ return () -- !> "interchange finish" + + -- add the new nodes to the local nodes in all the nodes connected previously + let toAdd=remotenode:tail newNodes + callNodes' nodes (<>) mempty $ local $ do + liftIO $ putStr "New nodes: " >> print toAdd + addNodes toAdd + + + + where + -- receive new nodes and send their own + interchange remotemode nodes= + do + newNodes <- local $ do + conn@Connection{remoteNode=rnode, connData=Just cdata} <- getSData <|> error ("connect': need to be connected to a node: use wormhole/connect/listen") - let nodeConnecting= head nodes - liftIO $ modifyMVar_ (connection nodeConnecting) $ const $ return [conn] + + -- if is a websockets node, add only this node + let newNodes = case cdata of + Node2Web _ -> [(head nodes){nodeServices=[("wsnode",show remotenode)]}] + _ -> nodes + + callingNode= head newNodes + + + liftIO $ writeIORef rnode $ Just callingNode + + liftIO $ modifyMVar_ (connection callingNode) $ const $ return [conn] + + onException $ \(e :: SomeException) -> do - liftIO $ putStrLn "removing node: ">> print nodeConnecting + liftIO $ putStr "connect:" >> print e + liftIO $ putStrLn "removing node: " >> print callingNode + topState >>= showThreads nodes <- getNodes - setNodes $ nodes \\ [nodeConnecting] + setNodes $ nodes \\ [callingNode] --- return nodes -- delete + return newNodes - mclustered . local $ addNodes nodes + oldNodes <- local $ getNodes - local $ do - allNodes <- getNodes - liftIO $ putStrLn "Known nodes: " >> print allNodes - return allNodes + mclustered . local $ do + liftIO $ putStrLn "New nodes1111: " >> print newNodes - local $ addNodes[remotenode] + addNodes newNodes + localIO $ atomically $ do + -- set the firt node (local node) as is called from outside +-- return () !> "HOST2 set" + nodes <- readTVar nodeList + let nodes'= (head nodes){nodeHost=nodeHost remotenode + ,nodePort=nodePort remotenode}:tail nodes + writeTVar nodeList nodes' - callNodes' nodes (<>) mempty $ local $ addNodes newNodes -- add the new discovered nodes - local $ do - nodes <- getNodes - liftIO $ putStrLn "Known nodes: " >> print nodes - + return oldNodes #else connect _ _= empty
src/Transient/Move/Services.hs view
@@ -2,7 +2,7 @@ -- -- Module : Transient.Move.Services -- Copyright : --- License : GPL-3 +-- License : MIT -- -- Maintainer : agocorona@gmail.com -- Stability : @@ -11,7 +11,7 @@ -- | -- ----------------------------------------------------------------------------- - +{-# LANGUAGE ScopedTypeVariables #-} module Transient.Move.Services where import Transient.Base @@ -35,7 +35,7 @@ import Data.Maybe import Data.Monoid import Control.Concurrent(threadDelay) -import Control.Exception +import Control.Exception hiding(onException) import Data.IORef monitorService= ("https://github.com/agocorona/transient-universe","monitor") @@ -193,12 +193,9 @@ callService' ident node params = do - onAll $ onFinish (\me -> do - case fmap fromException me :: Maybe(Maybe IOException) of - Nothing -> return () - Just (Just e') -> do - noFinish - liftIO startMonitor) + onAll $ onException $ \(e:: IOException) -> do + liftIO startMonitor + continue log <- onAll $ do log <- getSData <|> return emptyLog setData emptyLog @@ -262,7 +259,8 @@ local $ do conn <- defConnection - setData conn{myNode = mynode} + liftIO $ writeIORef (myNode conn) mynode + setState conn onAll inputAuthorizations <|> (inputNodes >> empty) <|> return () listen mynode where
src/Transient/Move/Utils.hs view
@@ -2,7 +2,7 @@ -- -- Module : Transient.Move.Utils -- Copyright : --- License : GPL-3 +-- License : MIT -- -- Maintainer : agocorona@gmail.com -- Stability : @@ -23,6 +23,7 @@ import Control.Monad.IO.Class import Data.IORef + -- | ask in the console for the port number and initializes a node in the port specified -- It needs the application to be initialized with `keep` to get input from the user. -- the port can be entered in the command line with "<program> -p start/<PORT>" @@ -66,8 +67,10 @@ -- | ask for nodes to be added to the list of known nodes. it also ask to connect to the node to get -- his list of known nodes. It returns empty inputNodes :: Cloud empty -inputNodes= onServer $ do - local $ option "add" "add a new node at any moment" +inputNodes= onServer $ listNodes <|> addNew + where + addNew= do + local $ option "add" "add a new node" host <- local $ do r <- input (const True) "Host to connect to: (none): " @@ -83,6 +86,10 @@ addNodes [nnode] empty + listNodes= do + local $ option "list" "list nodes" + local $ getNodes >>= liftIO . print + empty -- | executes the application in the server and the Web browser. -- the browser must point to http://hostname:port where port is the first parameter. @@ -111,7 +118,8 @@ initWebApp :: Node -> Cloud () -> TransIO () initWebApp node app= do conn <- defConnection - setData conn{myNode = node} + liftIO $ writeIORef (myNode conn) node + addNodes [node] serverNode <- getWebServerNode :: TransIO Node mynode <- if isBrowserInstance @@ -120,6 +128,7 @@ runCloud $ do listen mynode <|> return() wormhole serverNode app + return () -- only execute if the the program is executing in the browser. The code inside can contain calls to the server.
tests/TestSuite.hs view
@@ -1,11 +1,3 @@--- #!/usr/bin/env ./execthirdline.sh --- development: --- set -e && docker run -it -v /c/Users/magocoal/OneDrive/Haskell/devel:/devel agocorona/transient:05-02-2017 bash -c "runghc -j2 -isrc -i/devel/transient/src -i/devel/transient-universe/src /devel/transient-universe/tests/$1 $2 $3 $4" - --- compile and run within a docker image --- set -e && executable=`basename -s .hs ${1}` && docker run -it -v $(pwd):/work agocorona/transient:05-02-2017 bash -c "ghc /work/${1} && /work/${executable} ${2} ${3}" - - {-# LANGUAGE CPP #-} module Main where
transient-universe.cabal view
@@ -1,5 +1,5 @@ name: transient-universe -version: 0.4.1 +version: 0.4.4 cabal-version: >=1.10 build-type: Simple license: MIT @@ -7,7 +7,7 @@ maintainer: agocorona@gmail.com homepage: http://www.fpcomplete.com/user/agocorona bug-reports: https://github.com/agocorona/transient-universe/issues -synopsis: Remote execution and map-reduce: distributed computing for Transient +synopsis: Distributed computing with algebraic/monadic composability, map-reduce description: See <http://github.com/agocorona/transient>. category: Control @@ -61,7 +61,7 @@ text -any, time -any, transformers -any, - transient >=0.5.1 + transient >= 0.5.4 default-language: Haskell2010 hs-source-dirs: src .