transient-universe 0.4.6.1 → 0.5.0.0

raw patch · 8 files changed

+555/−353 lines, 8 filesdep ~transientPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: transient

API changes (from Hackage documentation)

Files

• README.md +21/−1
• src/Transient/MapReduce.hs +16/−12
• src/Transient/Move.hs +1/−8
• src/Transient/Move/Internals.hs +472/−292
• src/Transient/Move/Services.hs +5/−5
• src/Transient/Move/Utils.hs +31/−18
• tests/TestSuite.hs +1/−9
• transient-universe.cabal +8/−8

@@ -15,6 +15,26 @@ 
 All the nodes run the same program compiled for different architectures. It defines a Cloud computation (monad). It is a thin layer on top of transient with additional primitives and services that run a single program in one or many nodes.
 
+Example:
+=======
+
+```haskell
+main= keep . initNode $ inputNodes <|> mypPogram
+
+myProgram :: Cloud ()
+myProgram= do
+    nodes <- local getNodes
+    guard $ length nodes > 1
+    let node2= nodes !! 1
+    r <- runAt node2 . local $ waitEvents getLine
+    localIO $ print r
+    
+```
+
+This program will stream and print any text that you input in the console of the node 2.
+
+To know how to initialize the nodes, see the section of the  [Tutorial](https://github.com/transient-haskell/transient/wiki/Transient-tutorial#command-line-input)
+
 Browser integration
 ==================
 
@@ -22,7 +42,7 @@ 
 Distributed Browser/server Widgets
 -------
-Browser nodes can integrate Hplayground for ghcjs, a reactive client side library based in trasient (package axiom) 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.
+Browser nodes can integrate a reactive client side library based in trasient (package  [axiom](https://github.com/transient-haskell/axiom)). These widgets can create widgets with HTML form elements and control the server nodes. A computation can move from browser to server and back 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.
 

@@ -235,8 +235,8 @@ 
                  n <- localIO  $ modifyMVar nsent $ \r -> return (r+1, r+1)
 
-                 runAt (nodes !! i) $  local $ putMailbox' mboxid (Reduce folded)
---                                                     !> ("send",n,length,port,i,folded))
+                 (runAt (nodes !! i) $  local $ putMailbox' mboxid (Reduce folded))
+                                                     !> ("send",n,length,i,folded)
 
 --                 return () !> (port,n,length)
 
@@ -292,10 +292,10 @@                                   let maccum =  M.lookup k map
                                   return $ M.insert k (case maccum of
                                     Just accum ->  red input accum
-                                    Nothing    ->  input) map
+                                    Nothing    ->  input) map 
 
                 mapM addIt  (kvs `asTypeOf` paramOf' dds)
-                                                                   --  !> ("Received Reduce",kvs)
+                                                                     !> ("Received Reduce",kvs)
                 stop
 
 
@@ -318,9 +318,6 @@ mparallelize f xs =  loggedc $ foldr (<>) mempty $ map f xs
 
 
-
-
-
 getPartitionData :: Loggable a => PartRef a   -> TransIO  a
 getPartitionData (Ref node path save)  = Transient $ do
     mp <- (liftIO $ atomically
@@ -443,7 +440,9 @@                         body <- liftIO $  getResponseBody r
                         let xs = partitioner body
                             size= case length xs `div` lnodes of 0 ->1 ; n -> n
-                            xss= Transient.MapReduce.fromList $ take size $ drop  (i *  size) xs
+                            xss= Transient.MapReduce.fromList $
+                                  if i== lnodes-1 then drop (i* size) xs else  take size $ drop  (i *  size) xs
+     
                         generateRef  xss
 
 
@@ -461,10 +460,15 @@    parallelize  (process lnodes) $ zip nodes [0..lnodes-1]    -- !> show xss
    where
    process lnodes (node, i)=  runAt node $ local $ do
-                        content <- liftIO $ readFile file
-                        let xs = partitioner content
+                        content <-  do
+                              c <- liftIO $ readFile file
+                              length c `seq` return c
+                        let xs = partitioner  content
+                        
                             size= case length xs `div` lnodes of 0 ->1 ; n -> n
-                            xss=Transient.MapReduce.fromList $ take size $ drop  (i *  size) xs  -- !> size
+                            xss= Transient.MapReduce.fromList $
+                                   if i== lnodes-1 then drop (i* size) xs else  take size $ drop  (i *  size) xs
+     
                         generateRef    xss
 
 
@@ -504,4 +508,4 @@ 
 
 
-#endif
+#endif

@@ -59,7 +59,7 @@ Transient.Move.Internals.connect, connect', listen,
 -- Low level APIs
 addNodes, shuffleNodes,
-Connection(..), ConnectionData(..), defConnection,
+--Connection(..), ConnectionData(..), defConnection,
 
 -- ** Querying nodes
 getMyNode, getWebServerNode, getNodes, nodeList, isBrowserInstance,
@@ -92,13 +92,6 @@ -- * REST API
 api, HTTPMethod(..), PostParams,
 #endif
-
--- * Low Level APIs
-
-#ifndef ghcjs_HOST_OS
- ParseContext(..)
-#endif
-
 ) where
 
 import Transient.Move.Internals

@@ -19,7 +19,8 @@ module Transient.Move.Internals where
 
 import Transient.Internals
-import Transient.Logged
+import Transient.Parse
+import Transient.Logged 
 import Transient.Indeterminism
 --  import Transient.Backtrack
 import Transient.EVars
@@ -27,6 +28,8 @@ 
 import Data.Typeable
 import Control.Applicative
+import System.IO.Error
+
 #ifndef ghcjs_HOST_OS
 import Network
 --- import Network.Info
@@ -49,6 +52,8 @@ import           Data.CaseInsensitive(mk)
 import           Data.Char(isSpace)
 
+-- import System.Random
+
 #else
 import           JavaScript.Web.WebSocket
 import qualified JavaScript.Web.MessageEvent           as JM
@@ -120,9 +125,10 @@ 
 -- The cloud monad is a thin layer over Transient in order to make sure that the type system
 -- forces the logging of intermediate results
-newtype Cloud a= Cloud {runCloud' ::TransIO a} deriving (Functor,Applicative,Monoid,Alternative, Monad, Num, MonadState EventF)
+newtype Cloud a= Cloud {runCloud' ::TransIO a} deriving (Functor,Monoid,Applicative,Alternative, Monad, Num, Fractional, MonadState EventF)
 
 
+
 -- | Execute a distributed computation inside a TransIO computation.
 -- All the  computations in the TransIO monad that enclose the cloud computation must be `logged`
 runCloud :: Cloud a -> TransIO a
@@ -209,12 +215,13 @@ onAll ::  TransIO a -> Cloud a
 onAll =  Cloud
 
--- | only executes if the result is demanded
+-- | only executes if the result is demanded. It is useful when the conputation result is only used in
+-- the remote node, but it is not serializable.
 lazy :: TransIO a -> Cloud a
 lazy mx= onAll $ getCont >>= \st -> Transient $
         return $ unsafePerformIO $  runStateT (runTrans mx) st >>=  return .fst
 
--- | executes a non-serilizable action  in the remote node, whose result can be used by subsequent remote invocations
+-- | executes a non-serilizable action in the remote node, whose result can be used by subsequent remote invocations
 fixRemote mx= do
              r <- lazy mx
              fixClosure
@@ -229,18 +236,21 @@ -- inside and substitute it for that single result when the computation is completed.
 loggedc :: Loggable a => Cloud a -> Cloud a
 loggedc (Cloud mx)= Cloud $ do
-    closRemote  <- getSData <|> return (Closure  0 )
-    logged mx <*** setData  closRemote
+     closRemote  <- getSData <|> return (Closure  0 )
+     logged mx <*** setData  closRemote 
 
 
 loggedc' :: Loggable a => Cloud a -> Cloud a
 loggedc' (Cloud mx)= Cloud $ logged mx
+  
 
+    
+
 -- | the `Cloud` monad has no `MonadIO` instance. `lliftIO= local . liftIO`
 lliftIO :: Loggable a => IO a -> Cloud a
 lliftIO= local . liftIO
 
--- | locally perform IO. `localIO = lliftIO`
+-- |  `localIO = lliftIO`
 localIO :: Loggable a => IO a -> Cloud a
 localIO= lliftIO
 
@@ -250,7 +260,6 @@ 
 
 -- | continue the execution in a new node
--- all the previous actions from `listen` to this statement must have been logged
 beamTo :: Node -> Cloud ()
 beamTo node =  wormhole node teleport
 
@@ -264,19 +273,7 @@ -- and responses (streaming)
 callTo :: Loggable a => Node -> Cloud a -> Cloud a
 callTo node  remoteProc= wormhole node $ atRemote remoteProc
-  --  wormhole node $  do
-  --      relay <- local $ do
-  --             conn <-  getState <|> error ("no connection with node: " ++ show node)
-  --             case connData conn of  
-  --               Just (Relay conn remoteNode) -> do
-  --                  setData conn   !> "callTo RELAY"
-  --                  return $ Just remoteNode 
-  --               _ -> return Nothing
-  --      case relay of
-  --          Just remoteNode  ->
-  --             atRemote $ callTo remoteNode remoteProc
-  --          _ ->
-  --             atRemote remoteProc  !> "callTo NO RELAY"
+ 
 
 #ifndef ghcjs_HOST_OS
 -- | A connectionless version of callTo for long running remote calls
@@ -289,21 +286,40 @@     return r
 #endif
 
--- |  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.
+-- | Within a connection to a node opened by `wormhole`, it run the computation in the remote node and return
+-- the result back to the original node.
+--
+-- If `atRemote` is executed in the remote node, then the computation is executed in the original node
+--
+-- > wormhole node2 $ do
+-- >     t <- atRemote $ do
+-- >           r <- foo              -- executed in node2
+-- >           s <- atRemote bar r   -- executed in the original node
+-- >           baz s                 -- in node2
+-- >     bat t                      -- in the original node
+
 atRemote :: Loggable a => Cloud a -> Cloud a
 atRemote proc= loggedc' $ do
      was <- lazy $ getSData <|> return NoRemote
      teleport                                              -- !> "teleport 1111"
-     r <- Cloud $ runCloud proc <** setData WasRemote
+     r <- Cloud $ runCloud' proc  <** setData WasRemote
      teleport                                              -- !> "teleport 2222"
-     onAll $ setData was
+     lazy $ setData was
      return r
 
+-- | Execute a computation in the node that initiated the connection. 
+--
+-- if the sequence of connections is  n1 -> n2 -> n3 then  `atCallingNode $ atCallingNode foo` in n3 
+-- would execute `foo` in n1, -- while `atRemote $ atRemote foo` would execute it in n3
+-- atCallingNode :: Loggable a => Cloud a -> Cloud a
+-- atCallingNode proc=  connectCaller $ atRemote proc 
+
 -- | synonymous of `callTo`
 runAt :: Loggable a => Node -> Cloud a -> Cloud a
 runAt= callTo
 
+
+
 -- | run a single thread with that action for each connection created.
 -- When the same action is re-executed within that connection, all the threads generated by the previous execution
 -- are killed
@@ -350,43 +366,72 @@              liftIO $ modifyIORef rmap $ \mapth -> M.insert id tv mapth
 
 
-
+--data ParentConnection= ParentConnection Connection (Maybe Closure) deriving Typeable
 
 -- | A wormhole opens a connection with another node anywhere in a computation.
 -- `teleport` uses this connection to translate the computation back and forth between the two nodes connected
 wormhole :: Loggable a => Node -> Cloud a -> Cloud a
 wormhole node (Cloud comp) = local $ Transient $ do
+  
    moldconn <- getData :: StateIO (Maybe Connection)
    mclosure <- getData :: StateIO (Maybe Closure)
+      -- when (isJust moldconn) . setState $ ParentConnection (fromJust moldconn) mclosure
    
    -- labelState $ "wormhole" ++ show node
-   logdata@(Log rec log fulLog) <- getData `onNothing` return (Log False [][])
-
+   Log rec _ _  _<- getData `onNothing` return (Log False [][] 0)
 
    if not rec                                    
             then runTrans $ (do
-
                     conn <-  mconnect node
                     liftIO $ writeIORef (remoteNode conn) $ Just node
                     setData  conn{calling= True}
+                    
                     setData $ (Closure 0 )
-
+                    
                     comp )
-                  <*** do when (isJust moldconn) . setData $ fromJust moldconn
-                          when (isJust mclosure) . setData $ fromJust mclosure
+                  <*** do
+                       when (isJust moldconn) . setData $ fromJust moldconn
+                       when (isJust mclosure) . setData $ fromJust mclosure
                     -- <** is not enough since comp may be reactive
             else do
-             let conn = fromMaybe (error "wormhole: no connection in remote node") moldconn
-
-             setData $ conn{calling= False}
-
-             runTrans $  comp
-                     <*** do
-
-                          when (isJust mclosure) . setData $ fromJust mclosure
-
-
+                    let conn = fromMaybe (error "wormhole: no connection in remote node") moldconn
+                    setData $ conn{calling= False}
+                    runTrans $ comp
+                             <***  do when (isJust mclosure) . setData $ fromJust mclosure
 
+-- | connect to the caller node.
+-- connectCaller :: Loggable a => Cloud a -> Cloud a 
+-- connectCaller (Cloud comp)= local $ do 
+--   conn <-  getState  !> "CONNECTCALLER"
+--   case connData conn of
+--      Nothing -> empty
+--      Just Self -> empty 
+--      _ ->  if not $ calling conn !> ("calling", calling conn) then comp else do
+--           ParentConnection conn mmclosure <- getState <|> error "connectCaller: No connection defined: use wormhole"
+--           moldconn <- getData :: TransIO (Maybe Connection)
+--           mclosure <- getData :: TransIO (Maybe Closure)
+       
+--           -- labelState $ "wormhole" ++ show node
+--           Log rec _ _ <- getData `onNothing` return (Log False [][])
+       
+       
+--           if not rec                                    
+--                    then do
+--                           --  liftIO $ writeIORef (remoteNode conn) $ Just node
+--                            setData  conn{calling= True}
+--                            setData $ if (isJust mmclosure) 
+--                                then fromJust mmclosure
+--                                else Closure 0
+       
+--                            comp 
+--                          <*** do when (isJust moldconn) . setData $ fromJust moldconn
+--                                  when (isJust mclosure) . setData $ fromJust mclosure
+--                            -- <** is not enough since comp may be reactive
+--                    else do
+--                            let conn = fromMaybe (error "wormhole: no connection in remote node") moldconn
+--                            setData $ conn{calling= False}
+--                            comp
+--                                  <*** do when (isJust mclosure) . setData $ fromJust mclosure
 
 #ifndef ghcjs_HOST_OS
 type JSString= String
@@ -396,74 +441,93 @@ 
 #endif
 
+data CloudException = CloudException Node IdClosure   String deriving (Typeable, Show, Read)
 
+instance Exception CloudException 
+
 teleport ::   Cloud ()
-teleport =  do
-  local $ Transient $ do
+teleport =  local $ do
+  Transient $ do
      cont <- get
-     Log rec log fulLog <- getData `onNothing` return (Log False [][])
-
-     conn@Connection{connData=contype,closures= closures,calling= calling} <- getData
-             `onNothing` error "teleport: No connection defined: use wormhole"
-
+     Log rec log fulLog closLocal <- getData `onNothing` return (Log False [][] 0)
+    
+     conn@Connection{connData=contype, localClosures= localClosures,calling= calling} <- getData
+                             `onNothing` error "teleport: No connection defined: use wormhole"
      if not rec   -- !> ("teleport rec,loc fulLog=",rec,log,fulLog)
                   -- if is not recovering in the remote node then it is active
       then  do
 
- 
-
-#ifndef ghcjs_HOST_OS
+        
+-- when a node call itself, there is no need of socket communications
+-- #ifndef ghcjs_HOST_OS
         case contype of
          Just Self ->  runTrans $ do
---               return () !> "SELF"
-               setData $  if (not calling) then  WasRemote else WasParallel
-               abduce  -- !> "SELF" -- call himself
+               setData $ if (not calling) then WasRemote else WasParallel
+               abduce   !> "SELF" -- call himself
                liftIO $ do
                   remote <- readIORef $ remoteNode conn
                   writeIORef (myNode conn) $ fromMaybe (error "teleport: no connection?") remote
 
 
          _ -> do
-#else
-        do
-#endif
 
+-- #endif
+
          --read this Closure
           Closure closRemote  <- getData `onNothing`  return (Closure 0 )
+          
 
-          let closLocal = sum $ map ( \x -> case x of Wait -> 100000;
-                                                      Exec -> 1000
-                                                      _ -> 1) fulLog          
+          return () !> ("TELEPORTTTTTTTTTT", closLocal)
          --set his own closure in his Node data
 
-
           -- closLocal  <-   liftIO $ randomRIO (0,1000000)
 --          node <- runTrans getMyNode
           
-          liftIO $ modifyMVar_ closures $ \map -> return $ M.insert closLocal (fulLog,cont) map
 
-          let tosend= reverse $ if closRemote==0 then fulLog     else log 
-
+          let tosend= reverse $ if closRemote==0 then fulLog     else log
+          
+          liftIO $ modifyMVar_ localClosures $ \map -> return $ M.insert closLocal cont map
+          -- The log sent is in the order of execution. log is in reverse order
+          
           -- send log with closure ids at head
-          runTrans $ do msend conn $ SMore $ ClosureData closRemote closLocal tosend
-                                     !> ("teleport sending", SMore (closRemote,closLocal,tosend))
-                                     !> "--------->------>---------->"
-                  
-
-          setData $ if (not calling) then  WasRemote else WasParallel !> "SET WASPAraLLEL"
-
+          runTrans $ msend conn $ SMore $ ClosureData closRemote closLocal tosend 
+                                       !> ("teleport sending", SMore (unsafePerformIO $ readIORef $ remoteNode conn,closRemote,closLocal,tosend))
+                                       !> "--------->------>---------->"
+                                      --  -- !> ("log",reverse fulLog)
+ 
+  
+          setData $ if (not calling) then  WasRemote else WasParallel  -- !> "SET WASPAraLLEL"
           return Nothing
 
       else do
-         delData WasRemote                -- !> "deleting wasremote in teleport"
+         delData WasRemote                -- deleting wasremote in teleport
                                           -- it is recovering, therefore it will be the
                                           -- local, not remote
+         return $ Just ()
 
-         return (Just ())                           --  !> "TELEPORT remote"
+        --  code moved to reportBack
+        --  runTrans $ onException $ \(e :: SomeException) -> do 
 
+        --         Closure closRemote <- getData `onNothing` error "teleport: no closRemote"
+        --         node <- getMyNode
+        --         let msg= SError $ toException $ ErrorCall $  show $ show $ CloudException node closRemote   $ show e
+        --         msend conn msg  !> "MSEND"
+                
+                
+             
+  return ()                           --  !> "TELEPORT remote"
 
+-- | forward exceptions to the calling node
+reportBack :: TransIO ()
+reportBack= onException $ \(e :: SomeException) -> do 
+    conn<- getData `onNothing` error "reportBack: No connection defined: use wormhole"
+    Closure closRemote <- getData `onNothing` error "teleport: no closRemote"
+    node <- getMyNode
+    let msg= SError $ toException $ ErrorCall $  show $ show $ CloudException node closRemote   $ show e
+    msend conn msg  !> "MSEND"
 
 
+
 -- | copy a session data variable from the local to the remote node.
 -- If there is none set in the local node, The parameter is the default value.
 -- In this case, the default value is also set in the local node.
@@ -478,11 +542,11 @@ -- same `listen`  or `connect`
 -- 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 :: Typeable val => val -> TransIO ()
 putMailbox = putMailbox' (0::Int)
 
 -- | write to a mailbox identified by an identifier besides the type
-putMailbox' :: (Typeable b, Ord b, Typeable a) =>  b -> a -> TransIO ()
+putMailbox' :: (Typeable key, Ord key, Typeable val) =>  key -> val -> TransIO ()
 putMailbox'  idbox dat= do
    let name= MailboxId idbox $ typeOf dat
    Connection{comEvent= mv} <- getData `onNothing` errorMailBox
@@ -507,11 +571,11 @@ -- The order of reading is defined by `readTChan`
 -- 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 :: Typeable val => TransIO val
 getMailbox = getMailbox' (0 :: Int)
 
 -- | read from a mailbox identified by an identifier besides the type
-getMailbox' :: (Typeable b, Ord b, Typeable a) => b -> TransIO a
+getMailbox' :: (Typeable key, Ord key, Typeable val) => key -> TransIO val
 getMailbox' mboxid = x where
  x = do
 
@@ -578,66 +642,73 @@ callNodes' nodes op init proc= loggedc' $ 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"
 
-
-data NodeMSG= ClosureData IdClosure IdClosure CurrentPointer    | RelayMSG Node Node (StreamData NodeMSG) 
+type LengthFulLog= Int
+data NodeMSG= ClosureData IdClosure IdClosure CurrentPointer 
+            | RelayMSG Node Node (StreamData NodeMSG) 
    deriving (Typeable, Read, Show)
 
-msend :: MonadIO m => Connection -> StreamData NodeMSG -> m ()
+msend ::  Connection -> StreamData NodeMSG -> TransIO ()
 
+msend (Connection _ _ _ (Just Self) _ _ _ _ _ _) r= return ()
+
 #ifndef ghcjs_HOST_OS
 
-msend (Connection _ _ (Just (Node2Node _ sock _)) _ _ blocked _ _ _) r=do
-   liftIO $   withMVar blocked $  const $ SBS.sendAll sock $ BC.pack (show r)   !> "N2N SEND"
 
-msend (Connection _ _ (Just (TLSNode2Node ctx)) _ _ _ _ _ _) r=
-     liftIO $ sendTLSData  ctx $ BS.pack (show r)                             -- !> "TLS SEND"
+msend (Connection _ _ _ (Just (Node2Node _ sock _)) _ _ blocked _ _ _) r=do
+   liftIO $   withMVar blocked $  const $ SBS.sendAll sock $ BC.pack (show r)   !> ("N2N SEND", r)
 
+msend (Connection _ _ _ (Just (TLSNode2Node ctx)) _ _ _ _ _ _) r=
+     liftIO $ sendTLSData  ctx $ BS.pack (show r)                              !> "TLS SEND"
 
-msend (Connection _ _ (Just (Node2Web sconn)) _ _ _ _  _ _) r=liftIO $
-  {-withMVar blocked $ const $ -} WS.sendTextData sconn $ BS.pack (show r)   -- !> "websockets send"
 
-msend((Connection myNode _ (Just (Relay conn remote )) _ _ _ _  _ _)) r= do
-   origin <- liftIO $ readIORef myNode  -- `onNothing` error "msend: no remote node in connection"
-  --  msend conn $ SMore (ClosureData 0 0 [Var $ IDynamic (),Var . IDynamic $ origin{nodeServices=[]}
-  --                                     ,Var $ IDynamic remote{nodeServices=[]},Var $ IDynamic r])  -- writeEVar req r  !> "msed relay" 
+msend (Connection _ _ _ (Just (Node2Web sconn)) _ _ _ _ _ _) r=liftIO $
+  {-withMVar blocked $ const $ -} WS.sendTextData sconn $ BS.pack (show r)    !> "websockets send"
+
+msend(Connection _ myNode _ (Just (Relay conn remote )) _ _ _ _ _ _) r= do
+   origin <- liftIO $ readIORef myNode 
    msend conn $ SMore $ RelayMSG origin remote r
 
 
 #else
 
-msend (Connection _ _ (Just (Web2Node sconn)) _ _ blocked _  _ _) r= liftIO $
-  withMVar blocked $ const $ JavaScript.Web.WebSocket.send  (JS.pack $ show r) sconn   -- !!> "MSEND SOCKET"
+msend (Connection _ _ remoten (Just (Web2Node sconn)) _ _ blocked _  _ _) r= liftIO $  do
+  -- when (js_readystate sconn /= 1) $ do  -- must try to reconnect
+  --        Just node <- liftIO $ readIORef remoten
+  --        ...
+  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 connection context: use wormhole to connect"
 
+
+
 mread :: Loggable a => Connection -> TransIO (StreamData a)
 
 
 #ifdef ghcjs_HOST_OS
 
 
-mread (Connection _ _ (Just (Web2Node sconn)) _ _ _ _  _ _)=  wsRead sconn
+mread (Connection _ _ _ (Just (Web2Node sconn)) _ _ _ _  _ _)=  wsRead sconn
 
 
 
@@ -663,6 +734,10 @@    js_hostname ::    JSVal
 
 foreign import javascript safe
+   "window.location.pathname"
+  js_pathname ::    JSVal
+
+foreign import javascript safe
     "window.location.protocol"
    js_protocol ::    JSVal
 
@@ -691,6 +766,10 @@              "$1.onopen =$2;"
    js_open :: WebSocket  -> JSVal  -> IO ()
 
+foreign import javascript safe
+             "$1.readyState"
+  js_readystate ::  WebSocket -> Int
+
 newtype OpenEvent = OpenEvent JSVal deriving Typeable
 hsopen ::  WebSocket -> (OpenEvent ->IO()) -> IO ()
 hsopen ws hscb= do
@@ -709,20 +788,20 @@ 
 
 #else
-mread (Connection _ _(Just (Node2Node _ _ _)) _ _ _ _ _ _) =  parallelReadHandler -- !> "mread"
+mread (Connection _ _ _ (Just (Node2Node _ _ _)) _ _ _ _ _ _) =  parallelReadHandler -- !> "mread"
 
-mread (Connection _ _ (Just (TLSNode2Node _)) _ _ _ _ _ _) =  parallelReadHandler
+mread (Connection _ _ _ (Just (TLSNode2Node _ )) _ _ _ _ _ _) =  parallelReadHandler
 --        parallel $ do
 --            s <- recvTLSData  ctx
 --            return . read' $  BC.unpack s
 
-mread (Connection _ _  (Just (Node2Web sconn )) _ _ _ _ _ _)=
+mread (Connection _ _ _  (Just (Node2Web sconn )) _ _ _ _ _ _)=
         parallel $ do
             s <- WS.receiveData sconn
             return . read' $  BS.unpack s
                 !>  ("WS MREAD RECEIVED ----<----<------<--------", s)
 
-mread (Connection  _ _ (Just (Relay conn _  )) _ _ _ _ _ _)=  
+mread (Connection  _ _ _ (Just (Relay conn _  )) _ _ _ _ _ _)=  
      mread conn  -- !> "MREAD RELAY"
        
 
@@ -731,13 +810,12 @@ parallelReadHandler :: Loggable a => TransIO (StreamData a)
 parallelReadHandler= do
       str <- giveData :: TransIO BS.ByteString
-      r <- choose $ readStream str
+      r <- choose $ readStream  str
 
       return  r
-                  !> ("parallel read handler read",  r)
-                  !> "<-------<----------<--------<----------"
+                   !> ("parallel read handler read",  r)
+                   !> "<-------<----------<--------<----------"
     where
-
     readStream :: (Typeable a, Read a) =>  BS.ByteString -> [StreamData a]
     readStream s=  readStream1 $ BS.unpack s
      where
@@ -752,10 +830,8 @@ getWebServerNode = getNodes >>= return . head
 #endif
 
-read' s= case readsPrec' 0 s of
-       [(x,"")] -> x
-       _  -> error $ "reading " ++ s
 
+
 --release (Node h p rpool _) hand= liftIO $ do
 ----    print "RELEASED"
 --    atomicModifyIORef rpool $  \ hs -> (hand:hs,())
@@ -765,17 +841,17 @@ 
 #ifndef ghcjs_HOST_OS
 
-mclose (Connection _ _
+mclose (Connection _ _ _
    (Just (Node2Node _  sock _ )) _ _ _ _ _ _)= NS.close sock
 
-mclose (Connection _ _
+mclose (Connection _ _ _
    (Just (Node2Web sconn ))
    _ _ _ _  _ _)=
     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
@@ -786,17 +862,17 @@ mconnect  node'=  do
   node <- fixNode node'
   nodes <- getNodes
-  return ()                                            --    !>  ("mconnnect", nodePort node)
+  return ()                                                !>  ("mconnnect", nodePort node)
   let fnode =  filter (==node) nodes
   case fnode of
    [] -> mconnect1 node   -- !> "NO NODE"
    [node'@(Node _ _ pool _)] -> do
       plist <- liftIO $  readMVar $ fromJust pool 
-      case plist of                                      --   !>  ("length", length plist,nodePort node) of
+      case plist of                                      --  !>  ("length", length plist,nodePort node) of
         (handle:_) -> do
                   delData $ Closure undefined
                   return  handle
---                                                            !>   ("REUSED!", node)
+                                                           !>   ("REUSED!", node)
 
         _ -> mconnect1 node'                                 
   where
@@ -806,9 +882,8 @@   mconnect1 (node@(Node host port _ _))= do
 
      return ()  !> ("MCONNECT1",host,port,nodeServices node)
---     (do
---      liftIO $ when (host== "192.168.99.100" && (port == 8081 || port== 8080)) $  error "connnnn"  !> "detected"
-     (conn,parseContext) <- timeout 1000000 (connectNode2Node host port)   <|>
+     (conn,parseContext) <- checkSelf node                                 <|>
+                            timeout 1000000 (connectNode2Node host port)   <|>
                             timeout 1000000 (connectWebSockets host port)  <|> 
                             checkRelay                                     <|>
                             (throwt $ ConnectionError "" node)
@@ -823,12 +898,30 @@      liftIO $ modifyMVar_ (fromJust $ connection node) . const $ return [conn]
      addNodes [node]
 
-     watchConnection
+     case connData conn of
+       Just Self -> return()
+       _         -> watchConnection
      delData $ Closure undefined
      return  conn
 
     where
+    checkSelf node= do
+      node' <- getMyNode
+      if node /= node' 
+       then  empty
+       else do
+          conn<- case connection node of
+             Nothing    -> error "checkSelf error"
+             Just ref   ->  do
+                 cnn <- getSData <|> error "chechself: no connection"
+                 rnode  <- liftIO $ newIORef node
+                 conn   <- defConnection >>= \c -> return c{myNode= rnode, comEvent=comEvent cnn,connData= Just Self} !> "DEFF1"
+                 liftIO $ withMVar ref $ const $ return [conn]
+                 return conn
 
+          return (conn,(ParseContext (error "checkSelf parse error") (error "checkSelf parse error")
+                            ::  ParseContext BS.ByteString)) 
+
     timeout t proc=do
        r <- collect' 1 t proc
        case r of
@@ -864,17 +957,17 @@                              ::  ParseContext BS.ByteString)
 
     connectSockTLS host port= do
-        -- return ()                                         !> "connectSockTLS"
+        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 ->
+        conn' <- defConnection >>= \c ->
                      return c{myNode=my, comEvent= ev,connData=
                      
-                     Just $ (Node2Node u  sock (error $ "addr: outgoing connection"))}
+                     Just $ (Node2Node u  sock (error $ "addr: outgoing connection"))} 
 
         setData conn'
         input <-  liftIO $ SBSL.getContents sock
@@ -914,7 +1007,7 @@          connectSockTLS host port  -- a new connection
 
          never  <- liftIO $ newEmptyMVar :: TransIO (MVar ())
-         conn   <- getSData  <|> error "connectWebSockets: no connection"
+         conn   <- getSData <|> error "connectWebSockets: no connection"
          stream <- liftIO $ makeWSStreamFromConn conn
          wscon  <- react (NWS.runClientWithStream stream (host++(':': show port)) "/"
                       WS.defaultConnectionOptions []) (takeMVar never)
@@ -938,19 +1031,15 @@         -- tell listenResponses to watch incoming responses
         putMailbox  ((conn',parseContext,node)                            
               :: (Connection,ParseContext BS.ByteString,Node))
-
         liftIO $ threadDelay 100000  -- give time to initialize listenResponses
 
 #else
   mconnect1 (node@(Node host port (Just pool) _))= do
---    my <- getMyNode
-
-    Connection{myNode=my,comEvent= ev} <- getSData <|> error "connect: listen not set for this node"
-
-    do
+     conn' <- getSData <|> error "connect: listen not set for this node"
+     if nodeHost node== "webnode" then return  conn'{connData= Just Self} else do
         ws <- connectToWS host $ PortNumber $ fromIntegral port
 --                                                           !> "CONNECTWS"
-        conn <- defConnection >>= \c -> return c{comEvent= ev,connData= Just  (Web2Node ws)}
+        let conn=  conn'{connData= Just  (Web2Node ws)}
 --                                                           !>  ("websocker CONNECION")
         let parseContext =
                       ParseContext (error "parsecontext not available in the browser")
@@ -994,8 +1083,10 @@ #else
 connectToWS  h (PortNumber p) = do
    protocol <- liftIO $ fromJSValUnchecked js_protocol
+   pathname <- liftIO $ fromJSValUnchecked js_pathname
+   return () !> ("PAHT",pathname)
    let ps = case (protocol :: JSString)of "http:" -> "ws://"; "https:" -> "wss://"
-   wsOpen $ JS.pack $ ps++ h++ ":"++ show p
+   wsOpen $ JS.pack $ ps++ h++ ":"++ show p ++ pathname
 #endif
 
 
@@ -1017,7 +1108,7 @@                    Self
                    | Web2Node{webSocket :: WebSocket}
 #endif
-
+   --   deriving (Eq,Ord)
 
 
 data MailboxId =  forall a .(Typeable a, Ord a) => MailboxId a TypeRep
@@ -1032,10 +1123,11 @@                  EQ -> t `compare` t'
                  LT -> LT
                  GT -> GT
-         GT -> GT
-         LT -> LT
 
-data Connection= Connection{myNode     :: IORef Node
+         other -> other
+
+data Connection= Connection{idConn     :: Int
+                           ,myNode     :: IORef Node
                            ,remoteNode :: IORef (Maybe Node)
                            ,connData   :: Maybe ConnectionData
                            ,bufferSize :: BuffSize
@@ -1044,8 +1136,8 @@                            -- multiple wormhole/teleport use the same connection concurrently
                            ,blocked    :: Blocked
                            ,calling    :: Bool
-                           -- local closures with his log and his continuation
-                           ,closures   :: MVar (M.Map IdClosure ([LogElem], EventF))
+                           -- local localClosures with his log and his continuation
+                           ,localClosures   :: MVar (M.Map IdClosure  EventF)
 
                            -- for each remote closure that points to local closure 0,
                            -- a new container of child processes
@@ -1063,25 +1155,28 @@ 
 
 
-defConnection :: MonadIO m => m Connection
+defConnection :: (MonadIO m, MonadState EventF m)  => m Connection
 
+
 -- #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 my noremote Nothing  8192
-                 (error "defConnection: accessing network events out of listen")
-                 x  False y z
+defConnection =  do
+  idc <- genGlobalId
+  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 idc my noremote Nothing  8192
+                  (error "defConnection: accessing network events out of listen")
+                  x  False y z
 
 
 
 #ifndef ghcjs_HOST_OS
 setBuffSize :: Int -> TransIO ()
 setBuffSize size= Transient $ do
-   conn<- getData `onNothing`  defConnection
+   conn<- getData `onNothing`  (defConnection !> "DEFF3")
    setData $ conn{bufferSize= size}
    return $ Just ()
 
@@ -1096,7 +1191,8 @@ listen ::  Node ->  Cloud ()
 listen  (node@(Node _   port _ _ )) = onAll $ do
    addThreads 1
-   setData $ Log False [] []
+   
+   setData $ Log False [] [] 0
 
    conn' <- getSData <|> defConnection
    ev <- liftIO $ newIORef M.empty
@@ -1111,10 +1207,12 @@    liftIO $ modifyMVar_ (fromJust $ connection node') $ const $ return [conn]
 
    addNodes [node'] 
+   
    mlog <- listenNew (fromIntegral port) conn  <|> listenResponses :: TransIO (StreamData NodeMSG)
-   case mlog of 
-       SMore (RelayMSG _ _ _) ->relay mlog
-       _ -> execLog  mlog
+   return () !> mlog  
+   case mlog  of 
+       SMore (RelayMSG _ _ _) -> relay mlog
+       _                      -> execLog  mlog
  `catcht` (\(e ::SomeException) -> liftIO $ print  e)
 
 
@@ -1185,7 +1283,8 @@           in (origin',destiny')
 
 -- listen incoming requests
-listenNew port conn'= do
+listenNew port conn'=  do
+   
 
    sock <- liftIO . listenOn $ PortNumber port
 
@@ -1200,17 +1299,18 @@ --     NS.SockAddrInet port host -> liftIO $ print("connection from", port, host)
 --     NS.SockAddrInet6  a b c d -> liftIO $ print("connection from", a, b,c,d)
    noNode <- liftIO $ newIORef Nothing
-   let conn= conn'{closChildren=chs, remoteNode= noNode}
+   id1 <- genId
+   let conn= conn'{idConn=id1,closChildren=chs, remoteNode= noNode}
 
    input <-  liftIO $ SBSL.getContents sock
 
    cutExceptions
    
-   onException $ \(e :: SomeException) -> do
-            --  cutExceptions
+   onException $ \(e :: IOException) -> 
+          when (ioeGetLocation e=="Network.Socket.recvBuf") $ do
              liftIO $ putStr "listen: " >> print e
              
-             let Connection{remoteNode=rnode,closures=closures,closChildren= rmap} = conn
+             let Connection{remoteNode=rnode,localClosures=localClosures,closChildren= rmap} = conn
              -- TODO How to close Connection by discriminating exceptions
              mnode <- liftIO $ readIORef rnode
              case mnode of
@@ -1220,10 +1320,10 @@                              nodes <- getNodes
                              setNodes $ nodes \\ [node]
              liftIO $ do
-                  modifyMVar_ closures $ const $ return M.empty
+                  modifyMVar_ localClosures $ const $ return M.empty
                   writeIORef rmap M.empty
-            --  topState >>= showThreads
-            -- cutExceptions
+             -- topState >>= showThreads
+            
              killBranch
              
 
@@ -1235,8 +1335,8 @@ 
 
 
-   (method,uri, headers) <- receiveHTTPHead
-   maybeSetHost headers
+  --  (method,uri, headers) <- receiveHTTPHead
+   (method, uri, vers) <- getFirstLine
    case method of
 
      "CLOS" ->
@@ -1247,16 +1347,16 @@            mread conn
 
      _ -> do
-           let uri'= BC.tail $ uriPath uri
+           let uri'= BC.tail $ uriPath uri !> uriPath uri
            if  "api/" `BC.isPrefixOf` uri'
              then do
 
-
                log <- return $ Exec: (Var $ IDyns $ BS.unpack method):(map (Var . IDyns ) $ split $ BC.unpack $ BC.drop 4 uri')
 
 
                str <-  giveData  <|> error "no api data"
-
+               headers <- getHeaders
+               maybeSetHost headers
                log' <- case (method,lookup "Content-Type" headers) of
                        ("POST",Just "application/x-www-form-urlencoded") -> do
                             len <- read <$> BC.unpack
@@ -1268,10 +1368,13 @@ 
                        _ -> return $ log  -- ++ [Var $ IDynamic  str]
 
-               return $ SMore $ ClosureData 0 0 log'
+               return $ SMore $ ClosureData 0 0  log'
 
+             else if "relay/"  `BC.isPrefixOf` uri' then proxy sock method vers uri'
+                
              else do
-
+                   headers <- getHeaders
+                   return () !> (method,uri')
                    -- stay serving pages until a websocket request is received
                    servePages (method, uri', headers)
                    conn <- getSData
@@ -1281,7 +1384,7 @@ 
                    let conn'= conn{connData= Just (Node2Web sconn)
                              , closChildren=chs}
-                   setState conn'   -- !> "WEBSOCKETS-----------------------------------------------"
+                   setState conn'    !> "WEBSOCKETS-----------------------------------------------"
                    onException $ \(e :: SomeException) -> do
                             cutExceptions
                             liftIO $ putStr "listen websocket:" >> print e
@@ -1293,7 +1396,7 @@ --                     return ()                                                   !> "WEBSOCKET"
                      r <-  parallel $ do
                              msg <- WS.receiveData sconn
-                             return () !> ("Server WebSocket msg read",msg)
+                             return ()   !> ("Server WebSocket msg read",msg)
                                          !> "<-------<---------<--------------"
 
                              case reads $ BS.unpack msg of
@@ -1316,7 +1419,43 @@       split s=
           let (h,t) = span (/= '/') s
           in h: split  t
+      
+      -- reverse proxy for urls that look like http://host:port/relay/otherhost/otherport
+      proxy sclient method vers uri' = do
+        -- get host port
+        let (host:port:_)=  split $ BC.unpack $ BC.drop 6 uri'
+        sserver <- liftIO $ connectTo' 4096 host $ PortNumber $ fromIntegral $ read port
+                       
+        rawHeaders <- getRawHeaders
+        let uri= BS.fromStrict $ let d x= BC.tail $ BC.dropWhile (/= '/') x in d . d $ d uri'
+        
+        let sent=   method <> BS.pack " /" 
+                           <> uri  
+                           <> BS.cons ' ' vers 
+                           <> BS.pack "\r\n" 
+                           <> rawHeaders <> BS.pack "\r\n\r\n"
+        liftIO $ SBSL.send  sserver sent
+          -- Connection{connData=Just (Node2Node _ sclient _)} <- getState <|> error "proxy: no connection"
+        cutExceptions
+        onException $ \(e:: SomeException ) -> liftIO $ do 
+                            putStr "Proxy: " >> print e
+                            sClose sserver
+                            sClose sclient
 
+        send sclient sserver <|> send sserver sclient
+        empty
+        where
+        send f t= async $ mapData f t
+        mapData from to = do
+            content <- recv from 4096 
+            -- return () !> (" proxy received ", content)
+            if not $ BC.null content 
+              then sendAll to content >> mapData from to
+              else finish
+            where
+            finish= sClose from >> sClose to
+           -- throw $ Finish "finish"
+           
 
       maybeSetHost headers= do
         setHost <- liftIO $ readIORef rsetHost
@@ -1356,8 +1495,7 @@ 
 listenResponses :: Loggable a => TransIO (StreamData a)
 listenResponses= do
-      (conn, parsecontext, node) <- getMailbox
-
+      (conn, parsecontext, node) <- getMailbox  -- :: TransIO (Connection,ParseContext BS.ByteString,Node)
       labelState $ "listen from: "++ show node
 --      return () !> ("LISTEN",case connData conn of Just (Relay _) -> "RELAY"; _ -> "OTHER")
       setData conn
@@ -1372,14 +1510,14 @@ 
       cutExceptions
       onException (\(e:: SomeException) -> do
-                             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)
+        liftIO $ putStr "ListenResponses: " >> print e
+        liftIO $ putStr "removing node: " >> print node
+        nodes <- getNodes
+        setNodes $ nodes \\ [node]
+      --  topState >>= showThreads
+        killChilds
+        let Connection{localClosures=localClosures}= conn
+        liftIO $ modifyMVar_ localClosures $ const $ return M.empty)
 
 
       mread conn
@@ -1389,34 +1527,117 @@ 
 type IdClosure= Int
 
+-- The remote closure ids for each node connection
 newtype Closure= Closure  IdClosure -- deriving Show
 
+
+
+
+
+type RemoteClosure=  (Node, IdClosure)
+
+newtype JobGroup= JobGroup  (M.Map String RemoteClosure) deriving Typeable
+
+-- | if there is a remote job  identified by th string identifier, it stop that job, and set the
+-- current remote operation (if any) as the current remote job for this identifier.
+-- The purpose is to have a single remote job.
+--  to identify the remote job, it should be used after the `wormhole` and before the remote call:
+--
+-- r <- wormhole node $ do
+--        stopRemoteJob "streamlog"
+--        atRemote myRemotejob
+--
+-- So:
+--
+-- runAtUnique ident node job= wormhole node $ do stopRemoteJob ident; aRemote job
+stopRemoteJob :: String -> Cloud ()
+stopRemoteJob ident =  do
+    local $  do
+      JobGroup map <- getRState <|> return (JobGroup M.empty)
+      let mj= M.lookup ident map
+      when (isJust mj) $  putMailbox $ fromJust mj
+    fixClosure
+    local $ do
+      JobGroup map <- getRState <|> return (JobGroup M.empty)
+      Closure closr <- getData `onNothing` error "resetRemote: Closure not set, use wormhole"
+      conn <- getData `onNothing` error "resetRemote: no connection set"
+      remote <- liftIO $ readIORef $ remoteNode conn
+      when (isJust remote) $  do
+        setRState $ JobGroup $ M.insert ident (fromJust remote,closr) map
+        putMailbox  (fromJust remote, closr)
+
+
+-- kill the remote job. Usually, before starting a new one.
+resetRemote :: Cloud ()
+resetRemote= local $ do 
+   Closure clos <- getState  `onNothing` return (Closure 0)
+   conn <- getData `onNothing` error "resetRemote: no connection set"
+   remote <- liftIO $ readIORef $ remoteNode conn
+   when (isJust remote)  $ putMailbox  (fromJust remote, clos)
+
+-- | delete closures in a remote node when is requested by `resetRemote` or `stopRemoteJob`.
+-- This is necessary because a remote closure can be reactive or may take a long time.
+--
+-- It should be located as an alternative computation to the program:
+--
+-- >  main= initNode $ inputNodes <|> manageClosures <|>  myCloudCode
+manageClosures =   do
+   (remote, clos) <- local getMailbox
+   localIO $ print ("MANAGECLOSURESSSSSSSSSSSSSS", clos)
+   when (clos /= 0) $ runAt remote $  local $ do
+      conn@Connection {localClosures=localClosures} <- getData `onNothing` error "Listen: myNode not set"
+      mcont <- liftIO $ modifyMVar localClosures $ \map -> return ( M.delete clos map,  M.lookup clos map)
+      case mcont of
+        Nothing -> error $ "closure not found: " ++ show clos
+        Just cont -> do 
+                        showThreads $  fromJust $ parent cont
+                        liftIO $ killBranch' cont   
+                        return ()
+  
+
+
 execLog :: StreamData NodeMSG -> TransIO ()
-execLog  mlog = Transient $
-       case  mlog   of
+execLog  mlog =  Transient $ do
+       
+       return () !> "EXECLOG"
+       case mlog of
              SError e -> do
-                 runTrans $ back e
-                 return Nothing
+               case fromException e of
+                 Just (ErrorCall str) -> do
+                  case read str of
+                    (e@(CloudException  _ closl   err)) -> do
+                      process  closl (error "closr: should not be used") (Left  e) True
+                 
 
              SDone   -> runTrans(back $ ErrorCall "SDone") >> return Nothing   -- TODO remove closure?
-             SMore r -> process r False
-             SLast r -> process r True
+             SMore (ClosureData closl closr  log) -> process closl closr  (Right log) False
+             SLast (ClosureData closl closr  log) -> process closl closr  (Right log) True
   -- !> ("EXECLOG",mlog)
    where
-
-   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
+   process :: IdClosure -> IdClosure  -> (Either CloudException CurrentPointer) -> Bool -> StateIO (Maybe ())
+   process  closl closr  mlog  deleteClosure= do
+      conn@Connection {localClosures=localClosures} <- getData `onNothing` error "Listen: myNode not set"
+      if closl== 0 then case mlog of
+        Left except -> do
+          setData $ Log True [] []
+          --setData $ Closure closr
+          return () !> "THROWWWW1"
+          runTrans $ throwt except
+          empty
+        Right log -> do
+           -- runTrans cutExceptions !> "CUTEXCEPTIONS"
+           setData $ Log True log  (reverse log) 0  
            setData $ Closure  closr
+           
+           
            return $ Just ()                  --  !> "executing top level closure"
        else do
 
-         mcont <- liftIO $ modifyMVar closures
+         mcont <- liftIO $ modifyMVar localClosures
                          $ \map -> return (if deleteClosure then
                                            M.delete closl map
                                          else map, M.lookup closl map)
-                                           -- !> ("closures=", M.size map)
+                                           -- !> ("localClosures=", M.size map)
          case mcont of
            Nothing -> do
 --
@@ -1425,25 +1646,35 @@ --                     setData $ Log True log  $ reverse log
 --                     setData $ Closure closr
 --                     cont <- get    !> ("CLOSL","000000000")
---                     liftIO $ modifyMVar closures
+--                     liftIO $ modifyMVar localClosures
 --                            $ \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 [])
+                     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)
-                             runContinuation cont ()) cont
-                        return Nothing
+           Just cont -> do  -- remove fulLog?
+              liftIO $ runStateT (case mlog of
+                Right log -> do
+                  Log _ _ fulLog hash <- getData `onNothing` return (Log True [] [] 0)
+                  -- return() !> ("fullog in execlog", reverse fulLog)
+                  let nlog= reverse log ++  fulLog
+                  
+                  setData $ Log True  log  nlog  hash
+                  setData $ Closure  closr
+                                              
+                  runContinuation cont ()
 
+                Left except -> do
+                  setData $ Log True  []  []
+                  --setData $ Closure  closr
+                  return () !> "THROWWWW2"
+                  runTrans $ throwt except) cont
+              return Nothing
+                            
 
 #ifdef ghcjs_HOST_OS
 listen node = onAll $ do
@@ -1467,7 +1698,6 @@ 
 
 --------------------------------------------
-data ParseContext a = IsString a => ParseContext (IO  a) a deriving Typeable
 
 
 #ifndef ghcjs_HOST_OS
@@ -1495,6 +1725,7 @@     if BC.length s < bufSize
       then  return $ BLC.Chunk s mempty
       else BLC.Chunk s `liftM` loop
+      
 readFrom _ = error "readFrom error"
 
 toStrict= B.concat . BS.toChunks
@@ -1550,16 +1781,17 @@            - put this logic as independent alternative programmer options
               serveFile dirs <|> serveApi apis <|> serveNode nodeCode
         -}
-        mcontent <- liftIO $ (Just <$> BL.readFile ( "./static/out.jsexe/"++ BC.unpack file))
+        mcontent <- liftIO $ (Just <$> BL.readFile ( "./static/out.jsexe/"++ BC.unpack file) )
                                 `catch` (\(e:: SomeException) -> return Nothing)
+                                
 --                                    return  "Not found file: index.html<br/> please compile with ghcjs<br/> ghcjs program.hs -o static/out")
-
         case mcontent of
           Just content -> liftIO $ sendRaw conn $
             "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"
+          Nothing ->liftIO $ sendRaw conn $ BS.pack $ 
+              "HTTP/1.0 404 Not Found\nContent-Length: 13\nConnection: close\n\nNot Found 404"
         empty
 
 
@@ -1585,45 +1817,24 @@ 
 data HTTPMethod= GET | POST deriving (Read,Show,Typeable)
 
-receiveHTTPHead = do
-
-  (method, uri, vers) <- (,,) <$> getMethod <*> getUri <*> getVers
-  headers <- manyTill paramPair  (string "\r\n\r\n")          -- !>  (method, uri, vers)
-  return (method, toStrict uri, headers)                      -- !>  (method, uri, headers)
-
-  where
-  string :: BS.ByteString -> TransIO BS.ByteString
-  string s=withData $ \str -> do
-      let len= BS.length s
-          ret@(s',str') = BS.splitAt len str
-      if s == s'
-        then return ret
-        else empty
-
-  paramPair=  (,) <$> (mk <$> getParam) <*> getParamValue
-  manyTill p end  = scan
-      where
-      scan  = do{ end; return [] }
-            <|>
-              do{ x <- p; xs <- scan; return (x:xs) }
-
-  getMethod= getString
-  getUri= getString
-  getVers= getString
-  getParam= do
-      dropSpaces
-      r <- tTakeWhile (\x -> x /= ':' && not (endline x))
-      if BS.null r || r=="\r"  then  empty  else  dropChar >> return (toStrict r)
-
-  getParamValue= toStrict <$> ( dropSpaces >> tTakeWhile  (\x -> not (endline x)))
-
-dropSpaces= parse $ \str ->((),BS.dropWhile isSpace str)
-
-dropChar= parse  $ \r -> ((), BS.tail r)
-
-endline c= c== '\n' || c =='\r'
+getFirstLine=  (,,) <$> getMethod <*> (toStrict <$> getUri) <*> getVers
+    where
+    getMethod= parseString
+    getUri= parseString
+    getVers= parseString
 
---tGetLine= tTakeWhile . not . endline
+getRawHeaders= dropSpaces >> parse (scan mempty)
+  --  rs <- manyTill line (string "\r\n\r\n") 
+  --  return $ BS.concat rs
+  --  where
+  --  line= parse cond
+   where
+   scan  res str
+       | "\r\n\r\n" `BS.isPrefixOf` str= (res, BS.drop 4 str)
+       | otherwise=  scan ( BS.snoc res $ BS.head str) $ BS.tail str 
+  --  line= do
+  --   dropSpaces
+  --   tTakeWhile (not . endline)
 
 type PostParams = [(BS.ByteString, String)]
 
@@ -1636,51 +1847,25 @@    value= unEscapeString <$> BS.unpack <$> tTakeWhile' ( /= '&')
 
 
-getString= do
-    dropSpaces
-    tTakeWhile (not . isSpace)
 
-tTakeWhile :: (Char -> Bool) -> TransIO BS.ByteString
-tTakeWhile cond= parse (BS.span cond)
 
-tTakeWhile' :: (Char -> Bool) -> TransIO BS.ByteString
-tTakeWhile' cond= parse ((\(h,t) -> (h, if BS.null t then t else BS.tail t)) . BS.span cond)
+getHeaders =  manyTill paramPair  (string "\r\n\r\n")          -- !>  (method, uri, vers)
 
-parse :: (BS.ByteString -> (b, BS.ByteString)) -> TransIO b
-parse split= withData $ \str ->
+  where  
 
-     if str== mempty   then empty
 
-     else  return $ split str
+  paramPair=  (,) <$> (mk <$> getParam) <*> getParamValue
+  
 
+  getParam= do
+      dropSpaces
+      r <- tTakeWhile (\x -> x /= ':' && not (endline x))
+      if BS.null r || r=="\r"  then  empty  else  dropChar >> return (toStrict r)
 
--- | bring the data of a parse context as a lazy byteString to a parser
--- and actualize the parse context with the result
-withData :: (BS.ByteString -> TransIO (a,BS.ByteString)) -> TransIO a
-withData parser= Transient $ do
-   ParseContext readMore s <- getData `onNothing` error "parser: no context"
-   let loop = unsafeInterleaveIO $ do
-           r <-  readMore
-           (r <>) `liftM` loop
-   str <- liftIO $ (s <> ) `liftM` loop
-   mr <- runTrans $ parser str
-   case mr of
-    Nothing -> return Nothing
-    Just (v,str') -> do
-      setData $ ParseContext readMore str'
-      return $ Just v
+  getParamValue= toStrict <$> ( dropSpaces >> tTakeWhile  (\x -> not (endline x)))
 
--- | bring the data of the parse context as a lazy byteString
-giveData =noTrans $ do
-   ParseContext readMore s <- getData `onNothing` error "parser: no context"
-                                  :: StateIO (ParseContext BS.ByteString)  -- change to strict BS
 
-   let loop = unsafeInterleaveIO $ do
-           r <-  readMore
-           (r <>) `liftM` loop
-   liftIO $ (s <> ) `liftM` loop
 
-
 #endif
 
 
@@ -1726,11 +1911,11 @@     show (Node h p _ servs )= show (h,p, servs)
 
 instance Read Node where
-    readsPrec _ s=
-          let r= readsPrec' 0 s
+    readsPrec n s=
+          let r= readsPrec n s
           in case r of
             [] -> []
-            [((h,p,ss),s')] ->  [(Node h p Nothing ( ss),s')]
+            [((h,p,ss),s')] ->  [(Node h p Nothing ss ,s')]
           
           
 
@@ -1745,19 +1930,14 @@ --myNode :: Int -> DBRef  MyNode
 --myNode= getDBRef $ key $ MyNode undefined
 
-
-
 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 ::  TransIO Node -- (MonadIO m, MonadState EventF m) => m Node
 getMyNode =  do
-    Connection{myNode= node}  <- getSData   <|> errorMyNode "getMyNode" :: TransIO Connection
+    Connection{myNode= node} <- getSData <|> errorMyNode "getMyNode"  :: TransIO Connection
     liftIO $ readIORef node
 
-
-
 -- | Return the list of nodes in the cluster.
 getNodes :: MonadIO m => m [Node]
 getNodes  = liftIO $ atomically $ readTVar  nodeList
@@ -1850,8 +2030,8 @@ 
 
 -- | 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.
+-- part of the cluster. Reconciliation end up in each node in the cluster
+-- having  the same list of nodes.
 connect' :: Node -> Cloud ()
 connect'  remotenode= loggedc $ do
     nodes <- local getNodes

@@ -180,14 +180,14 @@     where
     typea :: a -> Cloud a
     typea = undefined
-    restoreLog (Log _ _ logw)= onAll $ do
-       Log _ _ logw' <- getSData <|> return emptyLog
+    restoreLog (Log _ _ logw hash)= onAll $ do
+       Log _ _ logw' hash' <- getSData <|> return emptyLog
 
        let newlog= reverse logw' ++ logw
 --       return ()                 !> ("newlog", logw,logw')
-       setData $ Log False newlog newlog
+       setData $ Log False newlog newlog (hash + hash')
 
-    emptyLog= Log False [] []
+    emptyLog= Log False [] [] 0
 
 -- catchc :: Exception e => Cloud a -> (e -> Cloud a) -> Cloud a
 -- catchc a b= Cloud $ catcht (runCloud' a) (\e -> runCloud' $ b e)
@@ -224,7 +224,7 @@           teleport
           return r
 
-   emptyLog= Log False [] []
+   emptyLog= Log False [] [] 0
 
    initNodeServ  servs=do
       mynode <- local  getNode

@@ -11,22 +11,19 @@ -- |
 --
 -----------------------------------------------------------------------------
-
+{-# LANGUAGE ScopedTypeVariables #-}
 module Transient.Move.Utils (initNode,initNodeDef, initNodeServ, inputNodes, simpleWebApp, initWebApp
-, onServer, onBrowser, runTestNodes)
+, onServer, onBrowser, atServer, atBrowser, runTestNodes)
  where
 
 --import Transient.Base
 import Transient.Internals
 import Transient.Move.Internals
 import Control.Applicative
-import Control.Monad.IO.Class
+import Control.Monad.State
 import Data.IORef
 import System.Environment
 
-import Control.Concurrent.MVar
-import Data.Maybe
-
 -- | 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>"
@@ -38,7 +35,7 @@ --
 -- > ghc program.hs
 -- > ghcjs program.hs -o static/out
--- > ./program -p start/8080
+-- > ./program -p start/myhost/8080
 --
 -- `initNode`, when the application has been loaded and executed in the browser, will perform a `wormhole` to his server node.
 --  So the application run within this wormhole.
@@ -55,6 +52,7 @@ initNode :: Loggable a => Cloud a -> TransIO a
 initNode app= do
    node <- getNodeParams
+   --abduce
    initWebApp node  app
 
 
@@ -88,21 +86,21 @@ -- | 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 $ listNodes <|> addNew
+inputNodes= onServer $ do 
+  --local abduce
+  listNodes <|> addNew
   where
   addNew= do
-          
           local $ oneThread $ option "add"  "add a new node"
-
-          host <- local $ do
-                    r <- input (const True) "Hostname of the node (none): "
-                    if r ==  "" then stop else return r
+          host      <- local $ do
+                          r <- input (const True) "Hostname of the node (none): "
+                          if r ==  "" then stop else return r
 
-          port <-  local $ input (const True) "port? "
+          port      <- local $ input (const True) "port? "
 
-          services <- local $ input' (Just []) (const True) "services? [] "
+          services  <- local $ input' (Just []) (const True) "services? ([]) "
 
-          connectit <- local $ input (\x -> x=="y" || x== "n") "connect to the node to interchange node lists? "
+          connectit <- local $ input (\x -> x=="y" || x== "n") "connect to the node to interchange node lists? (n) "
           nnode <- localIO $ createNodeServ host port  services
           if connectit== "y" then connect'  nnode
                              else  local $ do
@@ -153,19 +151,34 @@         listen mynode <|> return()
         wormhole serverNode  app  
 
--- only execute if the the program is executing in the browser. The code inside can contain calls to the server.
+-- | only execute if the the program is executing in the browser. The code inside can contain calls to the server.
 -- Otherwise return empty (so it stop the computation and may execute alternative computations).
 onBrowser :: Cloud a -> Cloud a
 onBrowser x= do
      r <- local $  return isBrowserInstance
      if r then x else empty
 
--- only executes the computaion if it is in the server, but the computation can call the browser. Otherwise return empty
+-- | only executes the computaion if it is in the server, but the computation can call the browser. Otherwise return empty
 onServer :: Cloud a -> Cloud a
 onServer x= do
      r <- local $  return isBrowserInstance
      if not r then x else empty
 
+
+-- | If the computation is running in the server, translates i to the browser and return back. 
+-- If it is already in the browser, just execute it
+atBrowser :: Loggable a => Cloud a -> Cloud a
+atBrowser x= do
+        r <- local $  return isBrowserInstance
+        if r then x else atRemote x
+
+-- | If the computation is running in the browser, translates i to the server and return back. 
+-- If it is already in the server, just execute it
+atServer :: Loggable a => Cloud a -> Cloud a
+atServer x= do
+        r <- local $  return isBrowserInstance
+        if not r then x else atRemote x
+         
 -- | run N nodes (N ports to listen) in the same program. For testing purposes.
 -- It add them to the list of known nodes, so it is possible to perform `clustered` operations with them.
 runTestNodes ports= do

@@ -23,8 +23,7 @@ -- #define _UPK_(x) {-# UNPACK #-} !(x)
 
 
-#define shouldRun(x) (local $ getMyNode >>= \p -> assert ( p == (x)) (return ()))
-
+shouldRun x=  local $ getMyNode >>= \p -> assert ( p == (x)) (return ())
 
 service= [("service","test suite")
          ,("executable", "test-transient1")
@@ -50,15 +49,8 @@           
       --  local $ option "get" "get instances"
 
-          localIO $ return () !> "REQUEST INSTANCE "
         
           [node1, node2] <- requestInstance "PIN1" service 2
-        --   localIO $ putStrLn "------checking connect --------"
-        --   connect' node1
-        --   connect' node2
-        --   runAt node1 $ local $ do
-        --        nodes <- getNodes
-        --        assert (length nodes== 3) return ()
  
 
           local ( option "f" "fire")   <|> return ""       -- to repeat the test,  remove exit

@@ -1,16 +1,16 @@ name: transient-universe
-version: 0.4.6.1
+version: 0.5.0.0
 cabal-version: >=1.10
 build-type: Simple
 license: MIT
 license-file: LICENSE
 maintainer: agocorona@gmail.com
-homepage: http://www.fpcomplete.com/user/agocorona
-bug-reports: https://github.com/agocorona/transient-universe/issues
+homepage: https://github.com/transient-haskell/transient-universe
+bug-reports: https://github.com/transient-haskell/transient-universe/issues
 synopsis: Remote execution and map-reduce: distributed computing for Transient
 description:
-    See <http://github.com/agocorona/transient>.
-category: Control
+    See <http://github.com/transient-haskell/transient>.
+category: Control, Distributed Computing
 author: Alberto G. Corona
 extra-source-files:
     ChangeLog.md README.md
@@ -19,7 +19,7 @@ 
 source-repository head
     type: git
-    location: https://github.com/agocorona/transient-universe
+    location: https://github.com/transient-haskell/transient-universe
 
 library
 
@@ -62,7 +62,7 @@         stm -any,
         time -any,
         transformers -any,
-        transient >= 0.5.9.2
+        transient >= 0.6.0.0
     default-language: Haskell2010
     hs-source-dirs: src .
 
@@ -71,7 +71,7 @@     if !impl(ghcjs >=0.1)
         build-depends:
             transformers -any,
-            transient >=0.5.9.2,
+            transient >= 0.6.0.0,
             transient-universe,
             process,
             directory