Yesod Web Framework

Yesod Web Framework

(Tutorial en Español)

LA APLICACION, la tienes disponible en producción aquí Notify me!.

EL CODIGO, lo tienes disponible en Github: Yesod Spanish Tutorial.

SI QUIERES COMENTAR, puedes usar este gist.

(Ésto está aún en construcción)

Introducción

¿Qué es Yesod?

Probablemente ya lo sepas. Yesod es un framework para desarrollar aplicaciones web en el lenguaje de programación Haskell de forma rápida, cómoda y segura, que basa buena parte de su robustez en el sistema de tipos de Haskell.

Le debemos a "Michael Snoyman" el poder disfrutar de Yesod.

¿Porqué este tutorial?

A fecha de hoy (6 de noviembre de 2012), no hay ningún tutorial de Yesod en español y los disponibles en inglés no se centran en un aspecto productivo, en el sentido de mostrar el ciclo completo de cada una de las herramientas que suministra Yesod. En lugar de eso, muestran la forma "canónica" de hacer las cosas, las anotan en la mayoría de los casos y/o las indican de una forma que luego no se corresponde con la que haríamos partiendo de un "scaffolding".

Desde el punto de vista de comprender internamente el funcionamiento de Yesod, es mejor el enfoque de los tutoriales existentes, pero a su vez requiere un conocimiento más profundo de Haskell y de tiempo para estudiar y asimilar la estructura interna de Yesod.

Por eso, este tutorial pretende describir Yesod centrándose en como representar los problemas habituales al desarrollar una aplicación web, en fijar procedimientos que permitan un rápido desarrollo, sin necesidad de conocer ni estudiar los elementos intrínsecos a Yesod.

Otro aspecto que he echado en falta de los tutoriales en inglés es que no muestran una estrategia o estructura general en el desarrollo de una web con Yesod. De echo, la mayoría de los ejemplos son código "from scratch", por lo que se hace difícil pensar desde el principio en como estructurar una web más o menos compleja.

En resumen, este tutorial pretende presentar primero "cómo las cosas funcionan" sin preguntar "porqué funcionan".

Que puedes esperar de este tutorial

Este tutorial se basa completamente en el "scaffolding" suministrado por Yesod, por tanto, cualquier cambio en el futuro afectará notablemente a la validez de este tutorial.

Además, soy un novato tanto en Haskell como en Yesod y no soy capaz de comprender ni he memorizado todos los tipos, mónadas y funciones que se definen, por lo que estoy convencido que muchas de las soluciones que aplico tienen otra forma mucho más elegante y correcta.

Por otra parte, sabrás que Haskell es un lenguaje difícil, al contrario que otros muchos lenguajes que pueden dominarse con bastante soltura en poco tiempo y sin dificultad, en Haskell se requiere de atención, tiempo y estudio para tan siquiera poder utilizar las librerías y frameworks que hay a nuestro alcance.

Es por esto que te insto a cuestionar la forma en la que yo llego a resolver cada problema, pues quizás no sea la mejor forma de hacerlo, y si ves algún fallo o mejora ¡ávisame!.

El entorno de trabajo

Instalación

La instalación de Yesod es fuertemente dependiente de la plataforma sobre la que quieras ejecutarlo. Es por eso que en lugar de presentar aquí una guía de instalación que seguramente no te funcionaría por uno u otro motivo, te presento algunas recomendaciones generales que quizás te sean de utilidad:

Yesod

Este tutorial está desarrollado utilizando:

$ yesod version
yesod-core version:1.1.3.1
yesod version:1.1.2

Hackage version: Yesod 1.1.2.

Haskell

Este tutorial está desarrollado utilizando:

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.4.1

Cabal

Este tutorial está desarrollado utilizando:

$ cabal --version
cabal-install version 1.16.0.1
using version 1.16.0.2 of the Cabal library

Otros

Aunque no debería importar la plataforma sobre la que estés ejecutando Yesod, yo lo hago sobre ArchLinux y usando nano como editor de código.

Descripción general de Yesod

Entorno de trabajo

Yesod es un conjunto de paquetes y comandos que normalmente instalamos con "cabal". Puesto que nosotros consideraremos en todo momento el uso del "scaffolding", cada proyecto que realicemos estará contenido en un directorio. La forma habitual en la que trabajaremos sobre nuestro proyecto será:

Estructura de los proyectos

Los diferentes elementos con los que tendremos que trabajar en Yesod son:

Estructura de una web Yesod

(Susceptible de reinterpretación)

Quizás imprecisa e incompleta, pero una forma de comprender como se estructura una web Yesod, podría ser:

Scaffolding, creando una web Yesod

Para todo el tutorial, vamos a hacer una sencilla web llamada "Notify Me" cuya descripción general sería "una aplicación web para que los usuarios puedan configurar alertas que les serán notificadas por email".

Directorio de proyecto

Es habitual considerar la ruta "~/" como el directorio "home" del usuario, aunque seguramente tu guardes tus proyectos en otro sitio, vamos a suponer que es ahí donde lo tendremos.

No hace falta que crees el directorio, desde una línea de comandos, si te sitúas en tu directorio "home" ("~/") para crear un nuevo proyecto ejecutaremos "yesod init" y responderemos a tres preguntas obvias, en rojo pongo la pregunta y en verde la respuesta que yo he dado:

~$ yesod init
Welcome to the Yesod scaffolder.
I'm going to be creating a skeleton Yesod project for you.

What is your name? We're going to put this in the cabal and LICENSE files.

Your name: josejuan
Welcome josejuan.
What do you want to call your project? We'll use this for the cabal name.

Project name: NotifyMe
Yesod uses Persistent for its (you guessed it) persistence layer.
This tool will build in either SQLite or PostgreSQL or MongoDB support for you.
We recommend starting with SQLite: it has no dependencies.

    s     = sqlite
    p     = postgresql
    mongo = mongodb
    mysql = MySQL

So, what'll it be? s
That's it! I'm creating your files now...
Generating deploy/Procfile
Generating config/sqlite.yml
Generating config/settings.yml
Generating config/keter.yaml
Generating app/main.hs
Generating devel.hs
Generating NotifyMe.cabal
Generating .ghci
Generating LICENSE
Generating Foundation.hs
Generating Import.hs
Generating Application.hs
Generating Handler/Home.hs
Generating Model.hs
Generating Settings.hs
Generating Settings/StaticFiles.hs
Generating Settings/Development.hs
Generating static/css/bootstrap.css
Generating templates/default-layout.hamlet
Generating templates/default-layout-wrapper.hamlet
Generating templates/normalize.lucius
Generating templates/homepage.hamlet
Generating config/routes
Generating templates/homepage.lucius
Generating templates/homepage.julius
Generating config/models
Generating messages/en.msg
Generating tests/main.hs
Generating tests/HomeTest.hs
Generating tests/TestImport.hs

---------------------------------------

                     ___
                            {-)   |\
                       [m,].-"-.   /
      [][__][__]         \(/\__/\)/
      [__][__][__][__]  |  |
      [][__][__][__][__][] /   |
      [__][__][__][__][__]| /| |
      [][__][__][__][__][]| || |
  ejm [__][__][__][__][__]__,__,  \__/


---------------------------------------

The foundation for your web application has been built.


There are a lot of resources to help you use Yesod.
Start with the book: http://www.yesodweb.com/book
Take part in the community: http://yesodweb.com/page/community


Start your project:

   cd NotifyMe && cabal install && yesod devel

or if you use cabal-dev:

   cd NotifyMe && cabal-dev install && yesod --dev devel

