/** -*-C-*-ish
    Webapp.k based on CGI.k from the Kaya standard library
    CGI.k Copyright (C) 2004, 2005 Edwin Brady
    Webapp.k Copyright (C) 2005 Chris Morris

    This file is distributed under the terms of the GNU Lesser General
    Public Licence. See COPYING for licence.
*/
"<summary>Web application development</summary>
<prose>The Webapp module allows the development of web applications with tight integration with the <moduleref>HTMLDocument</moduleref> module for high-quality HTML output (including auto-filling of forms), and secure state management.</prose>"
module Webapp;

import public WebCommon;
import Prelude;
import Dict;
import HTMLDocument;
import ElementTree;
import System;
import Strings;
import Crypto;
import Regex;
import IO;
import Compress;
import Binary;
import Mime;
import Time;
// have we missed any of the standard library here?

globals {
  Bool headersent = false;
  Bool debugmode = false;
}

"<summary>Bad handler function</summary>
<prose>The Handler function was not properly specified in <functionref>runHandler</functionref>.</prose>"
Exception IllegalHandler();
"<argument name='key'>The key of the bad header</argument>
<argument name='val'>The key of the bad value</argument>
<summary>Malformed HTTP header key</summary>
<prose>The HTTP header key is not valid. Only a limited set of characters are permitted.</prose>"
Exception BadHeadersKey(String key, String val);
"<summary>Malformed HTTP header value</summary>
<prose>The HTTP header value is not valid. New lines and control characters are not allowed.</prose>"
Exception BadHeadersVal(String key,String val);

"<summary>Returns true if headers have been sent</summary>
<prose>This function checks if the headers have been sent. It is only needed in the webapp template to correctly handle application errors.</prose>"
public Bool headersSent = headersent;
"<summary>Check debugging mode</summary>
<prose>Return whether the webprog is currently in debugging mode. You can use this check to display your own custom error messages.</prose>
<related><functionref>disableDebugging</functionref></related>
<related><functionref>enableDebugging</functionref></related>"
public Bool debugMode = debugmode;
"<summary>Enable debugging mode</summary>
<prose>Enable debugging mode for the webapp. Note that this can potentially 
expose security-relevant information about your application
and/or web server, so it's off by default and should remain that way for
any production application. However, when testing a program as you write it you may find it useful to enable as it will give (among other features) better backtraces for uncaught Exceptions.</prose>
<related><functionref>debugMode</functionref></related>
<related><functionref>enableDebugging</functionref></related>"
public Void enableDebugging() { debugmode = true; }

"<summary>Disable debugging mode</summary>
<prose>Disable debugging mode for the webapp. This is the default setting, so you should only need to call this if you have previously enabled debugging but only require it for one section of the webapp.</prose>"
public Void disableDebugging() { debugmode = false; }

"<argument name='defn'>The default function to run if none was specified.</argument>
<argument name='prefix'>An optional prefix to allow multiple <code>runHandler</code> calls to coexist.</argument>
<summary>Run the current state handler</summary>
<prose>This runs the function called by the previous page of the application,
or runs the provided default function if none was called. All functions called in this way must have the same return type. The default function takes no parameters, and all other functions take a single parameter representing the application state.</prose>
<prose>The optional prefix allows handlers to have different namespaces, which allows multiple handler functions to safely coexist at various parts of the web application. Note that it is not possible for a single form submission or link to call more than one handler (though they will call the default function).</prose>
<related><functionref>HTMLDocument::addLocalControlInput</functionref></related>"
public b runHandler(b() defn, String prefix="") {
  // try POST first
  for svkey in incomingKeys(DataPost) {
    if (quickMatch("^"+prefix+"kaya_submit_",svkey)) {
      action = Int(substr(svkey,15+length(prefix),length(svkey)-(15+length(prefix))));
      datavar = prefix+"kaya_control_Kay"+String(action);
      return doCalledFunction(incomingValue(datavar,DataPost),action,prefix);
    }
  }
  // then GET
  if (incomingExists(prefix+"kaya_control",DataGet)) {
    return doCalledFunction(incomingValue(prefix+"kaya_control",DataGet),228,prefix);
  }
  return defn();
  //  throw(IllegalHandler); // you should catch this and do a default function
}

"<argument name='defn'>The default function to call if the state key does not exist.</argument>
<argument name='retriever'>A function that returns the encoded state when given the key</argument>
<argument name='key'>The key to find the state</argument>
<summary>Retrieve saved state</summary>
<prose>In some circumstances you may need to store application state in an external source, so that a user may save their session and return to it later.
This function lets you retrieve a saved state from an external source based on a key.
The function represented by the saved state is then executed. The retrieval function should throw an Exception if it can't find the key, which will cause the default function <code>defn</code> to be executed instead. Otherwise, it should, given the key, return the state string that was stored using <functionref>storeFunction</functionref>.</prose>
<prose>One use of this is to generate links to be sent via email, where the links generated by Kaya containing the state data itself are too long to be practical.</prose>
<prose>You should consider when writing the retrieval function whether the action of retrieving the state should delete it from the persistent storage.</prose>
<related><functionref>runHandler</functionref></related>
<related><functionref>storeFunction</functionref></related>"
public b retrieveFunction(b() defn, String(String) retriever, String key) {
  try {
    state = retriever(key);
    return doCalledFunction(state,228);
  } catch(e) {
    return defn();
  }
}

"<argument name='storer'>A function that stores the state (which will be encoded as a String) and returns a key that can be used to retrieve it.</argument>
<argument name='fn'>The function to call when the state is retrieved.</argument>
<argument name='state'>The state to pass to <code>fn</code></argument>
<summary>Save application state persistently.</summary>
<prose>This lets you save application state and a handler function to an external source, and get a key to retrieve it later. The storage function should throw an exception if it is unable to store the state. Otherwise it should return a key that can be used with <functionref>retrieveFunction</functionref> to execute the state later. This lets you make URLs much shorter than is possibly by passing the state directly.</prose>
<prose>You may need to consider expiring old and unused states from your persistent storage if they have not been retrieved for some time.</prose>
<related><functionref>runHandler</functionref></related>
<related><functionref>retrieveFunction</functionref></related>"
public String storeFunction(String(String) storer, b(a) fn, a state) {
  enstate = encodeControlState(@fn,state);
  return storer(enstate);
}


private b doCalledFunction(String x, Int action, String prefix="") {
  dat = uncompressString(decode(x));
  Triple<b(a),a,String> fn = unmarshal(dat,action);
  if (prefix != fn.third) {
    // prefix doesn't match, so someone's trying something on.
    // types probably won't match either.
    throw(IllegalHandler);
  }
  return fn.fst(fn.snd);
}


"<argument name='page'>A HTMLDocument page</argument>
<summary>Displays a HTML page</summary>
<prose>Displays a HTML page. The displayPage functions are called
automatically by a webapp based on the return value of
<code>webmain</code> and should only be called directly for debugging
purposes and when constructing custom <code>displayPage</code>
functions.</prose>
<related><dataref>HTMLDocument::HTMLDocument</dataref></related>
<related><functionref index='1'>displayPage</functionref> (string data)</related>
<related><functionref index='2'>displayPage</functionref> (binary data)</related>
<related><functionref index='3'>displayPage</functionref> (void functions)</related>"
public Void displayPage(HTMLDocument page) {
  sendHeaders(page.httpheaders);
  putStr("\n"); // end headers
  write(page);
  if (debugmode) {
    putStrLn("<!-- Mem: "+gcHeapSize()+" "+gcTotalBytes()+" -->");
  }
}

// we have the generic String and Binary output methods here. Other modules
// should have their own displayPage() functions for appropriate output.
// HTMLDocument is above as an exception to this.
"<argument name='sdata'>The string to output as the content</argument>
<argument name='headers'>A list of key-value pairs of HTTP headers</argument>
<summary>Displays String content</summary>
<prose>Displays String content. The displayPage functions are called
automatically by a webapp based on the return value of
<code>webmain</code> and should only be called directly for debugging
purposes and when constructing custom <code>displayPage</code>
functions.</prose>
<related><functionref index='0'>displayPage</functionref> (HTML documents)</related>
<related><functionref index='2'>displayPage</functionref> (binary data)</related>
<related><functionref index='3'>displayPage</functionref> (void functions)</related>"
public Void displayPage(String sdata, [(String,String)] headers) {
  sendHeaders(headers);
  // last header
  Prelude::putStr("Content-length: "+length(sdata)+"\n\n");

  Prelude::putStr(sdata);
}

