アジェンダ

ToDoアプリを作る

ルーティングなど概観の確認
機能の実装
- タスクを追加できるようにする
- ユーザー登録できるようにする
- 認証機能を作る

Scotty というライトな Web フレームワークを使用します
ドキュメント : https://hackage.haskell.org/package/scotty-0.11.0/docs/Web-Scotty.html

準備

git clone git@github.com:ryota-ka/web-app-tutorial
cd web-app-tutorial
git checkout getting-started
stack setup
stack build
stack exec web-app-tutorial-exe

ブラウザで以下の URL にアクセス

http://localhost:8080/

app/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.Monoid
import Network.HTTP.Types
import Web.Scotty
import qualified Data.Text.Lazy as T

main :: IO ()
main = do
  scotty 8080 $ do
    get "/" $ do
      text "Hello, world!"

    get "/hello/:name" $ do
      name <- param "name"
      text $ "Hello, " <> name <> "!"

    get "/redirect/to/root" $ do
      status status302
      setHeader "X-Foo-Bar" "bazqux"
      redirect "/"

エンドポイント

$ curl http://localhost:8080/

Hello, world!

$ curl http://localhost:8080/hello/Haskeller

Hello, Haskeller!

$ curl -D - http://localhost:8080/redirect/to/root

HTTP/1.1 302 Found
Transfer-Encoding: chunked
Date: Sat, 14 Jan 2017 05:53:47 GMT
Server: Warp/3.2.9
Location: /
X-Foo-Bar: bazqux

`{-# LANGUAGE OverloadedStrings #-}`

GHCの言語拡張 (Node.js の --harmony オプションのようなもの)
フラグによって Haskell の言語を拡張できる

`OverloadedStrings`

文字列リテラル "str" の型が String ([Char]) ではなく IsString a => a になる

class IsString a where
    fromString :: String -> a

Haskell の文字列事情

Haskell の String はただの Char のリストのため，効率がよくない
文字列を効率よく扱うデータ型をライブラリが提供

以下では文字列表現として Data.Text.Lazy の Text を多く使用する
(Scotty がこの型を要求するため)

Text は IsString のインスタンスになっているので
OverloadedStrings 拡張を使えばリテラルで書ける

app/Main.hs

main :: IO ()
main = do
  scotty 8080 $ do
    get "/" $ do
      text "Hello, world!"

    get "/hello/:name" $ do
      name <- param "name"
      text $ "Hello, " <> name <> "!"

    get "/redirect/to/root" $ do
      status status302
      setHeader "X-Foo-Bar" "bazqux"
      redirect "/"

do を見つけたらそれがどのモナドの do なのかを考える

同じモナドの値が並んでいるはず

app/Main.hs

main :: IO ()
main = do
  scotty 8080 $ do
    get "/" $ do
      text "Hello, world!"

    get "/hello/:name" $ do
      name <- param "name"
      text $ "Hello, " <> name <> "!"

    get "/redirect/to/root" $ do
      status status302
      setHeader "X-Foo-Bar" "bazqux"
      redirect "/"

scotty    :: Network.Wai.Handler.Warp.Types.Port -- Int のエイリアス
             -> ScottyM () -> IO ()
get       :: RoutePattern -> ActionM () -> ScottyM ()
param     :: Parsable a => T.Text -> ActionM a
text      :: T.Text -> ActionM ()
status    :: Status -> ActionM ()
setHeader :: T.Text -> T.Text -> ActionM ()
redirect  :: T.Text -> ActionM a

app/Main.hs

main :: IO ()
main = do -- IO の do
  scotty 8080 $ do -- ScottyM の do
    get "/" $ do -- ActionM の do
      text "Hello, world!"

    get "/hello/:name" $ do -- ActionM の do
      name <- param "name"
      text $ "Hello, " <> name <> "!"

    get "/redirect/to/root" $ do -- ActionM の do
      status status302
      setHeader "X-Foo-Bar" "bazqux"
      redirect "/"