Como ves ha creado el directorio "~/NotifyMe/" y llenado con el "scaffolding" de Yesod. En la sección "Jerarquía del Scaffolding" tienes una descripción de los elementos que lo componen, a lo largo del tutorial iremos viendo para que sirven.

Instalando el proyecto

Como el producto del proyecto es un paquete de "cabal", debemos cargarlo en nuestros repositorios. No sólo lo haremos ahora, según modifiquemos nuestro proyecto será necesario reinstalar en cabal nuestro proyecto.

Para compilar e instalar por primera vez nuestro proyecto en los repositorios locales, podemos hacer:

~$ cd NotifyMe
NotifyMe$ cabal install
Resolving dependencies...
Configuring NotifyMe-0.0.0...
Building NotifyMe-0.0.0...
Preprocessing library NotifyMe-0.0.0...
[1 of 8] Compiling Model            ( Model.hs, dist/build/Model.o )
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package HUnit-1.2.4.2 ... linking ... done.
(... cargando paquetes dependientes ...)
Loading package language-javascript-0.5.6 ... linking ... done.
Loading package hjsmin-0.1.3 ... linking ... done.
[2 of 8] Compiling Settings.Development ( Settings/Development.hs, dist/build/Settings/Development.o )
[3 of 8] Compiling Settings         ( Settings.hs, dist/build/Settings.o )
[4 of 8] Compiling Settings.StaticFiles ( Settings/StaticFiles.hs, dist/build/Settings/StaticFiles.o )
[5 of 8] Compiling Foundation       ( Foundation.hs, dist/build/Foundation.o )
[6 of 8] Compiling Import           ( Import.hs, dist/build/Import.o )
[7 of 8] Compiling Handler.Home     ( Handler/Home.hs, dist/build/Handler/Home.o )
[8 of 8] Compiling Application      ( Application.hs, dist/build/Application.o )
In-place registering NotifyMe-0.0.0...
Preprocessing executable 'NotifyMe' for NotifyMe-0.0.0...
[1 of 1] Compiling Main             ( app/main.hs, dist/build/NotifyMe/NotifyMe-tmp/Main.o )
Linking dist/build/NotifyMe/NotifyMe ...
Installing library in /home/josejuan/.cabal/lib/NotifyMe-0.0.0/ghc-7.4.1
Installing executable(s) in /home/josejuan/.cabal/bin
Registering NotifyMe-0.0.0...
Installed NotifyMe-0.0.0

He omitido deliveradamente parte de la salida producida, ésta es muy similar (de hecho la misma) que cuando instalas un paquete con "cabal", revisará dependencias y las instalará si es necesario, etc...

Ejecutando el proyecto por primera vez

Ahora podemos usar el servidor de desarrollo para ejecutar nuestro proyecto creado a partir del scaffolding, pero antes yo te recomendaría establecer una configuración mínima.

Por defecto el servidor de desarrollo servirá la aplicación en la dirección "http://localhost:3000", pero puede ser conveniente poner alguna otra. Por ejemplo en mi caso, utilizo un equipo diferente al local (luego la dirección que yo debo poner no es localhost, es la de mi servidor).

Para ello, editaremos el archivo "~/NotifyMe/config/settings.yml":

Default: &defaults
  host: "*4" # any IPv4 host
  port: 8181
  approot: "http://shared.computer-mind.com:8181"
  copyright: Insert copyright statement here
  #analytics: UA-YOURCODE

Development:
  <<: *defaults

Testing:
  <<: *defaults

Staging:
  <<: *defaults

Production:
  #approot: "http://www.example.com"
  <<: *defaults

Ahora ya podemos lanzar el servidor, yo te recomiendo que dejes una consola ejecutando en "foreground" el servidor, así puedes ver las peticiones que se hacen, las recompilaciones, los errores, etc... Para lanzarlo:

NotifyMe$ yesod devel
Yesod devel server. Press ENTER to quit
Resolving dependencies...
Configuring NotifyMe-0.0.0...
Rebuilding application...
Building NotifyMe-0.0.0...
Preprocessing library NotifyMe-0.0.0...
[1 of 8] Compiling Model            ( Model.hs, dist/build/Model.o )
[2 of 8] Compiling Settings.Development ( Settings/Development.hs, dist/build/Settings/Development.o )
[3 of 8] Compiling Settings         ( Settings.hs, dist/build/Settings.o )
[4 of 8] Compiling Settings.StaticFiles ( Settings/StaticFiles.hs, dist/build/Settings/StaticFiles.o )
[5 of 8] Compiling Foundation       ( Foundation.hs, dist/build/Foundation.o )
[6 of 8] Compiling Import           ( Import.hs, dist/build/Import.o )
[7 of 8] Compiling Handler.Home     ( Handler/Home.hs, dist/build/Handler/Home.o )
[8 of 8] Compiling Application      ( Application.hs, dist/build/Application.o )
In-place registering NotifyMe-0.0.0...
Starting development server: runghc -package-confdist/package.conf.inplace devel.hs
Starting devel application
Devel application launched: http://localhost:8181
Migrating: CREATE TABLE "user"("id" INTEGER PRIMARY KEY,"ident" VARCHAR NOT NULL,"password" VARCHAR NULL,CONSTRAINT "unique_user" UNIQUE ("ident"))
Migrating: CREATE TABLE "email"("id" INTEGER PRIMARY KEY,"email" VARCHAR NOT NULL,"user" INTEGER NULL REFERENCES "user","verkey" VARCHAR NULL,CONSTRAINT "unique_email" UNIQUE ("email"))

Como ves, ha creado inicialmente los objetos de persistencia (la base de datos).

Ahora ya podemos ver el resultado en el explorador web:

Página inicial de Yesod (scaffolded)

Creando contenido

Creando una página

Vamos a crear una simple página, por ejemplo "http://shared.computer-mind.com/about". Los pasos a realizar en todos los casos serían:

Ahora podemos ver nuestra nueva página:

Página About

Y en la salida de la consola en la que hemos lanzado "yesod devel" podemos ver las peticiones:

