HaskellのWeb Application Frameworkを試してみる

LT駆動開発20 - 無神月の発表資料です
https://github.com/LTDD/Sessions/wiki/LT%E9%A7%86%E5%8B%95%E9%96%8B%E7%99%BA20

解説記事
http://blog.eiel.info/blog/2015/11/07/ltdd-20-haskell-web-application-framework/

Transcript

1. HaskellͷWeb Application FrameworkΛࢼͯ͠ΈΔ 2015-11-07 LTۦಈ։ൃ20
2. ͻΉΒ ͱ΋ͻ͜ ͦΖͦΖScalaॳ৺ऀΛଔۀ͠ͳ͚Ε͹
3. 10݄ͷπΠʔτ https://twitter.com/eielh/status/654319476620464129
4. 10݄ͷπΠʔτ https://twitter.com/eielh/status/654319476620464129 神無月
5. Haskellͷ Web Application Framework
6. 3強 • Yesod • Snap • Happstack IUUQTXJLJIBTLFMMPSH8FC'SBNFXPSLT
10. 3強 • Yesod (wai & warp) • Snap • Happstack IUUQTXJLJIBTLFMMPSH8FC'SBNFXPSLT
11. wai + warp Ͱ͍ͬͯΈΑ͏
12. IUUQRJJUBDPNFJFMIJUFNTCGDGEFFEF
13. IUUQRJJUBDPNFJFMIJUFNTCGDGEFFEF waiの最小サンプルは試した
14. IUUQRJJUBDPNFJFMIJUFNTFBFFFCBBE
15. IUUQRJJUBDPNFJFMIJUFNTFBFFFCBBE herokuにもデプロイできた
16. よーし、Web APIをつくるぞー
17. wai ϕʔεͷϑϨʔϜϫʔΫ
18. wai ベースのフレームワーク • scotty • Spock • yesod • MFlow
19. ೉қ౓ ܕܕܕʜ 4UBCJMJUZ TDPUUZ ௿ ௿ FYQFSJNFOUBM 4QPDL த த FYQFSJNFOUBM :FTPE ߴ ߴ 4UBCMF .'MPX ࢼ͞ͳ͔ͬͨ
    8FC
    "1*
    ʹ͸޲͔ͳͦ͏ͩͬͨͷͰ
20. ΍ͬͯΈΑ͏
21. Web API͢Δͷʹ͍ͨ͜͠ͱ •ΤϯυϙΠϯτͷߏங •JSONͷੜ੒ •JSONͷಡऔ •HTTPϔομͷಡऔ •HTTP΁ομͷઃఆ
22. લ४උ ଍͠ࢉͷͰ͖Δ७ਮͳWeb APIΛͭ͘Δ ଍͠ࢉΛ͢ΔυϝΠϯϩδοΫΛ༻ҙ
23. {-# LANGUAGE DeriveGeneric #-} module Add where import Prelude hiding (add) import GHC.Generics (Generic) import Data.Aeson hiding (Result) data Result = Result { result :: Integer } deriving (Generic, Show) data Request = Request { x :: Integer, y :: Integer } deriving (Generic, Show) instance ToJSON Result instance FromJSON Result instance ToJSON Request instance FromJSON Request add :: Integer -> Integer -> Result add x y = Result $ x + y
24. ࣮ߦྫ >>>> add 1 2 Result { result = 3}
25. ࣮ߦྫ >>>> add 1 2 Result { result = 3} Result構造体メンバのresultに3がはいってる感じ
26. Ϩεϙϯε༻ͷܕ data Result = Result { result :: Integer } deriving (Generic, Show) instance ToJSON Result instance FromJSON Result
27. POST ϦΫΤετ༻ͷܕ data Request = Request { x :: Integer, y :: Integer } deriving (Generic, Show) instance ToJSON Request instance FromJSON Request
28. υϝΠϯϩδοΫ add :: Integer -> Integer -> Result add x y = Result $ x + y
29. scottyͷ৔߹
30. {-# LANGUAGE OverloadedStrings #-} module Scotty where import Web.Scotty import Data.Aeson hiding (json) import Data.Maybe import Add (add, Request(..)) import Util (getPort) scottySample = getPort >>= flip scotty route where route = do get "/add/:x/:y" $ do addSampleHeader x <- fmap read . param $ "x" y <- fmap read . param $ "y" json $ add x y post "/add" $ do addSampleHeader Just (Request x y) <- fmap decode body json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample
31. $ curl -i http://localhost:3000/add/1/2 HTTP/1.1 200 OK Transfer-Encoding: chunked Date: Fri, 06 Nov 2015 16:58:44 GMT Server: Warp/3.1.3.1 X-SAMPLE: sample Content-Type: application/json; charset=utf-8 {"result":3}
32. $ curl -i http://localhost:3000/add -d '{ "x": 1, "y": 2} ' \ -H "Content-type: application/json" -H "X-SAMPLE: hoge” HTTP/1.1 200 OK Transfer-Encoding: chunked Date: Fri, 06 Nov 2015 16:59:44 GMT Server: Warp/3.1.3.1 X-SAMPLE: hoge Content-Type: application/json; charset=utf-8 {"result":3}
33. route = do get "/add/:x/:y" $ do addSampleHeader x <- fmap read . param $ "x" y <- fmap read . param $ "y" json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample
34. route = do get "/add/:x/:y" $ do addSampleHeader x <- fmap read . param $ "x" y <- fmap read . param $ "y" json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample /add/:x/:y から param key がつらい
35. Spockͷ৔߹
36. {-# LANGUAGE OverloadedStrings #-} module Spock where import Web.Spock import Data.Aeson hiding (json) import Data.Maybe import Add (add, Request(..)) import Util (getPort) spockSample = do port <- getPort runSpock port $ spockT id $ do get ("add" <//> var <//> var) $ \x y -> do addSampleHeader json $ add x y post "add" $ do addSampleHeader Just (Request x y) <- jsonBody json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample
37. $ curl -i http://localhost:3000/add/1/2 HTTP/1.1 200 OK Transfer-Encoding: chunked Date: Fri, 06 Nov 2015 17:09:18 GMT Server: Warp/3.1.3.1 X-SAMPLE: sample Content-Type: application/json; charset=utf-8 {"result":3}%
38. $ curl -i http://localhost:3000/add/1/2 HTTP/1.1 200 OK Transfer-Encoding: chunked Date: Fri, 06 Nov 2015 17:09:18 GMT Server: Warp/3.1.3.1 X-SAMPLE: sample Content-Type: application/json; charset=utf-8 {"result":3}% Spock とかわりない
39. $ curl -i http://localhost:3000/add -d '{ "x": 1, "y": 2} ' \ -H "Content-type: application/json" -H "X-SAMPLE: hoge" HTTP/1.1 200 OK Transfer-Encoding: chunked Date: Fri, 06 Nov 2015 17:10:40 GMT Server: Warp/3.1.3.1 X-SAMPLE: hoge Content-Type: application/json; charset=utf-8 {"result":3}
40. $ curl -i http://localhost:3000/add -d '{ "x": 1, "y": 2} ' \ -H "Content-type: application/json" -H "X-SAMPLE: hoge" HTTP/1.1 200 OK Transfer-Encoding: chunked Date: Fri, 06 Nov 2015 17:10:40 GMT Server: Warp/3.1.3.1 X-SAMPLE: hoge Content-Type: application/json; charset=utf-8 {"result":3} とくに変化ないけど Content-type必須に より安全になったかも
41. get ("add" <//> var <//> var) $ \x y -> do addSampleHeader json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample
42. get ("add" <//> var <//> var) $ \x y -> do addSampleHeader json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample パラメータ取得に文字列不要。 型変換も不要。
43. Yesodͷ৔߹
44. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} module YesodSample where import Yesod (mkYesod, parseRoutes, Yesod(..), selectRep, provideJson, parseJsonBody, warp, lookupHeader, addHeader, renderRoute) import Add (add, Request(..)) import Data.Aeson.Types (Result(..)) import Data.Maybe (fromMaybe) import Data.Text.Encoding (decodeUtf8) data App = App mkYesod "App" [parseRoutes| /add/#Integer/#Integer Add1R GET /add Add2R POST |] instance Yesod App getAdd1R x y = do addSampleHeader selectRep . provideJson $ add x y postAdd2R = do addSampleHeader Success (Request x y) <- parseJsonBody selectRep . provideJson $ add x y yesod :: IO () yesod = warp 3000 App addSampleHeader = do headerSample <- lookupHeader "X-SAMPLE" addHeader "X-SAMPLE" . fromMaybe "sample" $ fmap decodeUtf8 headerSample
45. $ url -i http://localhost:3000/add/1/2 HTTP/1.1 200 OK Date: Fri, 06 Nov 2015 17:15:46 GMT Server: Warp/3.1.3.1 + Yesod/1.4.15.1 (core) Content-Length: 12 Content-Type: application/json; charset=utf-8 Set-Cookie: _SESSION=jjHIHspMlgfwUvPIXiMVzkdx6kn65DVAwX3fiVERujNy FSG9aort5UZ6KyKOW0J7sqlOOwXd6HBp0NeLvYHstBE4qcS25 Xa37WZcXYOh/WWJ1Iv7SD8xCT9QE9hK/98z20/IHXiHg2s=; Path=/; Expires=Fri, 06-Nov-2015 19:15:38 GMT; HttpOnly Vary: Accept, Accept-Language X-SAMPLE: sample {"result":3}
46. $ url -i http://localhost:3000/add/1/2 HTTP/1.1 200 OK Date: Fri, 06 Nov 2015 17:15:46 GMT Server: Warp/3.1.3.1 + Yesod/1.4.15.1 (core) Content-Length: 12 Content-Type: application/json; charset=utf-8 Set-Cookie: _SESSION=jjHIHspMlgfwUvPIXiMVzkdx6kn65DVAwX3fiVERujNy FSG9aort5UZ6KyKOW0J7sqlOOwXd6HBp0NeLvYHstBE4qcS25 Xa37WZcXYOh/WWJ1Iv7SD8xCT9QE9hK/98z20/IHXiHg2s=; Path=/; Expires=Fri, 06-Nov-2015 19:15:38 GMT; HttpOnly Vary: Accept, Accept-Language X-SAMPLE: sample {"result":3} Cookieまでついてきた
47. mkYesod "App" [parseRoutes| /add/#Integer/#Integer Add1R GET |] getAdd1R x y = do addSampleHeader selectRep . provideJson $ add x y addSampleHeader = do headerSample <- lookupHeader "X-SAMPLE" addHeader "X-SAMPLE" . fromMaybe "sample" $ fmap decodeUtf8 headerSample
48. mkYesod "App" [parseRoutes| /add/#Integer/#Integer Add1R GET |] getAdd1R x y = do addSampleHeader selectRep . provideJson $ add x y addSampleHeader = do headerSample <- lookupHeader "X-SAMPLE" addHeader "X-SAMPLE" . fromMaybe "sample" $ fmap decodeUtf8 headerSample 型まで指定できるエンドポイント 黒魔術満載？
49. ·ͱΊ
50. ·ͱΊ Yesod ͍͢͝ɻͰ΋ɺ೉͍͠ɻ scotty΍SpockͳΒ௅ઓ͠΍͍͢ɻ Haskellͩͱهड़͕γϯϓϧͳؾ͕͢Δɻ IUUQTHJUIVCDPNFJFMIBTLFMMXFCGSBNFXPSLTBNQMF