scotty    :: Network.Wai.Handler.Warp.Types.Port -- Int のエイリアス
             -> ScottyM () -> IO ()
get       :: RoutePattern -> ActionM () -> ScottyM ()
param     :: Parsable a => T.Text -> ActionM a
text      :: T.Text -> ActionM ()
status    :: Status -> ActionM ()
setHeader :: T.Text -> T.Text -> ActionM ()
redirect  :: T.Text -> ActionM a

参考 : `do` 構文なしで書くと

main :: IO ()
main =
  scotty 8080 $ get "/" (
                  text "Hello, world!"
                ) >>= \_ ->
                get "/hello/:name" (
                  param "name" >>= \name ->
                  text $ "Hello, " <> name <> "!"
                ) >>= \_ ->
                get "/redirect/to/root" (
                  status status302 >>= \_ ->
                  setHeader "X-Foo-Bar" "bazqux" >>= \_ ->
                  redirect "/"
                )

`GET /tasks`

git checkout get-tasks && stack build && stack exec web-app-tutorial-exe
curl http://localhost:8080/tasks | jq

[
  {
    "taskId": 1,
    "title": "Haskellの勉強会を探す"
  },
  {
    "taskId": 2,
    "title": "CAMPHOR- BASEの場所を調べる"
  },
  {
    "taskId": 3,
    "title": "Haskellの文法を勉強する"
  },
  {
    "taskId": 4,
    "title": "ScottyでWebアプリケーションを作る"
  }
]

`Task` 型の定義

data Task = Task {
    taskId :: Int
  , title  :: T.Text
  } deriving (Eq, Generic, Show)

以下の関数が定義される

Task   :: Int -> T.Text -> Task
taskId :: Task -> Int
title  :: Task -> T.Text

`POST /tasks`

タスクを追加できるようにしていく

git checkout add-tasks

変更可能な状態を扱う
簡単のため今回は IORef を用いる

`IORef` とは？

IOモナドの中で変更可能なリファレンス (Haskell でも例外的に副作用を扱える)

newIORef :: a -> IO (IORef a)
-- 新しい IORef を作成

readIORef :: IORef a -> IO a
-- リファレンスの読み出し

writeIORef :: IORef a -> a -> IO ()
-- リファレンスの書き込み

modifyIORef :: IORef a -> (a -> a) -> IO ()
-- 関数を用いたリファレンスの変更

ドキュメント : https://hackage.haskell.org/package/base-4.9.0.0/docs/Data-IORef.html

app/Main.hs

main :: IO ()
main = do
  ref <- newIORef defaultTasks -- 新しい IORef を作成して ref に入れる
  scotty 8080 $ do
    -- 中略
    get "/tasks" $ do -- ActionM の do (≠ IO の do)
      tasks <- liftIO $ readIORef ref -- readIORef :: IORef a -> IO a
      json tasks

    post "/tasks" $ do
      text "change me to add tasks!"

readIORef は IO であって ActionM ではない

liftIO :: MonadIO m => IO a -> m a を使って型を調整
m が ActionM, a が [Task] だと思うと

liftIO :: IO [Task] -> ActionM [Task]

(詳しくは中級者になってから)

`addTask`

ref :: IORef [Task] の参照は Task のリストを指しています

ref とタスクのタイトルを受け取り
リストの先頭にタスクを追加するよう参照を変更し
IO () を返す

関数 addTask を modifyIORef を用いて実装してください
ただし，taskId は連番になるようにしてください

ヒント : まずは引数や関数全体の型を考えましょう

modifyIORef -> IORef a -> (a -> a) -> IO ()

-- a が [Task] だと思うと
modifyIORef :: IORef [Task] -> ([Task] -> [Task]) -> IO ()

`addTask` (cont'd)

addTask :: IORef [Task] -> T.Text -> IO ()
addTask ref title = modifyIORef ref transform
  where
    transform :: [Task] -> [Task]
    transform tasks = ...

解答例

addTask :: IORef [Task] -> T.Text -> IO ()
addTask ref title = modifyIORef ref transform
  where
    transform :: [Task] -> [Task]
    transform tasks =
      let newTask = Task (length tasks + 1) title
          in newTask:tasks

`POST /tasks` の実装

先程定義した addTasks を用いて，エンドポイント POST /tasks を実装してください

$ curl -X POST -d title='a new task' -D - http://localhost:8080/tasks

HTTP/1.1 201 Created
Transfer-Encoding: chunked
Date: Fri, 13 Jan 2017 15:15:15 GMT
Server: Warp/3.2.9
Content-Type: application/json; charset=utf-8

{"taskId":5,"title":"a new task"}

ヒント : param "title" でリクエストボディから title が取得できます

解答例

post "/tasks" $ do
  title <- param "title"
  liftIO $ addTask ref title
  tasks <- liftIO $ readIORef ref
  let newTask = head tasks
  status status201
  json newTask

`modifyIORef` は atomic でない

for i in `seq 1 1000`; do
  curl -X POST -d title=$i http://localhost:8080/tasks &
done

curl http://localhost:8080/tasks | jq length

atomic な関数への修正

タスクの追加が atomic 行われるように修正してください

Data.IORef に modifyIORef を atomic に行う関数が提供されています

atomic な関数への修正 (cont'd)

atomicModifyIORef  :: IORef a -> (a -> (a, b)) -> IO b -- lazy
atomicModifyIORef' :: IORef a -> (a -> (a, b)) -> IO b -- strict

空間計算量の肥大化(スペースリーク)を防ぐため，atomicModifyIORef' を使いましょう

戻り値の型の b は任意なので，追加したタスクを返すと便利そう

addTask :: IORef [Task] -> T.Text -> IO Task

解答例

addTask :: IORef [Task] -> T.Text -> IO Task
addTask ref title = atomicModifyIORef' ref transform
  where
    transform :: [Task] -> ([Task], Task)
    transform tasks =
      let newTask = Task (length tasks + 1) title
          in (newTask:tasks, newTask)

post "/tasks" $ do
  title <- param "title"
  newTask <- liftIO $ addTask ref title -- addTask ref title :: IO [Task]
  status status201
  json newTask

ごく単純な認証機能の作成

git checkout login

type Username = T.Text
type Password = T.Text

data User = User {
    username :: Username
  , password :: Password
} deriving (Eq, Generic, Show)

ごく単純な認証機能の作成 (cont'd)

post "/login" $ do
  maybeUser <- currentUser
  case maybeUser of
    Nothing -> status status401 >> text "authentication required"
    Just user -> text $ "Hello, " <> username user <> "!"

currentUser :: ActionM (Maybe User)

`currentUser` の実装

リクエストパラメータで渡されたユーザーIDとパスワードに一致するユーザーを defaultUsers から探し，
ユーザーが存在すれば Just に入れて返し，
存在しなければ Nothing を返す currentUser を定義してください

currentUser :: ActionM (Maybe User)
currentUser = do
  ...

ヒント :

ActionM の do の中では，ActionM を返す他の関数も使用できます
Data.List に find :: (a -> Bool) -> [a] -> Maybe a という便利な関数があります

解答例

currentUser :: ActionM (Maybe User)
currentUser = do
  u <- param "username"
  p <- param "password"
  return $ find (== User u p) defaultUsers

$ curl -X POST -d username=alice -d password=password http://localhost:8080/login
Hello, alice!

$ curl -X POST -d username=alice -d password=1234 http://localhost:8080/login
authorization required

安全な `param` 関数

期待するパラメータがリクエストに含まれていない場合，param はエラーを吐きます

$ curl -X POST -d username=alice http://localhost:8080/login
<h1>500 Internal Server Error</h1>Param: password not found!

params :: ActionM [Param] を用いて，安全にパラメータを取得する関数 safeParam を実装してください

param     :: Parsable a => T.Text -> ActionM a
safeParam :: Parsable a => T.Text -> ActionM (Maybe a)

ヒント : まずは型や型クラスについて調べましょう

安全な `param` 関数 (cont'd)

ドキュメントから

type Param = (Text, Text)

class Parsable a where Source
  parseParam :: Text -> Either Text a

であることがわかる

data Either a b = Left a | Right b

fst :: (a, b) -> a
snd :: (a, b) -> b

解答例

safeParam :: Parsable a => T.Text -> ActionM (Maybe a)
safeParam key = do
  params' <- params
  let value = snd <$> find ((== key) . fst) params'
  let parsedValue = case value of
                         Nothing -> Nothing
                         Just value -> case parseParam value of
                                            Left _ -> Nothing
                                            Right v -> Just v
  return parsedValue

安全な `currentUser`

先程定義した safeParam を用いて currentUser の定義を修正してください

解答例

currentUser :: ActionM (Maybe User)
currentUser = do
  maybeUsername <- safeParam "username"
  maybePassword <- safeParam "password"
  let maybeUser =
        case (maybeUsername, maybePassword) of
             (Just u, Just p) -> find (== User u p) defaultUsers
             (_, _) -> Nothing
  return maybeUser

ユーザーの追加

ユーザーは現状リードオンリーですが，
タスクの他にユーザーも追加できるようにしてください

git checkout app-state

type AppState = ([Task], [User])

方針

IORef [Task] を IORef AppState に変更する
addTask の型を IORef AppState -> T.Text -> IO Task に変更する
addUser を書く
POST /users を実装する

ユーザー認証

Task に user フィールドを追加してしてください
GET /tasks POST /tasks でも認証情報を要求するように変更してください
毎回 case ~ of ... を書くのが面倒な方は，ヘルパー関数を用意してください

ヘルパー関数のインターフェース

get "/tasks" $ do
  authenticateUser $ \user -> do
  something <- doSomethingWith user
  json something

ログインしていなかったら 401 で { "error": "unauthorized" } を返すと便利そう
(Error 型を定義してあります)

ヘルパー関数の実装

authenticateUser :: (User -> ActionM ()) -> ActionM ()
authenticateUser f = do
  maybeUser <- currentUser
  case maybeUser of
       Nothing -> status status401 >> json (Error "unauthorized")
       Just user -> f user

`GET /tasks/:id`

余裕のある方は GET /tasks/:id を実装してください

username と password を要求する
以下の場合には 404 で { "error": "not found" }
- id に対応するタスクが存在しない
- id に対応するタスクが他人のものである

Scotty による Web アプリ入門

アジェンダ

準備

エンドポイント

{-# LANGUAGE OverloadedStrings #-}

OverloadedStrings

Haskell の文字列事情

参考 : do 構文なしで書くと

GET /tasks

Task 型の定義

POST /tasks

IORef とは？

addTask

addTask (cont'd)

解答例

POST /tasks の実装

解答例

modifyIORef は atomic でない

atomic な関数への修正

atomic な関数への修正 (cont'd)

解答例

ごく単純な認証機能の作成

ごく単純な認証機能の作成 (cont'd)

currentUser の実装

解答例

安全な param 関数

安全な param 関数 (cont'd)

解答例

安全な currentUser

解答例

ユーザーの追加

方針

ユーザー認証

ヘルパー関数のインターフェース

ヘルパー関数の実装

GET /tasks/:id

`{-# LANGUAGE OverloadedStrings #-}`

`OverloadedStrings`

参考 : `do` 構文なしで書くと

`GET /tasks`

`Task` 型の定義

`POST /tasks`

`IORef` とは？

`addTask`

`addTask` (cont'd)

`POST /tasks` の実装

`modifyIORef` は atomic でない

`currentUser` の実装

安全な `param` 関数

安全な `param` 関数 (cont'd)

安全な `currentUser`

`GET /tasks/:id`