Devel application launched: http://localhost:8181
GET /about
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Status: 200 OK. /about
GET //static/css/bootstrap.css
Accept: text/css,*/*;q=0.1
GET [("etag","nyE417Xw")]
Status: 301 Moved Permanently. //static/css/bootstrap.css
GET //static/tmp/GKy_B1VG.css
Accept: text/css,*/*;q=0.1
Status: 301 Moved Permanently. //static/tmp/GKy_B1VG.css
GET //static/css/bootstrap.css
Accept: text/css,*/*;q=0.1
GET [("etag","nyE417Xw")]
...

Pueden parecer muchos pasos pero no lo son tanto, además podemos crear un script que nos facilite la tarea.

Creando un widget

Un Widget es similar en la forma de construirlo que una página, pero la mónada sobre la que corren no es la misma.

Vamos a crear un sencillo widget que muestra un botón para validar la página actual mediante el validador de W3C, así podremos poner fácilmente el widget allí donde queramos.

En el scaffolder no hay una carpeta para meter los widget, no se muy bien porqué pero "por ahí" sugirieron meterlos en una carpeta "~/NotifyMe/Widget/" y eso es lo que haremos.

Pasos para crear un widget básico:

Ahora podemos usar nuestro widget, por ejemplo, podemos mostrarlo en la página About que hemos creado antes editando su archivo de marcado "~/NotifyMe/templates/about.hamlet":

<h1>Acerca de "Notify Me"
<p><b>Notify Me</b> es la aplicación con la que se desarrolla el tutorial de Yesod en español.
<hr />
^{w3cValidator}

Pero para que el widget sea visible desde esta página debemos añadir una referencia al widget, es decir, en el archivo "~/NotifyMe/Handler/About.hs":

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.About where

import Import
import Widget.W3CValidator

getAboutR :: Handler RepHtml
getAboutR = do
  defaultLayout $ do
      setTitle "Acerca de Notify Me"
      $(widgetFile "about")

Y podemos ver el resultado:

Yesod About W3C

Bueno, se que no es impresionante y que aún te estarás preguntando muchas cosas, implementaremos widgets más útiles a lo largo del tutorial, que accedan a los datos, que tengan en cuenta estados de la sesión, usuarios autenticados, etc...

Personalizando la web

Normalmente todas nuestras páginas comparten un "layout" e incluso realizamos jerarquía de "layouts". Yesod define por defecto un envoltorio para todas las páginas cuyo archivo es "~/NotifyMe/templates/default-layout-wrapper.hamlet". Dicho archivo contiene el marcado principal de las páginas. Un envoltorio menos general sería el archivo "~/NotifyMe/templates/default-layout.hamlet", que define el "layout" a utilizar en nuestro sitio web.

No hay problema en definir jerárquicamente varios "layout", nosotros vamos a darle estilo al "layout" general que tendrán todas nuestras páginas, posteriormente veremos que ciertos grupos de páginas pueden tener otro "layout" específico.

Layout de estructura de página

Vamos a fijar un layout general, el típico de cabecera y pie de página, para ello, vamos a llamar al archivo "~/NotifyMe/templates/default-layout-wrapper.hamlet" simplemente default-layout-wrapper.hamlet, y al archivo "~/NotifyMe/templates/default-layout. hamlet" simplemente default-layout.hamlet.

El problema (igual es que yo no hago algo bien), es que en default-layout-wrapper.hamlet no se pueden meter widgets "normales" y en default-layout.hamlet sí, pero resulta que los elementos <header> y <footer> de HTML5 están declarados en default-layout-wrapper.hamlet y si queremos (que querremos) meter chicha en esos elementos, nos será mucho más cómodo si son widgets "normales".

Vamos a modificar el archivo default-layout-wrapper.hamlet para quitar de ahí los elementos <header> y <footer> de HTML5, reemplazando:

..................................
        <div class="container">
            <header>
            <div id="main" role="main">
              ^{pageBody pc}
            <footer>
              #{extraCopyright $ appExtra $ settings master}
..................................

Por esto otro (recuerda que eliminamos cosas):

..................................
        <div class="container">
          ^{pageBody pc}
..................................

El marcado que hemos quitado, lo metemos entonces en el archivo default-layout.hamlet cuyo contenido completo sería:

<header>
  ^{nmHeader}

<div id="main" role="main">
  $maybe msg <- mmsg
    <div #message>#{msg}
  ^{widget}

<footer>
  ^{nmFooter}
  #{extraCopyright $ appExtra $ settings master}

Y ahora ya sólo tenemos que crear los widget, pero, como a éstos se les hace referencia desde "~/NotifyMe/Foundation.hs", no podemos ponerlos en archivos separados (se produciría referencia cíclica en las importaciones), así, los metermos al final del archivo "~/NotifyMe/Foundation.hs" (obviamente ésto es algo que debo investigar, debe haber una forma más elegante):

..................................
nmHeader :: GWidget sub App ()
nmHeader = $(widgetFile "nmHeader")

nmFooter :: GWidget sub App ()
nmFooter = $(widgetFile "nmFooter")

Ahora podemos crear normalmente el marcado.

"~/NotifyMe/templates/nmHeader.hamlet":

<div>
  <a href="/">
    <img alt="" src=@{StaticR img_clock120_png}>
  <h1>Notify me!
  <h2>Small site to don't forgot important dates!

"~/NotifyMe/templates/nmFooter.hamlet":

Powered with <a href="http://www.yesodweb.com/">Yesod Web Framework</a>
<br />

No hace falta actualizar "~/NotifyMe/NotifyMe.cabal" porque estos widgets especiales no definen un módulo.

Hoja de estilos global

Yesod carga por defecto la hoja de estilos de bootstrap, pero será normal que nosotros queramos poner nuestros propios estilos. Para ello es mejor tener los nuestros en un archivo independiente que se cargue después, así una actualización de la hoja de bootstrap no afectará a la nuestra.

Podemos entonces crear nuestra hoja global en "~/NotifyMe/static/css/global.css":

body {
  background-color: white;
  background-image: url(/static/img/headerbg.gif);
  background-repeat: repeat-x;
}

.container {
  width: 700px;
  margin: auto;
  margin-top: 30px;
  -moz-box-shadow:    0px 0px 10px 4px #000000;
  -webkit-box-shadow: 0px 0px 10px 4px #000000;
  box-shadow:         0px 0px 10px 4px #000000;
  margin-bottom: 100px;
}

header div {
  background-color: #8080f0;
  height: 124px;
  padding: 3px;
  position: relative;
}

header div img {
  float: left;
}
header div h1,h2 {
  text-align: left;
  color: white;
  font-style: italic;
}
header div h1 {
  font-size: 42px;
  margin: 20px 0 0 120px;
}
header div h2 {
  font-size: 12px;
  margin: 10px 0 0 160px;
}

#main {
  background-color: white;
  margin-top: 0px !important;
  margin-bottom: 0px !important;
  padding: 15px;
}

footer {
  text-align: right;
  background-color: #e0e0e0;
  padding: 10px;
  margin-top: 30px;
}

#nmLogin {
  position: absolute;
  right: 0px;
  top: 0px;
  margin-right: 5px;
  margin-top: 5px;
  background: none;
}

Para que sea cargada siempre, lo suyo es añadila en el archivo "~/NotifyMe/Foundation.hs":

..................................
        pc <- widgetToPageContent $ do
            $(widgetFile "normalize")
            addStylesheet $ StaticR css_bootstrap_css
            addStylesheet $ StaticR css_global_css
            $(widgetFile "default-layout")
..................................

Contenido estático

El contenido estático, lo podemos dejar en el directorio "~/NotifyMe/static/" en el que hay varios directorios destinados a diferente tipo de contenido.

Las rutas se generan automáticamente y así, en producción se puede utilizar el sitio separado para el contenido estático sin tener que ajustar nada.

En el punto anterior, en el marcado de la cabecera, puedes ver que hemos escrito algo como:

<img alt="" src=@{StaticR img_clock128_png}>

Yesod al compilar, se asegurará también de que los contenidos estáticos existen y producirá un error si una ruta estática apunta a un recurso que no existe. También en compilación realizará tareas como minimizar javascript y otros.

Para poder escribir las rutas así, tan sólo debemos dejar el archivo, en este caso en "~/NotifyMe/static/img/clock128.png".

Ten en cuenta que los símbolos asociados a los recursos estáticos sólo se recompilan si se modifica el archivo "~/NotifyMe/Settings/StaticFiles.hs" para lo cual viene bien el comando (de la línea de comandos) touch.

El resultado de nuestros cambios anteriores se pueden ver así:

Yesod tutorial home page

Internacionalización (i18n)

Básico

La forma habitual de internacionalizar los mensajes es creando un archivo para cada idioma en "~/NotifyMe/message/", después, en las plantillas se interpolan añadiendo en prefijo Msg y usando la intervalación "_{MsgEtiqueta}".

Por ejemplo, en "~/NotifyMe/message/en.msg":

Hello: Hello world!

Y luego en una plantilla algo como:

<h1>_{MsgHello}

Traducción fuera de plantilla

Para traducir fuera de plantilla, debemos obtener el renderer, que nornalmente será Yesod.Handler.getMessageRender, por ejemplo, en el controlador:

getMiPaginaR = do
  msg <- getMessageRender
  defaultLayout $ do
    $(widgetFile "mipagina")

Y en la plantilla:

<h1>#{msg MsgHello}

Que sería totalmente equivalente al ejemplo básico anterior.

Autenticación y autorización

Uno de los aspectos más importantes a la hora de hacer aplicaciones para los usuarios es permitirles identificarse en nuestra web.

Al proceso de permitir a un usuario que se identifique en nuestro sitio se le llama autenticación, pues permite identificar de forma inequívoca y segura a un usuario en nuestra web.

Al proceso de conceder al usuario acceso (o no) a determinados recursos, se le llama autorización y para poder autorizar, primero hay que autenticar (o bien, establecer un contexto de autenticación por defecto).

Autenticación

Hoy en día es muy común que los sitios no validen a los usuarios, sino que se usan sistemas de autenticación globales con el fin de que el usuario no tenga que crear cuentas y contraseñas en cada web que utiliza.

Yesod permite utilizar sistemas de autenticación globales como Google, OpenID y otros.

Vamos a crear un widget en la cabecera de nuestro layout que de al usuario la posibilidad de autenticarse en nuestro sitio y, si ya lo está, le permita cerrar de la sesión.

Lo primero, es crear el widget, que obtendrá la información relativa al estado actual de la autenticación. Como no tenemos bien resuelto el tema de los widget a nivel de default-layout tendremos que dejarlo en "~/NotifyMe/Foundation.hs", añadiendo al final el siguiente código:

nmLogin :: GWidget sub App ()
nmLogin = do
  maid <- lift $ maybeAuth
  let user = case maid of
               Nothing -> "(unkown user id)"
               Just (Entity _ u) -> userIdent u
  $(widgetFile "nmLogin")

El marcado, que estará en el archivo "~/NotifyMe/templates/nmLogin.hamlet" podría ser así:

<div #nmLogin>
  <span>User:</span>
  <span #nmUser>
    $maybe _ <- maid
      #{user} (<a href=@{AuthR LogoutR}>Logout)
    $nothing
      <a href=@{AuthR LoginR}>Login

Modificamos la cabecera para incluir el widget ("~/NotifyMe/templates/nmHeader.hamlet"):

<div>
  <a href="/">
    <img alt="" src=@{StaticR img_clock120_png}>
  <h1>Notify me!
  <h2>Small site to don't forgot important dates!
  ^{nmLogin}

Y el resultado es éste si vemos la secuencia:

Yesod autenticación

Autorización

Una vez que un usuario ha demostrado que es él (se ha autenticado), podemos conceder o denegar acceso a ciertos recursos, muchas veces se tratará de un acceso indirecto (eg. al recuperar de la base de datos un dato a partir del identificador de este usuario en concreto). Pero otras, querremos autorizar el acceso a elementos concretos.

Ahora vamos a crear una página en la ruta "http://shared.computer-mind.com:8181/userprofile" y sólo daremos acceso (autorizaremos) si está autenticado.

El nombre de nuestro handler podría ser UserProfile es decir, creamos el archivo "~/NotifyMe/Handler/UserProfile.hs":

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.UserProfile where

import Import

nmUserProfileR :: Handler RepHtml
nmUserProfileR = do
  maid <- maybeAuth
  let user = case maid of
               Nothing -> "(unkown user id)"
               Just (Entity _ u) -> userIdent u
  defaultLayout $ do
    setTitle "Perfil de usuario"
    $(widgetFile "nmUserProfile")

Luego la plantilla de marcado "~/NotifyMe/templates/nmUserProfile.hamlet":

<h1>Perfil de usuario</h1>

<div>
  Usuario: #{user}

Ahora añadimos la ruta en "~/NotifyMe/config/routes":

/static StaticR Static getStatic
/auth   AuthR   Auth   getAuth

/favicon.ico FaviconR GET
/robots.txt RobotsR GET

/ HomeR GET POST
/about AboutR GET
/userprofile UserProfileR GET

Actualizamos "~/NotifyMe/Application.hs":

-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Home
import Handler.About
import Handler.UserProfile

Y por último en "~/NotifyMe/NotifyMe.cabal":

library
    exposed-modules: Application
                     Foundation
                     Import
                     Model
                     Settings
                     Settings.StaticFiles
                     Settings.Development
                     Handler.Home
                     Handler.About
                     Handler.UserProfile
                     Widget.W3CValidator

Autorizando una página

Obviamente todo el mundo tiene acceso a esta página, por eso ahora vamos a pedir a Yesod, que si alguien intenta acceder a esta página sin estar autenticado, lo diriga al proceso de autenticación.

Para ésto, editaremos el archivo "~/NotifyMe/Foundation.hs" y sobrecargaremos la función isAuthorized cuando el argumento sea nuestra página, revisando si está autenticado o no:

    -- The page to be redirected to when authentication is required.
    authRoute _ = Just $ AuthR LoginR

    -- Cuando se trata de nuestra página, forzamos autenticación:
    isAuthorized UserProfileR _ =  do
      mu <- maybeAuthId
      return $ case mu of
                 Nothing -> AuthenticationRequired
                 Just _ -> Authorized

    -- Por defecto, todas las páginas son públicas:
    isAuthorized _ _ = return Authorized

    -- This function creates static content files in the static folder
    -- and names them based on a hash of their content. This allows
    -- expiration dates to be set far in the future without worry of
    -- users receiving stale content.
    addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])

Ahora, en el widget de estado de autenticación, podemos añadir un enlace a la página, de todos modos, si se intenta acceder directamente sin estar autenticado redirigirá al proceso de login.

Así pues, modificamos el widget para enlazar a nuestra página de perfil de usuario:

<div #nmLogin>
  <span>User:</span>
  <span #nmUser>
    $maybe _ <- maid
      #{user} (<a href=@{AuthR LogoutR}>Logout</a> | <a href=@{UserProfileR}>My profile</a>)
    $nothing
      <a href=@{AuthR LoginR}>Login

Ahora, el usuario puede ver su perfil:

Yesod, autorizando

Sesiones

En una aplicación web es habitual mantener un estado con información relativa a las acciones que realiza un usuario durante una visita concreta. Por ejemplo, si un usuario busca en un formulario con muchas opciones (fecha, texto, selectores, ...) quizás sea interesante que si vuelve al formulario no tenga que reintroducir todos los valores, es decir, la aplicación recuerde que valores ha introducido.

Algunos de estos valores sólo es interesante que persistan mientras el usuario navega por el sitio, una vez cierra el explorador, la sesión junto a sus datos se pierde.

Podemos hacer un sencillo cambio en la página del perfil de usuario para que muestre el número de veces que hemos visitado esa página.

Modificaríamos el controlador para suministrar y actualizar esa información, es decir, el archivo "~/NotifyMe/Handler/UserProfile.hs":

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.UserProfile (getUserProfileR) where

import Import
import Yesod.Auth
import Data.Maybe (fromMaybe)
import Data.Text (pack, unpack)

viewCountName :: Text
viewCountName = "UserProfileViews"

readInt :: String -> Int
readInt = read

getUserProfileR :: Handler RepHtml
getUserProfileR = do

  -- Leemos el estado de la sesión e incrementamos uno
  viewCount <- lookupSession viewCountName
                  >>= return.(1+).readInt.unpack.fromMaybe "0"

  -- Guardamos el valor
  setSession viewCountName (pack $ show viewCount)

  maid <- maybeAuth
  let user = case maid of
               Nothing -> "(unkown user id)"
               Just (Entity _ u) -> userIdent u

  defaultLayout $ do
    setTitle "Perfil de usuario"
    $(widgetFile "userprofile")

El marcado de "~/NotifyMe/templates/nmUserProfile.hamlet" lo podemos dejar así:

<h1>Perfil de usuario</h1>

<div>
  Usuario: #{user}<br />
  Página visitada <b>#{viewCount}</b> veces

El resultado, es el siguiente:

Yesod sesión

Configuración personalizada

Hemos visto algunos archivos de configuración del scaffolding, pero es habitual que nuestras aplicaciones requieran algunos valores personalizados de configuración como una dirección de correo en la que realizar ciertas notificaciones, una dirección de un servicio externo, etc...

Vamos a ver como crear nuestra propia clave de configuración.

En el archivo "~/NotifyMe/Settings.hs", podemos ver el tipo "data Extra", en él, podemos añadir claves de configuración adicionales. Éstas claves, ya irán preparadas para tener valores por defecto y valores específicos según el tipo de despliegue que se trate (desarrollo, testing, producción, ...).

Pensamos en nuestra clave, que podría ser para este ejemplo "AboutMessage", entonces añadimos al archivo "~/NotifyMe/Settings.hs":

data Extra = Extra
    { extraCopyright :: Text
    , extraAnalytics :: Maybe Text -- ^ Google Analytics
    , aboutMessage   :: Maybe Text -- ^ About Message
    } deriving Show

parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra
    <$> o .:  "copyright"
    <*> o .:? "analytics"
    <*> o .:? "aboutmessage"

Para acceder al valor, modificaremos el handler para acceder al dato en "~/NotifyMe/Handler/About.hs":

getAboutR = do
  getAboutMessage <- getExtra >>= return . aboutMessage
  publicLayout $ do

Y en la plantilla "~/NotifyMe/templates/about.hamlet" añadimos algo como:

$maybe aboutmessage <- getAboutMessage
  <h1>#{aboutmessage}

Ahora podemos añadir nuestra clave de configuración, por ejemplo, en "~/NotifyMe/config/settings.yml":

Default: &defaults
  host: "*4" # any IPv4 host
  port: 8181
  approot: "http://shared.computer-mind.com:8181"
  copyright: Insert copyright statement here
  #analytics: UA-YOURCODE
  aboutmessage: Esto es un texto de ejemplo.

Development:
  <<: *defaults

Testing:
  <<: *defaults

Staging:
  <<: *defaults

Production:
  #approot: "http://www.example.com"
  <<: *defaults

Por lo que ahora podemos ver cómo se accede a esa clave de configuración:

Yesod Custom Site Config

Persistencia

Yesod permite utilizar diferentes tipos de bases de datos. Todo el tratamiento lo hace de forma transparente, por lo que podemos cambiar entre una y otra en cualquier momento sin que afecte a nuestro código.

Para mostrar la persistencia, vamos a definir algunos datos que el usuario podrá fijar en su perfil.

El modelo

Para definir el modelo de datos, modificaremos el archivo "~/NotifyMe/config/models":

User
    ident Text
    password Text Maybe
    UniqueUser ident
    
Email
    email Text
    user UserId Maybe
    verkey Text Maybe
    UniqueEmail email

UserProfile
  user UserId
  email Text
  name Text
  defaultSubject Text
  UniqueUserProfile user

 -- By default this file is used in Model.hs (which is imported by Foundation.hs)

Hemos definido tres campos ("email", "name" y "defaultSubject") y hemos relacionado un único posible registro con la tabla preexistente en Yesod "user".

Yesod creará automáticamente los objetos de base de datos en la próxima compilación por lo que ya podemos usar la nueva entidad.

Lo que vamos a hacer, es que esos datos se puedan ver y modificar desde nuestra página de perfil de usuario.

Leyendo datos desde persistencia

Como aún no vamos a hacer un auténtico formulario (lo haremos en la próxima sección del tutorial) y como es lógico no hay creado ningún registro, usaremos la línea de comandos de "sqlite" para insertar un registro con el que trabajar.

Ésto dependerá de tu sistema, pero en Linux debería servirte la siguiente secuencia:

NotifyMe$ sqlite3 NotifyMe.sqlite3
SQLite version 3.7.14.1 2012-10-04 19:37:12
Enter ".help" for instructions
Enter SQL statements terminated with a ";"
sqlite> SELECT * FROM user;
1|jose******@gmail.com|
sqlite> INSERT INTO user_profile(
   ...>    user,
   ...>    email,
   ...>    name,
   ...>    default_subject
   ...> ) VALUES (
   ...>    1,
   ...>    'jose-juan@computer-mind.com',
   ...>    'jose juan',
   ...>    'Notify me, evento'
   ...> );
sqlite> 

Ahora, para mostrar esa información, lo primero es modificar el controlador (el Handler) de la página para cargar los datos desde la persistencia (la base de datos). Así, editamos el archivo "~/NotifyMe/Handler/UserProfile.hs" (y de paso, quitamos la prueba anterior relacionada con el estado de la sesión):

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.UserProfile (getUserProfileR) where

import Import
import Yesod.Auth
import Data.Maybe (fromJust)

getUserProfileR :: Handler RepHtml
getUserProfileR = do

  userId <- requireAuthId
  Entity _ userData <- runDB $ selectFirst [UserProfileUser ==. userId] [] >>= return.fromJust

  defaultLayout $ do
    setTitle "Perfil de usuario"
    $(widgetFile "userprofile")

La plantilla "~/NotifyMe/templates/userprofile.hamlet" la dejaremos como:

<h1>Perfil de usuario</h1>

<div>
  e-mail: #{userProfileEmail userData}<br />
  Nombre: #{userProfileName userData}<br />
  Subject: #{userProfileDefaultSubject userData}

Escribiendo datos persistentes

En la siguiente sección veremos los formularios, pero ahora, para mostrar como actualizar los datos que hemos leído, únicamente añadiremos una letra al subject cada vez que se muestre la página, para ello añadimos el comando de actualización en el archivo "~/NotifyMe/Handler/UserProfile.hs":

{-# LANGUAGE TupleSections, OverloadedStrings, ScopedTypeVariables #-}
module Handler.UserProfile (getUserProfileR) where

import Import
import Yesod.Auth
import Data.Maybe (fromJust)
import Data.Text (pack, unpack)

getUserProfileR :: Handler RepHtml
getUserProfileR = do

  userId <- requireAuthId
  Entity userDataId userData <- runDB $ selectFirst [UserProfileUser ==. userId] [] >>= return.fromJust

  runDB $ update userDataId [UserProfileDefaultSubject =. (pack.('A':).unpack.userProfileDefaultSubject $ userData)]

  defaultLayout $ do
    setTitle "Perfil de usuario"
    $(widgetFile "userprofile")

Ahora, cada vez que entres al perfil de usuario se añadirá una "A" como prefijo del subject (muy útil, por supuesto).

Como vemos, hacer las operaciones básicas es muy sencillo.

Formularios

Ahora vamos a ver los formularios, en particular, vamos a permitir que un usario modifique su perfil de usuario.

Modificaremos el controlador "~/NotifyMe/Handler/UserProfile.hs" para generar un formulario cuando se accede directamente a la página (GET) y para procesarlo cuando nos devuelven los datos (POST):

{-# LANGUAGE TupleSections, ScopedTypeVariables, QuasiQuotes, TemplateHaskell,
             MultiParamTypeClasses, OverloadedStrings, TypeFamilies #-}
module Handler.UserProfile (getUserProfileR, postUserProfileR) where

import Import
import Yesod.Auth
import Data.Maybe (fromJust, isNothing)

-- Definimos una estructura que representan los datos del formulario
data UserProfileForm = UserProfileForm
  { upfEmail :: Text
  , upfName :: Text
  , upfSubject :: Text
  } deriving Show

-- Un constructor de formularios
userProfileForm email name subject = renderDivs $ UserProfileForm
  <$> areq textField "Email" email
  <*> areq textField "Name" name
  <*> areq textField "Subject" subject

genUserProfileR :: GWidget App App () -> Enctype -> GHandler App App RepHtml
genUserProfileR form formEnc = defaultLayout $ do
                                 setTitle "Perfil de usuario"
                                 $(widgetFile "userprofile")

getUserProfileR :: Handler RepHtml
getUserProfileR = do
  userId <- requireAuthId
  userPersist <- runDB $ selectFirst [UserProfileUser ==. userId] []
  let Entity userDataId userData = fromJust userPersist
      userData' = UserProfileForm (userProfileEmail          userData)
                                  (userProfileName           userData)
                                  (userProfileDefaultSubject userData)
      emptyData = UserProfileForm "" "" ""
      UserProfileForm userProfileEmail'
                      userProfileName'
                      userProfileDefaultSubject' =
        if not (isNothing userPersist)
          then userData'
          else emptyData
  (form, formEnc) <- generateFormPost $ userProfileForm (Just userProfileEmail')
                                                        (Just userProfileName')
                                                        (Just userProfileDefaultSubject')
  genUserProfileR form formEnc

postUserProfileR :: Handler RepHtml
postUserProfileR = do
  userId <- requireAuthId
  ((res, form), formEnc) <- runFormPost $ userProfileForm Nothing Nothing Nothing
  case res of
    FormSuccess uData -> do
         userPersist <- runDB $ selectFirst [UserProfileUser ==. userId] []
         let Entity userDataId' _ = fromJust userPersist
         if isNothing userPersist
           then do
                  _ <- runDB $ insert $ UserProfile userId
                                                    (upfEmail   uData)
                                                    (upfName    uData)
                                                    (upfSubject uData)
                  return ()
           else runDB $ update userDataId' [ UserProfileEmail          =. (upfEmail   uData)
                                           , UserProfileName           =. (upfName    uData)
                                           , UserProfileDefaultSubject =. (upfSubject uData)
                                           ]
    _ -> return ()
  genUserProfileR form formEnc

También modificamos la plantilla "~/NotifyMe/templates/userprofile.hamlet" para mostrar el formulario:

<h1>Perfil de usuario</h1>

<form method=post action=@{UserProfileR} enctype=#{formEnc}>
  ^{form}
  <br />
  <input type=submit>

Como ahora nuestra página admite el verbo POST de HTTP, debemos incluirlo en "~/NotifyMe/config/routes":

/static StaticR Static getStatic
/auth   AuthR   Auth   getAuth

/favicon.ico FaviconR GET
/robots.txt RobotsR GET

/ HomeR GET POST
/about AboutR GET
/userprofile UserProfileR GET POST

Ahora, los usuarios pueden actualizar los datos de su perfil:

Yesod form

Sirviendo tipos de contenido

Servicios JSON

Hoy en día pocas aplicaciones web pueden concebirse sin desplegar servicios JSON de forma que pueda actualizarse información en el cliente sin necesidad de recargar toda la página, validaciones, etc...

En su forma más sencilla, implementar un servicio JSON es seguir los mismos pasos que para un Handler "normal", pero cuya respuesta sea JSON (incluido en "Content-type" por supuesto):

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.JsonTest (getJsonTestR) where

import Import

getJsonTestR :: Handler RepJson
getJsonTestR = jsonToRepJson $ object [("json", "test" :: String)]
      

Raw o "plain-text"

De forma similar, podríamos hacer una URL que dada una lista de palabras las devuelve ordenadas:

Por ejemplo "~/Handler/SortWords.hs":

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.SortWords (getSortWordsR) where

import Import
import qualified Data.Text as T
import Data.List (sort)

getSortWordsR :: [Text] -> Handler RepPlain
getSortWordsR = return . RepPlain . toContent . T.unlines . sort

Notify me, case study

Hasta ahora, he intentado que el tutorial fuera lineal en el sentido de mostrar uno a uno los elementos para poner en marcha una web con Yesod. Así por ejemplo se ha mostrado el uso de variables de sesión aunque realmente no se han usado para nada (útil), se ha mostrado la persistencia antes que los formularios, etc...

Esto ha sido así, para mostrar los elementos mínimos con los que podemos realizar aplicaciones con Yesod.

En esta sección, desarrollaré los elementos al revés, es decir, la linealidad la marcarán las funcionalidades que añadiremos al sitio y sobre ella se verán como podemos aplicar las herramientas de Yesod.

Creando eventos

Ahora que un usuario tiene un perfil, podemos permitirle que mantenga sus eventos, es decir, crear, visualizar, modificar y eliminar sus eventos de notificación.

Primero añadimos el modelo de los datos que queremos mantener (bueno, ya sabes, editando "~/NotifyMe/config/models"):

User
    ident Text
    password Text Maybe
    UniqueUser ident

Email
    email Text
    user UserId Maybe
    verkey Text Maybe
    UniqueEmail email

UserProfile
    user UserId
    email Text
    name Text
    defaultSubject Text
    UniqueUserProfile user

Event
    user UserId
    subject Text
    detail Text
    fireAt Day

 -- By default this file is used in Model.hs (which is imported by Foundation.hs)

Como hemos añadido un tipo Day hemos tenido que añadir "import Data.Time" al archivo "~/NotifyMe/Model.hs" y la referencia al paquete "time-1.4" en "~/NotifyMe/NotifyMe.cabal".

Crearemos una dirección REST de la forma "http://shared.computer-mind.com:8181:/event/#/edit", donde la almohadilla indicará el identificador del evento, si es 0, se supondrá que se quiere crear uno nuevo.

El controlador lo podemos llamar EventEdit es decir, creamos el archivo "~/NotifyMe/Handler/EventEdit.hs":

{-# LANGUAGE TupleSections, ScopedTypeVariables, QuasiQuotes, TemplateHaskell,
             MultiParamTypeClasses, OverloadedStrings, TypeFamilies #-}
module Handler.EventEdit (getEventEditR, postEventEditR) where

import Import
import Yesod.Auth
import Data.Maybe (fromJust, isNothing)
import Control.Monad
import Data.Time
import System.Locale
import Database.Persist.Store (PersistValue (PersistInt64))

-- Definimos una estructura que representan los datos del formulario
data EventEditForm = EventEditForm
  { eefSubject :: Text
  , eefDetail :: Text
  , eefFireAt :: Day
  } deriving Show

-- Un constructor de formularios
eventEditForm subject detail fireAt = renderDivs $ EventEditForm
  <$> areq textField "Subject" subject
  <*> areq textField "Detail" detail
  <*> areq dayField "FireAt" fireAt

-- genEventEditR :: GWidget App App () -> Enctype -> GHandler App App RepHtml
genEventEditR form formEnc eventId = defaultLayout $ do
                                 setTitle "Edición de evento"
                                 $(widgetFile "eventedit")

getEventEditR :: Int -> Handler RepHtml
getEventEditR eventId = do
  userId <- requireAuthId
  let eventKey = Key . PersistInt64 $ fromIntegral eventId
  eventPersist <- runDB $ selectFirst [EventUser ==. userId, EventId ==. eventKey] []
  let Entity eventDataId eventData = fromJust eventPersist
  now <- liftIO getCurrentTime
  let eventData' = EventEditForm (eventSubject eventData)
                                 (eventDetail  eventData)
                                 (eventFireAt  eventData)
      emptyData = EventEditForm "" "" $ utctDay now
      EventEditForm eventSubject'
                    eventDetail'
                    eventFireAt' =
        if eventId == 0
          then emptyData
          else eventData'
  (form, formEnc) <- generateFormPost $ eventEditForm (Just eventSubject')
                                                      (Just eventDetail')
                                                      (Just eventFireAt')
  genEventEditR form formEnc eventId

postEventEditR :: Int -> Handler RepHtml
postEventEditR eventId' = do
  userId <- requireAuthId
  let eventKey = Key . PersistInt64 $ fromIntegral eventId'
  ((res, form), formEnc) <- runFormPost $ eventEditForm Nothing Nothing Nothing
  eventKey'' <- case res of
               FormSuccess eData -> do
                    eventPersist <- runDB $ selectFirst [EventUser ==. userId, EventId ==. eventKey] []
                    let Entity _ eventData = fromJust eventPersist

                    if eventId' == 0
                      then do
                             eventKey' <- runDB $ insert $ Event userId
                                                                 (eefSubject eData)
                                                                 (eefDetail  eData)
                                                                 (eefFireAt  eData)
                             return eventKey'
                      else do
                             runDB $ update eventKey [ EventSubject =. (eefSubject eData)
                                                     , EventDetail  =. (eefDetail  eData)
                                                     , EventFireAt  =. (eefFireAt  eData)
                                                     ]
                             return eventKey
               _ -> return eventKey
  let Key (PersistInt64 eventId64) = eventKey''
      eventId = fromIntegral eventId64
  genEventEditR form formEnc eventId

Añadimos la ruta en "~/NotifyMe/config/routes":

/static StaticR Static getStatic
/auth   AuthR   Auth   getAuth

/favicon.ico FaviconR GET
/robots.txt RobotsR GET

/ HomeR GET POST
/about AboutR GET
/userprofile UserProfileR GET POST
/event/#Int/edit EventEditR GET POST

Como requiere estar autorizado, ajustamos "~/NotifyMe/Foundation.hs" (notar que hemos reemplazado todas las definiciones previas de la función isAuthorized):

    -- The page to be redirected to when authentication is required.
    authRoute _ = Just $ AuthR LoginR

    -- Cuando se trata de nuestra página, forzamos autenticación:
    isAuthorized p _ = isAuth p
      where isAuth UserProfileR = chkAuth
            isAuth _ = return Authorized
            chkAuth = do
              mu <- maybeAuthId
              return $ case mu of
                 Nothing -> AuthenticationRequired
                 Just _ -> Authorized

    -- This function creates static content files in the static folder
    -- and names them based on a hash of their content. This allows

Añadimos a "~/NotifyMe/Application.hs":

-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Home
import Handler.About
import Handler.UserProfile
import Handler.EventEdit

Y a "~/NotifyMe/NotifyMe.cabal":

library
    exposed-modules: Application
                     Foundation
                     Import
                     Model
                     Settings
                     Settings.StaticFiles
                     Settings.Development
                     Handler.Home
                     Handler.About
                     Handler.UserProfile
                     Handler.EventEdit
                     Widget.W3CValidator

Ahora los usuarios pueden crear y modificar sus eventos:

Yesod event editor

Listando eventos

Vamos a listar todos los eventos de un usuario, creando el controlador EventList en la ruta "http://shared.computer-mind.com:8181/event".

El controlador:

module Handler.EventList (getEventListR) where

import Import
import Yesod.Auth
import Database.Persist.Store (PersistValue (PersistInt64))
import Data.Text (pack)

getEventListR :: Handler RepHtml
getEventListR = do
  userId <- requireAuthId
  eventList <- runDB $ selectList [EventUser ==. userId] []
  let fromKey k = fromIntegral i where Key (PersistInt64 i) = k
      list = zip (cycle [pack "dataOdd", pack "dataEven"]) eventList
  defaultLayout $ do
    setTitle "Listado de eventos"
    $(widgetFile "eventlist")

El marcado:

<h1>Listado de eventos</h1>

<table class=dataTable>
  <tr>
    <th>Evento
    <th>Fecha
    <th>Acciones
  $forall e <- list
    <tr class=#{fst e}>
      <td>#{eventSubject $ entityVal $ snd e}
      <td class=dataRight>#{show $ eventFireAt $ entityVal $ snd e}
      <td class=dataCenter>
        <a href=@{EventEditR $ fromKey $ entityKey $ snd e}>editar

Y añadimos la ruta, requerimiento de autenticación en Foundation y las referencias en Application y en cabal.

Así, los usuarios pueden listar sus eventos:

Yesod event list

Un menú de usuario

Vamos a poner en la cabecera un menú de usuario para acceder a las páginas que hemos creado.

En el marcado del widget de la cabecera simplemente añadimos:

<div>
  <a href="/">
    <img alt="" src=@{StaticR img_clock120_png}>
  <h1>Notify me!
  <h2>Small site to don't forgot important dates!
  ^{nmLogin}

$if isauth
  <div id=userMenu>
    <ul>
      <li>
        <a href=@{UserProfileR}>
          <img src=@{StaticR img_menu_userprofile_png} alt="" class=left />
          <img src=@{StaticR img_menu_arrow_png} alt="" class=right />
          <span>Perfil de usuario
      <li>
        <a href=@{EventListR}>
          <img src=@{StaticR img_menu_events_png} alt="" class=left />
          <img src=@{StaticR img_menu_arrow_png} alt="" class=right />
          <span>Eventos programados
      <li>
        <a href=@{EventEditR 0}>
          <img src=@{StaticR img_menu_newevent_png} alt="" class=left />
          <img src=@{StaticR img_menu_arrow_png} alt="" class=right />
          <span>Crear evento

Y el controlador (recuerda que está en "~/NotifyMe/Foundation.hs") lo reescribimos como:

nmHeader :: GWidget sub App ()
nmHeader = do
  maid <- lift $ maybeAuth
  let isauth = case maid of
                 Nothing -> False
                 _ -> True
  $(widgetFile "nmHeader")

Así el menú enlazará a las páginas correctas aunque cambiemos las rutas, en controlador, etc...

Yesod menú de usuario

Páginas maestras

El menú anterior, aparecerá en todas las páginas, obviamente sólo cuando el usuario esté autenticado, pero puede ser que no queramos que aparezca en todas las páginas.

Es habitual a la hora de hacer aplicaciones web que haya "grupos de layouts", es decir, unas cuantas páginas comparten el layout X, otras pocas páginas comparten otro layout Y, etc...

Uno de los aspectos que me gustan de ASP.NET son las páginas maestras ("master pages") y en Yesod es realmente fácil implementarlas.

Yo sugiero crear un directorio "~/NotifyMe/MasterPage/" para alojar las páginas maestras, realmente no va a haber muchas diferencia con una página normal, pero ésto separa sin ambigüedad el sentido de un Handler y de una "master page".

Así, nosotros podemos crear un layout que compatirán las páginas "http://shared.computer-mind.com:8181/" y "http://shared.computer-mind.com:8181/about". Ahora, con todos los cambios que hemos hecho se ven así:

Yesod new old home about

Así, vamos a crear un layout para las páginas públicas, cuyo nombre podría ser PublicLayout, y así, crearemos el archivo "~/NotifyMe/MasterPage/PublicLayout.hs" que crearemos como una página (Handler) normal excepto porque no necesita definir permisos (aunque podría) ni rutas.

El código podría ser éste:

module MasterPage.PublicLayout (publicLayout) where

import Import

publicLayout pageContent = do
  defaultLayout $ do
      $(widgetFile "publiclayout")

Y el marcado (que obviamente será en "~/NotifyMe/templates/publiclayout.hamlet") es:

<div style="border: 5px solid red; padding: 10px; background-color: yellow">
  ^{pageContent}

Actualizamos Application.hs, Foundation.hs y NotifyMe.cabal y ya tenemos nuestra página maestra.

Obviamente por sí sóla no se ve en ningún sitio, pero sólo es reemplazar defaultLayout por publicLayout en los controladores (Handler) home y about y veremos ésto:

Yesod new old home about

Como ves, aparte de los bonitos colores, ambas páginas comparten el layout PublicLayout.

Para combinar páginas maestras de páginas maestras únicamente es crear una nueva página maestra que parta, no de defaultLayout, sino de la página maestra ancestra.

Redirigiendo

Otro aspecto frecuente es que desde un controlador, en un momento dado, se quiere redirigir al usuario a otra página, en la siguiente sección Formularios con múltiples botones puedes ver un ejemplo.

Formularios con múltiples botones

En los formularios hemos visto como se insertan controles a partir de un tipo de datos pero, ¿que pasa con los botones?. Hasta ahora sólo hemos necesitado el botón "submit", pero a veces es útil tener "ok/cancel" u otros como "save/new/delete/cancel".

Lo que vamos a hacer es modificar la página "EventEdit" para que haya un total de cuatro botones:

(PENDIENTE...)

Enviando mails

Obviamente nuestra aplicación tiene que avisar de las alertas configuradas, para ello, deberá revisar cada cierto tiempo si algún evento no enviado está fuera de fecha. Aunque hay formas de hacer que en la aplicación Yesod haya un proceso en segundo plano, una forma más sencilla y robusta es delegar la responsabilidad de lanzar la tarea a una entidad externa (eg. un comando en el crontab en un servidor).

Así, no sólo para enviar los emails, sino para cualquier tarea periódica que deba realizarse, podemos utilizar el mismo punto de entrada, que será una dirección de nuestra aplicación.

Yesod disponía en sus primeras versiones de un helper para enviar correos, pero fué eliminado, supongo que por los problemas de compatibilidad entre diferentes sistemas operativos. De todos modos, existen librerías como Network.Mail.Mime (también implementada por "Michael Snoyman") que podemos utilizar sin mayor inconveniente en nuestras aplicaciones Yesod.

Entonces, lo que vamos a hacer es una entrada en nuestra aplicación que puede ser "http://shared.computer-mind.com:8181/internal/dotasks" que lanzará las tareas que deban ejecutarse (eg. enviar correos pendientes).

Para proteger este recurso (sólo deben poder lanzarlo quienes tengan permiso) existen diferentes mecanismos: solicitar credenciales a nivel HTTP, conceder acceso por IP, pedir por POST una clave de acceso, etc... Nosotros implementaremos el acceso por IP, así veremos como recuperarla y procesarla.

Como usamos el comando de Linux sendmail, la cuenta del usuario from debe ser correcta, así, podemos poner dicha cuenta como una clave de configuración, por ejemplo "sitemail" (en "~/NotifyMe/Settings.hs" recuerda).

Otra clave de configuración, puede ser la lista de IP's que permitimos lancen el proceso. Podemos poner una clave "dotasksgrantedips" que contenga algo como "127.0.0.1,1.2.3.4,124.98.45.43" para indicar las ips a las que se concede acceso.

El manejador no me ha quedado muy limpio que digamos, pero creo que se entiende bien. En él, hay unas cuantas estrategias poco comunes que nos pueden ser útiles como el procesar un hamlet inline, calcular una url de forma limpia, enlazar llamadas a la base de datos, etc...

{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.DoTasks (getDoTasksR) where

import Import
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Network.Mail.Mime
import Network.Wai (remoteHost)
import Network.Socket (SockAddr)
import qualified Data.List as L
import Data.Time (getCurrentTime, utctDay)
import Text.Blaze.Renderer.String (renderMarkup)
import Database.Persist.Store (PersistValue (PersistInt64))

getIP :: SockAddr -> Text
getIP = L.head . T.splitOn ":" . T.pack . show

joinEventData (Entity k e) = do
  let uid = eventUser e
      Key (PersistInt64 k64') = k
      k64 = fromIntegral k64'
  Just (Entity _ userp) <- runDB $ selectFirst [UserProfileUser ==. uid] []
  return ( k64
         , userProfileName userp
         , userProfileEmail userp
         , eventSubject e
         , eventDetail e
         , eventFireAt e
         )

formatNotifyMail url (_, _, _, esubject, edetail, efireat) =
  LT.pack $ renderMarkup ([hamlet|
<html>
  <body>
    <h1>#{esubject}
    <ul>
      <li><b>Descripción:</b> #{edetail}
      <li><b>Fecha:</b> #{show efireat}
      <li>
        <a href=#{url}>editar evento
    <b>(Debes marcar el evento como notificado si no quieres seguir recibiendo avisos)
|] undefined)
  
sendEventData d@(eid, uname, uemail, esubject, _, efireat) = do
  tm <- getRouteToMaster
  render <- getUrlRender
  fromM <- getExtra >>= return.siteMail
  let eml = simpleMail (Address (Just uname) uemail)
                       (Address Nothing fromM)
                       esubject
                       (LT.fromStrict esubject)
                       (formatNotifyMail (render $ tm $ EventEditR eid) d)
                       []
  liftIO $ eml >>= renderMail' >>= sendmail
  return $ T.concat [uemail, " >>> ", uname, ", ", esubject, " (", T.pack $ show efireat, ")"]

getDoTasksR :: Handler RepPlain
getDoTasksR = do
  grantedIps <- getExtra >>= return.T.splitOn ",".doTasksGrantedIps
  ip <- fmap (getIP . remoteHost . reqWaiRequest) getRequest
  if ip `elem` grantedIps
    then do
           now <- liftIO getCurrentTime
           let nowDay = utctDay now
           eventList <- runDB $ selectList [EventNotified ==. False, EventFireAt <=. nowDay] []
           eventData <- mapM joinEventData eventList
           result <- mapM sendEventData eventData
           (return . RepPlain . toContent) (T.unlines result)
    else do
           (return . RepPlain . toContent) (T.concat ["No access to ", ip, " IP."])

Advertencias

Se ponen aquí algunos avisos, advertencias, cosas a tener en cuenta:

Procedimientos

Aquí se pone en forma de lista los pasos a seguir a la hora de hacer tareas comunes con el fin de no dejarnos ningún paso y no tener que recordar de memoria.

Crear una página

  1. pensar nombre adecuado para la página y controlador.
  2. crear el archivo del controlador en "~/NotifyMe/Handler/".
  3. crear el archivo de plantilla (hamlet, lucius y julius) en "~/NotifyMe/templates/".
  4. añadir la ruta en "~/NotifyMe/config/routes".
  5. añadir "import" en "~/NotifyMe/Application.hs".
  6. añadir referencia en "~/NotifyMe/NotifyMe.cabal".
  7. añadir requerimiento de autenticación en "~/NotifyMe/Foundation.hs".

Jerarquía del Scaffolding

Jerarquía de directorios y archivos dentro de nuestra carpeta de proyecto, con los archivos que crea automáticamente Yesod (scaffolding) como los que nosotros vamos añadiendo: