HaskellͷWeb Application FrameworkΛࢼͯ͠ΈΔ 2015-11-07 LTۦಈ։ൃ20 

ͻΉΒ ͱ΋ͻ͜ ͦΖͦΖScalaॳ৺ऀΛଔۀ͠ͳ͚Ε͹ 

10݄ͷπΠʔτ https://twitter.com/eielh/status/654319476620464129 

10݄ͷπΠʔτ https://twitter.com/eielh/status/654319476620464129 神無月 

Haskellͷ Web Application Framework 

3強 • Yesod • Snap • Happstack IUUQTXJLJIBTLFMMPSH8FC'SBNFXPSLT 

No content

No content

No content

3強 • Yesod (wai & warp) • Snap • Happstack IUUQTXJLJIBTLFMMPSH8FC'SBNFXPSLT 

wai + warp Ͱ͍ͬͯΈΑ͏ 

IUUQRJJUBDPNFJFMIJUFNTCGDGEFFEF 

IUUQRJJUBDPNFJFMIJUFNTCGDGEFFEF waiの最小サンプルは試した 

IUUQRJJUBDPNFJFMIJUFNTFBFFFCBBE 

IUUQRJJUBDPNFJFMIJUFNTFBFFFCBBE herokuにもデプロイできた 

よーし、Web APIをつくるぞー 

wai ϕʔεͷϑϨʔϜϫʔΫ 

wai ベースのフレームワーク • scotty • Spock • yesod • MFlow 

೉қ౓ ܕܕܕʜ 4UBCJMJUZ TDPUUZ ௿ ௿ FYQFSJNFOUBM 4QPDL த த FYQFSJNFOUBM :FTPE ߴ ߴ 4UBCMF .'MPX ࢼ͞ͳ͔ͬͨ
8FC
"1*
ʹ͸޲͔ͳͦ͏ͩͬͨͷͰ 

΍ͬͯΈΑ͏ 

Web API͢Δͷʹ͍ͨ͜͠ͱ •ΤϯυϙΠϯτͷߏங •JSONͷੜ੒ •JSONͷಡऔ •HTTPϔομͷಡऔ •HTTP΁ομͷઃఆ 

લ४උ ଍͠ࢉͷͰ͖Δ७ਮͳWeb APIΛͭ͘Δ ଍͠ࢉΛ͢ΔυϝΠϯϩδοΫΛ༻ҙ 

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

࣮ߦྫ >>>> add 1 2 Result { result = 3} 

࣮ߦྫ >>>> add 1 2 Result { result = 3} Result構造体メンバのresultに3がはいってる感じ 

Ϩεϙϯε༻ͷܕ data Result = Result { result :: Integer } deriving (Generic, Show) instance ToJSON Result instance FromJSON Result 

POST ϦΫΤετ༻ͷܕ data Request = Request { x :: Integer, y :: Integer } deriving (Generic, Show) instance ToJSON Request instance FromJSON Request 

υϝΠϯϩδοΫ add :: Integer -> Integer -> Result add x y = Result $ x + y 

scottyͷ৔߹ 

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

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

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

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 

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 がつらい 

Spockͷ৔߹ 

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

$ 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}% 

$ 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 とかわりない 

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

$ 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必須に より安全になったかも 

get ("add" var var) $ \x y -> do addSampleHeader json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample 

get ("add" var var) $ \x y -> do addSampleHeader json $ add x y addSampleHeader = do headerSample <- header "X-SAMPLE" setHeader "X-SAMPLE" . fromMaybe "sample" $ headerSample パラメータ取得に文字列不要。 型変換も不要。 

Yesodͷ৔߹ 

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

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

$ 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までついてきた 

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 

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 型まで指定できるエンドポイント 黒魔術満載？ 

·ͱΊ 

·ͱΊ Yesod ͍͢͝ɻͰ΋ɺ೉͍͠ɻ scotty΍SpockͳΒ௅ઓ͠΍͍͢ɻ Haskellͩͱهड़͕γϯϓϧͳؾ͕͢Δɻ IUUQTHJUIVCDPNFJFMIBTLFMMXFCGSBNFXPSLTBNQMF