Introduction to Web Development with Spock

Spock
------

> Spock is a lightweight Haskell web framework inspired by **Ruby's Sinatra**. It provides a full toolbox including everything to get a quick start into web programming using Haskell.

[Spock](https://www.spock.li/)

### Features

* Fast routing
* JSON
* Sessions
* Cookies
* Database helper
* CSRF protection

[The Spock package](http://hackage.haskell.org/package/Spock)

----

Hello World!
------------

Spock-0.11.0.0

```hs
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Web.Spock
import Web.Spock.Config
import qualified Data.Text as Text

main :: IO ()
main = do
  spockCfg <- defaultSpockCfg () PCNoDatabase ()
  runSpock 8080 $ spock spockCfg $ do

    get root $
      text "Hello Spock!"

    get ("hello" <//> var) $ \name ->
      text (Text.concat ["Hello ", name, "!"])
```

![](https://i.gyazo.com/e6f97f9b78478426301453a93e77e7e8.png)

```hs
-- Web.Spock
get root :: ActionCtxT ctx (WebStateM conn sess st) () -> SpockCtxM ctx conn sess st ()

text :: MonadIO m => Text -> ActionCtxT ctx m a
```

----

Example: Login API
------------------

----

Form data
----------------------

To get a form data, Spock provides `param` function.

```hs
post "login" $ do
  maybeUsername <- param "username"
  case maybeUsername of
    Nothing       -> setStatus status400 >> text "Missing parameter."
    Just username -> text (Text.concat ["Username: ", username])
```

```hs
-- Web.Spock
param :: (PathPiece p, MonadIO m) => Text -> ActionCtxT ctx m (Maybe p)
```

```bash
$ curl -XPOST -F'username=lotz' http://localhost:8080/login
Username: lotz
```

![](https://i.gyazo.com/cbdeb2ac7700437ec2bec8c0fe2dd3a4.png)
[The path-pieces package](http://hackage.haskell.org/package/path-pieces)

----

First Login API
---------------

Preparing the set of username and password.

```hs
userList :: [(Text, Text)]
userList =
  [ ("lotz", "password1")
  , ("alice", "password2")
  , ("bob", "password3")
  ]

findCredential :: MonadIO m => ActionCtxT ctx m (Maybe (Text, Text))
findCredential = do
  username <- param "username"
  password <- param "password"
  pure $ (,) <$> username <*> password
```

Creating `post "login"`.

```hs
post "login" $ do
  credential <- findCredential
  case credential of
    Nothing -> setStatus status400 >> text "Missing parameter."
    Just (username, password) ->
      if lookup username userList == Just password
        then text "Login succeed."
        else setStatus status400 >> text "Wrong parameter."
````

```hs
-- Data.List
lookup :: Eq a => a -> [(a, b)] -> Maybe b
```

```sh
$ curl -XPOST -F'username=lotz' -F 'password=password1' http://localhost:8080/login
Login succeed.
```

----

Of course, we need to hash password
-----------------------------------

Using [bcrypt](http://hackage.haskell.org/package/bcrypt) library.

```hs
-- Crypto.BCrypt
hashPasswordUsingPolicy :: HashingPolicy -> ByteString -> IO (Maybe ByteString)

validatePassword :: ByteString -> ByteString -> Bool
```

Hashing password in `userList`.

```hs
userList :: [(Text, ByteString)]
userList =
  [ ("lotz", "$2y$04$UMnRYB26AvreBv0v4efdauIIr3qTM0opEKln26tSy6XXmKV4hS56S")
  , ("alice", "$2y$04$kRpVhhxbgerHneJJ4HqmNe8MIB7WbPJPXXI3Zy0hFhWpiaJIz6t3m")
  , ("bob", "$2y$04$qbhEesNseMuIpJfFzN7F7uCN6Y5CB0vmMs7eq708CAAx8wnzxvGAm")
  ]
```

Create a validation function.

```hs
validateCredential :: [(Text, ByteString)] -> (Text, Text) -> Bool
validateCredential userList (username, password) =
  case lookup username userList of
    Nothing -> False
    Just passhash ->
      let password' = Text.encodeUtf8 password
      in  validatePassword passhash password'
```

----

Connect to Database
-----

Using [mysql-simple](http://hackage.haskell.org/package/mysql-simple) library.
Create sample database and table in MySQL. 

```mysql
mysql> USE login_sample;
Database changed

mysql> SHOW TABLES;
+------------------------+
| Tables_in_login_sample |
+------------------------+
| user                   |
+------------------------+
1 row in set (0.00 sec)

mysql> DESC user;
+------------+------------------+------+-----+-------------------+-----------------------------+
| Field      | Type             | Null | Key | Default           | Extra                       |
+------------+------------------+------+-----+-------------------+-----------------------------+
| id         | int(10) unsigned | NO   | PRI | NULL              | auto_increment              |
| username   | varchar(255)     | NO   |     | NULL              |                             |
| password   | varchar(255)     | NO   |     | NULL              |                             |
| created_at | timestamp        | NO   |     | CURRENT_TIMESTAMP |                             |
| updated_at | timestamp        | NO   |     | CURRENT_TIMESTAMP | on update CURRENT_TIMESTAMP |
+------------+------------------+------+-----+-------------------+-----------------------------+
5 rows in set (0.02 sec)

mysql> SELECT * FROM user;
+----+----------+--------------------------------------------------------------+---------------------+---------------------+
| id | username | password                                                     | created_at          | updated_at          |
+----+----------+--------------------------------------------------------------+---------------------+---------------------+
|  1 | lotz     | $2y$04$UMnRYB26AvreBv0v4efdauIIr3qTM0opEKln26tSy6XXmKV4hS56S | 2016-08-28 20:10:52 | 2016-08-28 20:10:52 |
|  2 | alice    | $2y$04$kRpVhhxbgerHneJJ4HqmNe8MIB7WbPJPXXI3Zy0hFhWpiaJIz6t3m | 2016-08-28 20:11:06 | 2016-08-28 20:11:06 |
|  3 | bob      | $2y$04$qbhEesNseMuIpJfFzN7F7uCN6Y5CB0vmMs7eq708CAAx8wnzxvGAm | 2016-08-28 20:11:22 | 2016-08-28 20:11:22 |
+----+----------+--------------------------------------------------------------+---------------------+---------------------+
3 rows in set (0.01 sec)
```

Preparing database connection.

```hs
main :: IO ()
main = do
  let mysqlConnect = MySQL.connect MySQL.defaultConnectInfo {MySQL.connectDatabase = "login_sample"}
      dbConn = ConnBuilder mysqlConnect MySQL.close (PoolCfg 1 1 30)

  spockCfg <- defaultSpockCfg () (PCConn dbConn) ()
  runSpock 8080 $ spock spockCfg $ do
```

```hs
-- Web.Spock
data ConnBuilder a
   = ConnBuilder
   { cb_createConn :: IO a
   , cb_destroyConn :: a -> IO ()
   , cb_poolConfiguration :: PoolCfg
   }
```

Validation function is changed as below.

```hs
validateCredential :: (Text, Text) -> ActionCtxT ctx (WebStateM MySQL.Connection sess st) (Maybe Int)
validateCredential (username, password) = do
  user <- runQuery $ \conn -> do
    results <- MySQL.query conn "SELECT id, password FROM user WHERE username = ?" (MySQL.Only (Text.encodeUtf8 username))
    pure $ (listToMaybe results :: Maybe (Int, ByteString))
  pure $ do
    (userId, passhash) <- user
    guard $ validatePassword passhash (Text.encodeUtf8 password)
    pure userId
```

```hs
-- Data.Maybe
listToMaybe :: [a] -> Maybe a
listToMaybe []    =  Nothing
listToMaybe (a:_) =  Just a

-- Web.Spock
runQuery :: (MySQL.Connection -> IO a) -> ActionCtxT ctx (WebStateM MySQL.Connection sess st) a
```

----

Template
-----------------
Actually, Spock has no template support.
Using [stache](http://hackage.haskell.org/package/stache) library for templates.
Preparing templates as below.

```sh
views
├── index.mustache
└── login.mustache
```

```html:views/index.mustache
<p>Hello {{text}}!</p>
```

```html:views/login.mustache
<form method='POST' action='/login'>
  <legend>username: </legend>
  <input type='text' name='username'/>
  <br/>
  <legend>password: </legend>
  <input type='password' name='password'/>
  <br/>
  <input type='submit'/>
</form>
```

Let's use templates.

```hs
main :: IO ()
main = do

  template <- compileMustacheDir "index" "views/"
  let render pname = TL.toStrict . renderMustache (template {templateActual = pname})

  ...

  spockCfg <- defaultSpockCfg () (PCConn dbConn) ()
  runSpock 8080 $ spock spockCfg $ do

    get root $ html (render "index" (object ["text" .= ("Spock" :: Text)]))

    get "login" $ html (render "login" (object []))
```

```hs
-- Web.Spock
html :: MonadIO m => Text -> ActionCtxT ctx m a

-- Text.Mustache
compileMustacheDir :: (MonadIO m, MonadThrow m) => PName -> FilePath -> m Template

renderMustache :: Template -> Value -> Text
```

![](https://i.gyazo.com/46a0ad5a6d1df54fb129c885a72bb3df.png)

----

Session
----------------

To use session, you just change the type of an argument of `defaultSpockCfg`.

```hs
spockCfg <- defaultSpockCfg (Nothing :: Maybe Int) (PCConn dbConn) ()
runSpock 8080 $ spock spockCfg $ do

  get root $ do
    maybeUserId <- readSession
    case maybeUserId of
      Nothing -> redirect "/login"
      Just userId -> html (render "index" (object ["text" .= (Text.pack (show userId))]))

  get "logout" $ writeSession Nothing >> redirect "/login"
```

```hs
  post "login" $ do
    credential <- findCredential
    case credential of
      Nothing -> redirect "/login"
      Just (username, password) -> do
        maybeUserId <- validateCredential (username, password)
        case maybeUserId of
          Nothing -> redirect "/login"
          Just userId -> writeSession (Just userId) >> redirect "/"
```

```hs
-- Web.Spock
readSession :: ActionCtxT ctx (WebStateM conn sess st) sess

writeSession :: sess -> ActionCtxT ctx (WebStateM conn sess st) ()

modifySession :: (sess -> sess) -> SpockActionCtx ctx conn sess st ()
```

----

Logging
-------

Spock create a `Middleware` in WAI.
WAI is a generic web application interface like WSGI and Rack.

```hs
-- Network.Wai
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

type Middleware = Application -> Application
```
```hs
-- Web.Spock
spock :: SpockCfg conn sess st -> SpockCtxM () conn sess st -> IO Middleware
```

You can combine any other `Middleware` with your Spock app.

![](https://i.gyazo.com/286b9076546d9bbabbccd144fad4e945.png)

Let's use `RequestLogger` in [`wai-extra`](http://hackage.haskell.org/package/wai-extra).

```hs
spockCfg <- defaultSpockCfg (Nothing:: Maybe Int) (PCConn dbConn) ()
runSpock 8080 $ fmap (logStdoutDev.) $ spock spockCfg $ do
  get root $ do
```

![](https://i.gyazo.com/ad0c2aed0c7c095329ca490a399dcf0e.png)

----

Thank you :bowtie: 
-----------------

----

This slide is used at [Haskell Day 2016](http://connpass.com/event/37892/). For this reason it is written in English, but I use a lot of images and code to make it easier to understand :wink: .
Final example code is uploaded [here](https://github.com/lotz84/haskellday2016).