Friday, July 26, 2013

Maxwell Smart push counter

To illustrate the push functionality the previous example is confusing since it seems to be a request response interaction with a web browser, but it is not, since the text box send to the server a string, it is stored in a variable, the push widget detect the update of the variable and send it back in a separate message, different that the reception message. In fact various unrelated push widgets can be updated using this asynchronous mechanism   simultaneously in the same page.

So I created another push example theoretically more simple.

http://mflowdemo.herokuapp.com/noscript/pushdec

It is a countdown after which the page will navigate back to the main menu. In this case the widget generates its own output by decreasing the variable. It also illustrates the use of Hamlet.

Note that

 - push has a new parameter that is the delay for a new ajax request when the previous connection has been lost.

- The last push after 0, send a script that forces a navigation to the menu. And then kill itself.

pushDecrease= do
 tv ←  liftIO $ newTVarIO 10
 page $ 
  [shamlet|
   <div>
       <h2> Maxwell Smart push counter
       <p> This example shows a reverse counter
       <p> To avoid unnecessary load, the push process will be killed when reaching 0
       <p> The last push message will be an script that will redirect to the menu"
       <h3> This message will be autodestroyed within ‥

  |] ++>  counter tv <++  b << "seconds" 
 where

 counter tv = push Html 0 $ do
      setTimeouts 100 0     -- kill  the thread if the user navigate away
      n ←  atomic $ readTVar tv
      if (n≡ -1) 
        then  do
          script << "window.location='/'" ++> noWidget
          liftIO $ myThreadId ↠ killThread 
        else do
          atomic $ writeTVar tv $ n - 1
          liftIO $ threadDelay 1000000
          h1 << (show n) ++> noWidget

atomic= liftIO . atomically

.....

Ops.. No.

killThread is never called since noWidget return an invalid formlet value, so the next statements are not executed in the View monad (See: The promising land of monadic formlets). 

That kill is in order to drop the process immediately, but otherwise, the timeout of setTimeouts would do the same job. Since the delay between push sends is one second, by shortening the timeout from 100 to two seconds will do the same job.  So the killthread line can be eliminated.


Wednesday, July 24, 2013

New push mode, to present data in real time. in MFlow

Another milestone completed in MFlow.  The new asynchronous widgets can display server information at the moment that they appear. And thanks to Software Transactional Memory this may be immediately.

The new primitive, push, like autoRefresh,  is a modifier of a widget behavior. In this case push  will execute the widget and present the output again and again using ajax internally. This is an example:

http://mflowdemo.herokuapp.com/noscript/push


 
 
The image is not very exciting. I will try to add another better. In this example the push widget is above the text box.
 
The code is as follows:
 
pushSample=  do
  tv ←  liftIO $ newTVarIO $ Just "The content will be appended here"
  page $   h2 << "Push example"
       ++> p << "The content of the text box will be appended to the push widget below."
       ++> p << "A push widget can have links and form fields."
       ++> p << "Since they are asynchronous the communucation must be trough..."
       ++> p << "The input box is configured with autoRefresh"
       ++> hr

       ++> pageFlow "push" (push Append (disp tv) <** input tv)
       **> br
       ++> br
       ++> wlink () << b << "exit"

  where
  -- the widget being pushed:
  disp tv= do
      setTimeouts 100 0
      line ←  tget tv
      liftIO $ when (line ≡ "kill") $ myThreadId ↠ killThread
      p <<  line ++> noWidget

  -- The input box
  input tv= autoRefresh $ do
      line ←  getString Nothing <** submitButton "Enter"
      tput tv line


  tput tv x = atomic $ writeTVar  tv ( Just x)

  tget tv= atomic $ do
      mr ←  readTVar tv
      case mr of
         Nothing → retry
         Just r → do
          writeTVar tv Nothing
          return r

atomic= liftIO . atomically

There are still some minor issues with this widget, but I expect to fix them soon. As you can see, the push widget retry when Nothing is available in the TVar. When the input widget tput's something in the variable, it is read, emptied and returned to be displayed. The other widgets of the  page must be configured with autorefresh, unless we want to navigate away from the page. This is why the text input box and the button are under autoRefresh, but the exit link is not.

Tuesday, July 16, 2013

Automatic error trace generation in MFlow

To have  the trace of an unexpected error is very important in Web development. Specially when the error has been produced in exploitation. There is no way to make tests in a exploitation environment, so the error message is the only information available to fix it as soon as possible.

Now MFlow permits the creation of execution traces. Not just call traces, but execution traces, whenever an error happens. It uses the package monadloc from Pepe Iborra, used to produce stack traces in his package control-monad-exception

Using MonadLoc, MFlow can produce entire traces instead of call stacks because his backtracking mechanism permits to  run back the execution up to the beginning in case of an exception following the exact execution steps in reverse order. In this back-execution is when the trace is generated. When running normally, the tracing machinery does not affect the performance.

This is an example of what it is necessary in order to have execution traces in case of error.  It is necessary to install the monadloc-pp and monadloc packages that install the monadloc preprocessor and the monadloc class respectively. There are two according changes in the user programs, the preprocessor directive and to include  the Control.Monad.Loc module (in big letters):