"<argument name='bdata'>The binary block containing the content</argument>
<argument name='headers'>A list of key-value pairs of HTTP headers</argument>
<summary>Displays binary data</summary>
<prose>Displays binary data (for example an Image). The displayPage functions are called
automatically by a webapp based on the return value of
<code>webmain</code> and should only be called directly for debugging
purposes and when constructing custom <code>displayPage</code>
functions.</prose>
<prose>The Image module contains its own <code>displayPage</code> function for image data, so you do not need to use this function.</prose>
<related><dataref>Binary::Binary</dataref></related>
<related><moduleref>Image</moduleref></related>
<related><functionref index='0'>displayPage</functionref> (HTML documents)</related>
<related><functionref index='1'>displayPage</functionref> (string data)</related>
<related><functionref index='3'>displayPage</functionref> (void functions)</related>"
public Void displayPage(Binary bdata, [(String,String)] headers) {
  sendHeaders(headers);
  // last header
  Prelude::putStr("Content-length: "+blockSize(bdata)+"\n\n");

  for i in [0..(blockSize(bdata)-1)] {
    ch = peek(bdata,i);
    putChar(stdout,Char(ch));
  }
}

"<argument name='fn'>A Void function taking no parameters that prints the content to standard output.</argument>
<argument name='headers'>A list of key-value pairs of HTTP headers</argument>
<summary>Displays a function result</summary>
<prose>Displays a function result. The displayPage functions are called
automatically by a webapp based on the return value of
<code>webmain</code> and should only be called directly for debugging
purposes and when constructing custom <code>displayPage</code>
functions.</prose>
<prose>This function may be useful for output of very large amounts of content where reading the entire content into a string or binary block before printing it is not practical.</prose>
<related><functionref index='0'>displayPage</functionref> (HTML documents)</related>
<related><functionref index='1'>displayPage</functionref> (string data)</related>
<related><functionref index='2'>displayPage</functionref> (binary data)</related>"
public Void displayPage(Void() fn, [(String,String)] headers) {
  sendHeaders(headers);
  putStr("\n"); // end headers
  fn();
}


// check that headers are in reasonable format
// let's not let people stick a response body in the headers, for example
private Void sendHeaders([(String,String)] headers) {
  if (headersent) { return; }
  hkey = compile("[()<>@,;:\\\"/[\\]?={}[:cntrl:]\r\n]");
  hval = compile("[[:cntrl:]\r\n]");
  for header in headers {
    if (quickMatch(hkey,header.fst)) {
      throw(BadHeadersKey(header.fst,header.snd));
    }
    if (quickMatch(hval,header.snd)) {
      throw(BadHeadersVal(header.fst,header.snd));
    }
    Prelude::putStr(header.fst+": "+header.snd+"\n");
  }
  headersent = true;
}

/* Begin auto-fill function set */

"<argument name='form'>The form element (or a subset of that if you only wish to automatically fill a part of the form.</argument>
<argument name='mainvars'>The data source to use (e.g. <code>DataPost</code>)</argument>
<argument name='extravars'>An optional dictionary mapping keys to lists of values, to allow a form to be automatically filled from a database. You may or may not need to use <code>DataNone</code> as your main data source in this case.</argument>
<summary>Automatically fill a HTML form</summary>
<prose>Automatically fill a HTML form based on data from a particular data source. This makes it easy to construct web forms with error handling - see <link url='http://kayalang.org/tutorial/web/webapp'>the webapp tutorial</link> for more information.</prose>
<example>ElementTree OnHello(Int dummy) {
    div = anonymousBlock; // we create this temporarily.
    fname = incomingValue(\"fname\",DataPost);
    lname = incomingValue(\"lname\",DataPost);
    if (fname != \"\" && lname != \"\") {
        p = addParagraph(div,\"Hello \"+fname+\" \"+lname);
        return p;
    } else {
        form = HelloForm();
// if they entered one of first and last name, make sure it's still in the form
        autoFill(form,DataPost);
        return form;
    } 
}

ElementTree helloForm() {
    parent = anonymousBlock;
    form = addLocalForm(parent);
    f1 = addFieldset(form,\"Who are you?\");
    input = addLabelledInput(f1,\"Your First Name\",InputText,\"fname\",\"\",0);
    input = addLabelledInput(f1,\"Your Last Name\",InputText,\"lname\",\"\",0);
    submit = addLocalControlInput(f1,\"Say hello\",OnHello,1);
    return form;
}</example>
<related><dataref>WebCommon::DataSource</dataref></related>"
public Void autoFill (ElementTree form, DataSource mainvars, Dict<String,[String]> extravars=Dict::new()) {

  if (elem(form.name,["input","select","textarea"])) {
    // fill each (text/check/radio/select/textarea) input found based on vars
    autoFillElement(form,mainvars,extravars);
  } else {
    // iterate (recursively?) through form for inputs
    for s in getChildren(form) {
      autoFill(s,mainvars,extravars);
    }
  }
}

Void autoFillElement(ElementTree input, DataSource mainvars, Dict<String,[String]> extravars) {
  if (input.name == "input") {
    itype = HTMLDocument::getAttribute(input,"type");
    case itype of {
      nothing -> autoFillTextInput(input, mainvars, extravars);
      | just(x) -> if (x == "text") {
	autoFillTextInput(input, mainvars, extravars);
      } else if (x == "checkbox" || x == "radio") {
	autoFillChoiceInput(input, mainvars, extravars);
      }
    }
  } else if (input.name == "select") {
    autoFillSelectInput(input, mainvars, extravars);
  } else if (input.name == "textarea") {
    autoFillArea(input,mainvars,extravars);
  }
}

[String] getVariables(String vname, DataSource mainvars, Dict<String,[String]> extravars) {
  fromextra = lookup(extravars,vname);
  try {
    frommain = incomingData(vname,mainvars);
    case fromextra of {
      just(x) -> Array::concat(frommain,x);
      | nothing -> ;
    }
    return frommain;
  } catch(e) {
    case fromextra of {
      just(x) -> return x;
      | nothing -> throw(NotIncoming(vname));
    }
  }
}

Void autoFillTextInput(ElementTree input, DataSource mainvars, Dict<String,[String]> extravars) {
  name = HTMLDocument::getAttribute(input,"name");
  case name of {
    nothing -> return; // strange...
    | just(x) -> try {
      vars = getVariables(x,mainvars,extravars);
      HTMLDocument::setAttribute(input,"value",vars[0]); // no sensible way to deal with text inputs with non-unique names
    } catch(e) {
      //      HTMLDocument::setAttribute(input,"value","");
    }
  }
}

Void autoFillChoiceInput(ElementTree input, DataSource mainvars, Dict<String,[String]> extravars) {
selname = "checked";
  name = HTMLDocument::getAttribute(input,"name");
  case name of {
    nothing -> return; // strange...
    | just(x) -> try {
      vars = getVariables(x,mainvars,extravars);
      val = HTMLDocument::getAttribute(input,"value");
      case val of {
	nothing -> return; //strange...
	| just(x) -> if (elem(x,vars)) {
		HTMLDocument::setAttribute(input,selname,selname); // no sensible way to deal with text inputs with non-unique names
	} else {
	  unsetAttribute(input,selname);
	}
      }
    } catch(e) {
      unsetAttribute(input,selname);
    }
  }
}

Void autoFillArea(ElementTree input, DataSource mainvars, Dict<String,[String]> extravars) {
  name = HTMLDocument::getAttribute(input,"name");
  input.elements = createArray(2); // clear the textarea.
  case name of {
    nothing -> return; // strange...
    | just(x) -> try {
      vars = getVariables(x,mainvars,extravars);
      addString(input,Strings::join(vars,'\n'));
    } catch(e) {
      return;
    }
  }
}

Void autoFillSelectInput(ElementTree input, DataSource mainvars, Dict<String,[String]> extravars) {
  name = HTMLDocument::getAttribute(input,"name");
  case name of {
    nothing -> return; // strange...
    | just(x) -> try {
      vars = getVariables(x,mainvars,extravars);
      setSelectsOptions(input,vars);
    } catch(e) {
      //      unsetSelectsOptions(input);
    }
  }
}

Void unsetSelectsOptions(ElementTree input) {
  for s in getChildren(input) {
    if (s.name == "option") {
      unsetAttribute(s,"selected");
    } else { // optgroup
      for opt in getChildren(s) {
	unsetAttribute(opt,"selected");
      }
    }
  }
}

Void setSelectsOptions(ElementTree input, [String] vals) {
  for s in getChildren(input) {
    if (s.name == "option" ) {
      getval = HTMLDocument::getAttribute(s,"value");
      case getval of {
	just(val) -> if (elem(val,vals)) { 
	  HTMLDocument::setAttribute(s,"selected","selected");
	} else {
	  unsetAttribute(s,"selected");
	}
	| nothing -> ; // shouldn't happen in a KayHTML page
      } 
    } else { // optgroup
      setSelectsOptions(s,vals);
    }
  }
}

/* End auto-fill functions */