Help us understand the problem. What is going on with this article?

Introduction to Web Development with Spock

More than 3 years have passed since last update.

Introduction to Web Development with Spock

by lotz
1 / 13

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.

lotz
実用関数型プログラミング言語 Haskell の情報を発信しています
http://lotz84.github.io/
folio-sec
誰もがかんたんに資産運用することができるサービス「フォリオ」を作っているFinTech系スタートアップ
https://corp.folio-sec.com/
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away