This program has an intended error at line 33

  1. {-# OPTIONS -F -pgmF MonadLoc #-}
  2. module TestREST where
  3. import MFlow.Wai.Blaze.Html.All
  4. import Data.Monoid
  5. import Data.String
  6. import Control.Monad.Loc
  7.  
  8.  
  9.  
  10.  
  11. main= runNavigation "" $ transientNav testREST
  12.  
  13.  
  14. testREST= do
  15.   setTimeouts 120 0
  16.   liftIO $ print "start/restart"
  17.  
  18.   setHeader header1
  19.  
  20.   option ←  page $   wlink "a" << p << "letters " <++ p << "or"
  21.                  <|> wlink "1" << p << "numbers"
  22.  
  23.   case option of
  24.     "1"do
  25.           page $ wlink "2" << cont "1"
  26.           page $ wlink "3" << cont "2"
  27.           page $ wlink "4" << cont "3"
  28.           page $ wlink ()  <<  "menu"
  29.  
  30.     "a"do
  31.           page $ wlink "b" << cont "a"
  32.           page $ wlink "c" << cont "b"
  33.           page $ undefined -- wlink "d" << cont "c"
  34.           page $ wlink ()  <<  "menu"
  35.  
  36.  
  37. cont x= p << "page for"
  38.         <> b << x
  39.         <> p << "goto next page"


If we navigate to execute this line with the web browser, the error produced in the console, in the file "errlog" (and in the Web browser if you are logged as administrator) is:

---------------------ERROR-------------------------
TIME=Tue Jul 16 11:52:16 Hora de verano romance 2013

TRACE (error in the last line):

testREST, TestREST(Demos\TestREST.hs): (14, 11)
testREST, TestREST(Demos\TestREST.hs): (20, 3)
testREST, TestREST(Demos\TestREST.hs): (23, 3)
testREST, TestREST(Demos\TestREST.hs): (30, 12)
testREST, TestREST(Demos\TestREST.hs): (31, 11)
testREST, TestREST(Demos\TestREST.hs): (32, 11)
testREST, TestREST(Demos\TestREST.hs): (33, 11)
exception: Prelude.undefined

USER= admin

VERB= navigation

REQUEST:
[("cookieuser","admin"),("flow","1373963274"),("Host","localhost"),("Connection","keep-alive"),("Cache-Control","max-age=0"),("Accept","text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"),("User-Agent","Mozilla/5.0 (Windows NT 6.2; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/28.0.1500.72 Safari/537.36"),("Accept-Encoding","gzip,deflate,sdch"),("Accept-Language","es-ES,es;q=0.8,en-US;q=0.6"),("Cookie","flow=1373963274; cookieuser=admin")]
 
 
Fine, Isn´t? Note that it is not a call stack, but a true execution trace.
 
If we comment out both lines the error produced is:
 
---------------------ERROR-------------------------
TIME=Tue Jul 16 12:57:04 Hora de verano romance 2013


Prelude.undefined

USER= admin

VERB= navigation

REQUEST:
...
 


How I did that?

Essentially the monadLoc instance permits to add information to a monad about the line number that it is executing now.  I attach in this instance an exception handler to each bind operation so that when a noncaugh exception reaches the handler, it add this line number to  mfTrace, a list of  strings within the internal state monad. Then it trigger a failure that initiates the backtracking (see fail back monad) each step back detect the exception condition because mfTrace is not empty. then each of these steps add its own line to the mfTrace until the execution goes back to the init, were instead of restarting the execution forward, generate a error exception with all the content of mfTrace.

This is the instance:
instance  MonadLoc (FlowM v IO) where
    withLoc loc f = FlowM . BackT $ do
       withLoc loc $ do
            s ←  get
            (r,s') ←  lift $ do
                       (r,s') ←  runWithState f s  `CE.catch` (handler1  loc s)

                       case mfTrace s' of
                            Nothing     →  return (r,s')
                            Just  trace →  return(r, s'{mfTrace= Just( loc:trace)})
            put s'
            return r
       where

       handler1 loc s (e ∷  SomeException)=
        return (GoBack, s{mfTrace= Just ["exception: " ⊕show e]}) 



This is for the MFlow monad. For the View monad, used for in-page flows, the validation fails and mfTrace is filled with the error line, which trigger the backtracking in the MFlow monad.

The code of that last version with traces is not yet in Hackage. In github is at:

 
The fail-back monad is evolving to a supervisor monad that can execute tests, produce error traces , manage exceptional conditions, undo transactions and so on. I have to abstract out this monad from MFlow and make it available as a separate package.

In the next post I promise to talk about it.

I need people interested in MFlow to collaborate !!!!

Thursday, July 11, 2013

The Web Navigation Monad

The MFlow app server can express routes within normal Haskell monadic code. The FlowM monad backtrack and goes forward to track the URL of any page within the monadic flow.

To make a web application program more close to a plain console application, I created runNavigation, that get the port from the first execution parameter. If not, it read it from the PORT environment variable. If it does not exist, it uses the por 80.

runNavigation executes a persistent navigation (whose state is logged and later recovered when the process has a timeout).  If the flow is not persistent, it must be prefixed with transientNav.

The result is a more close visualization of what the FlowM monad is: a navigation monad.

This example has two routes (letters and numbers). Each one has a simple sucession of pages. The user can navigate forward and backward, introduce any url and the program will track the proper page to respond.

I installed it on Heroku:

http://mflowdemo.herokuapp.com/noscript/restnav

This page for example, points to the second page of the numbers:

http://mflowdemo.herokuapp.com/noscript/restnav/1/2

Notice the restful URLs generated, that can be entered in the address box at any time.

When the flow finish, it goes to the beginning again.

From numbers it is possible to have a link to any letter by means of a HTML link, instead of a wlink. (wlinks return results to the flow where they are in)


main= runNavigation "" $ transientNav $ do

  liftIO $ print "start/restart"

  setHeader $ html . body

  option <- ask  $   wlink "a"  << p << "letters"
                 <|> wlink "1" << p << "numbers"

  case option of
    "1" -> do
          page $ wlink "2" << pagefor "1"
          page $ wlink "3" << pagefor "2"
          page $ wlink "4" << pagefor "3"
          page $ wlink ()  <<  "menu"
    "a" -> do
          page $ wlink "b" << pagefor "a"
          page $ wlink "c" << pagefor "b"
          page $ wlink "d" << pagefor "c"
          page $ wlink ()  <<  "menu"

pagefor x= p << "page for"
        <> b << x
        <> p << "goto next page"



page is a synonym of ask

It is a navigation of 9 pages within the main procedure. The application is stateless, since the GET URLs have ever the same response. There is no state. It is, simply, a navigation.