Edited at

Introduction to Web Development with Spock

More than 1 year has passed since last update.


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


Features


  • Fast routing

  • JSON

  • Sessions

  • Cookies

  • Database helper

  • CSRF protection

The Spock package



Hello World!

Spock-0.11.0.0

{-# 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, "!"])

-- 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.

post "login" $ do

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

-- Web.Spock

param :: (PathPiece p, MonadIO m) => Text -> ActionCtxT ctx m (Maybe p)

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

Username: lotz



The path-pieces package



First Login API

Preparing the set of username and password.

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".

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."

-- Data.List

lookup :: Eq a => a -> [(a, b)] -> Maybe b

$ curl -XPOST -F'username=lotz' -F 'password=password1' http://localhost:8080/login

Login succeed.



Of course, we need to hash password

Using bcrypt library.

-- Crypto.BCrypt

hashPasswordUsingPolicy :: HashingPolicy -> ByteString -> IO (Maybe ByteString)

validatePassword :: ByteString -> ByteString -> Bool

Hashing password in userList.

userList :: [(Text, ByteString)]

userList =
[ ("lotz", "$2y$04$UMnRYB26AvreBv0v4efdauIIr3qTM0opEKln26tSy6XXmKV4hS56S")
, ("alice", "$2y$04$kRpVhhxbgerHneJJ4HqmNe8MIB7WbPJPXXI3Zy0hFhWpiaJIz6t3m")
, ("bob", "$2y$04$qbhEesNseMuIpJfFzN7F7uCN6Y5CB0vmMs7eq708CAAx8wnzxvGAm")
]

Create a validation function.

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 library.

Create sample database and table in 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.

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

-- Web.Spock

data ConnBuilder a
= ConnBuilder
{ cb_createConn :: IO a
, cb_destroyConn :: a -> IO ()
, cb_poolConfiguration :: PoolCfg
}

Validation function is changed as below.

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

-- 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 library for templates.

Preparing templates as below.

views

├── index.mustache
└── login.mustache


views/index.mustache

<p>Hello {{text}}!</p>



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.

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 []))

-- 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



Session

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

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"

  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 "/"

-- 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.

-- Network.Wai

type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

type Middleware = Application -> Application

-- Web.Spock

spock :: SpockCfg conn sess st -> SpockCtxM () conn sess st -> IO Middleware

You can combine any other Middleware with your Spock app.

Let's use RequestLogger in wai-extra.

spockCfg <- defaultSpockCfg (Nothing:: Maybe Int) (PCConn dbConn) ()

runSpock 8080 $ fmap (logStdoutDev.) $ spock spockCfg $ do
get root $ do



Thank you :bowtie:


This slide is used at Haskell Day 2016. 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.