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.
Features
- Fast routing
- JSON
- Sessions
- Cookies
- Database helper
- CSRF protection
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
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 
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 
.
Final example code is uploaded here.