diff --git a/Coltrane.hs b/Coltrane.hs new file mode 100644 --- /dev/null +++ b/Coltrane.hs @@ -0,0 +1,264 @@ +-- Coltrane, a minimal web framework. +-- Sean Welleck | Yuanfeng Peng | 2013 + +module Coltrane ( + coltrane, + get, post, put, delete, addroute, addroutes, + html, text, json, file, htmlFile, + setBody, setStatus, setHeader, addHeader, + param, request, + throwError, catchError + ) where + +import ColtraneTypes + +import qualified Data.ByteString.Lazy.Char8 as LBS hiding (putStrLn, putStr) +import qualified Data.ByteString.Char8 as BS hiding (putStrLn, putStr) +import qualified Data.Text as DT +import Data.Text.Encoding +import Text.Regex +import qualified Control.Monad.State as MS +import Control.Monad.Error + +import Network.HTTP.Types +import Network.HTTP.Types.Method +import Network.Wai +import Network.Wai.Handler.Warp as WA +import Network.Wai.Handler.CGI as CG +import Network.Wai.Parse + +import Data.Either (partitionEithers) +import qualified Data.Text.IO as DTIO (readFile) + +-- | creates a response with an error message and the +-- status set to 500. +error500 :: String -> HandlerM () +error500 msg = do text msg + setStatus status500 + return () + +-- | the base ResponseState used when execState is called +defaultRS :: ResponseState +defaultRS = RS "" [] status200 + +-- | creates a WAI Response using a ResponseState +renderResponse :: ResponseState -> Response +renderResponse (RS b h s) = responseLBS s h (LBS.pack b) + +-- | shorthand for unpeeling the HandlerState from the monad +-- if an exception occurs, return an error response with the message +runHandlerM :: HandlerM () -> Params -> Request -> IO HandlerState +runHandlerM rm ps req = MS.execStateT (runErrorT (runHM (rm `catchError` error500))) + (HS defaultRS ps req) + + +-- | run a route's handler on a request +runHandler :: Route -> Params -> Request -> IO ResponseState +runHandler r ps req = do + hs <- runHandlerM (handler r) ps req + return $ resp hs + +-- | The router is a piece of Middleware, which is just a +-- function (Application -> Application). Middleware is defined by WAI. +-- The router is 'chained' together with another Application +-- (here called innerApp); the router tries to route a request +-- using one of the routes in the input list, and if no route succeeds, +-- it runs the innerApp, which corresponds to a 404 Not Found. +router :: [Route] -> Middleware +router rs innerApp req = do + r <- route rs req + case r of + Nothing -> innerApp req + Just rstate -> return $ renderResponse rstate + +-- | Does the actual routing by matching an incoming request's HTTP +-- method and path with one of the routes. if a match is found, +-- the route's handler is run, resulting in a ResponseState. +-- returns Nothing if no matches exist. +route :: [Route] -> Request -> IO (Maybe ResponseState) +route [] _ = return Nothing +route (r:rs) req = + if methodMatches r req then + case path r of + Literal l -> + case matchesPath (trim $ splitPath l) (trim $ pathInfo req) of + Just ps -> addPostParams ps r req + Nothing -> route rs req + RegExp re -> + case matchRegex re (dropQueryString req) of + Just strs -> addPostParams (putRegexParams strs) r req + Nothing -> route rs req + else + route rs req + +dropQueryString :: Request -> String +dropQueryString req = + let sr = rawPathInfo req + (sh:ss) = BS.split '?' $ rawPathInfo req + in + if BS.null sh then BS.unpack sr else BS.unpack sh + +addPostParams :: Params -> Route -> Request -> IO (Maybe ResponseState) +addPostParams ps r req = do + (ps',_) <- MS.liftIO $ parseRequestBody lbsBackEnd req + rs <- runHandler r (ps ++ convertBSParams ps') req + return $ Just rs + +splitPath :: String -> [DT.Text] +splitPath s = DT.split (=='/') (DT.pack s) + +-- | Removes the empties. +trim :: [DT.Text] -> [DT.Text] +trim = filter (not . DT.null) + +methodMatches :: Route -> Request -> Bool +methodMatches route req = renderStdMethod (method route)==requestMethod req + +putRegexParams :: [String] -> Params +putRegexParams strs = aux 1 strs where + aux n [] = [] + aux n (s:ss) = ("r" ++ (show n), s) : (aux (n + 1 ) ss) + + +-- | Matches the path info specified in a route with the path info +-- in the request +matchesPath :: [DT.Text] -> [DT.Text] -> Maybe Params +matchesPath ((r1:rs1)) ((r2:rs2)) = + case DT.unpack r1 of + x:_ -> if isWildcard x then + combine (Just [(DT.unpack r1, DT.unpack r2)]) matchesRemaining + else + strictlyMatches + _ -> strictlyMatches + where + isWildcard = (==':') + matchesRemaining = matchesPath (rs1) (rs2) + combine = liftM2 (++) + strictlyMatches = if r1==r2 then matchesRemaining else Nothing + +matchesPath r1 r2 = if trim r1 ==trim r2 then Just [] else Nothing + +-- this is 'chained' after the Middleware router in the +-- main function; thus this runs if the router doesn't find a match +defaultApp :: Application +defaultApp req = return $ renderResponse + (RS "404 : Page not Found." [] status404) + +-- | Helper method for adding a GET route. +get :: Path -> Handler -> ColtraneApp () +get p h = addroute $ Route GET p h + +-- | Helper method for adding a POST route. +post :: Path -> Handler -> ColtraneApp () +post p h = addroute $ Route POST p h + +-- | Helper method for adding a PUT route. +put :: Path -> Handler -> ColtraneApp () +put p h = addroute $ Route PUT p h + +-- | Helper method for adding a DELETE route. +delete :: Path -> Handler -> ColtraneApp () +delete p h = addroute $ Route DELETE p h + +-- | Add a route to the app's state. +addroute :: Route -> ColtraneApp () +addroute r = do rs <- MS.get + MS.put (r:rs) + return () + +-- | Add multiple routes to the app's state. +addroutes :: [Route] -> ColtraneApp () +addroutes rs = do + st <- MS.get + MS.put (rs ++ st) + return () + +-- | Sets body and content type for HTML. +html :: ResponseBody -> HandlerM () +html = setBody ctHTML + +-- | Sets body and content type for Text. +text :: ResponseBody -> HandlerM () +text = setBody ctText + +-- | Sets body and content type for JSON. +json :: ResponseBody -> HandlerM () +json = setBody ctJSON + +-- | Sets body and content type for File. +file :: ResponseBody -> HandlerM () +file = setBody ctFile + +-- | Reads a file in as a String. +htmlFile :: FilePath -> IO String +htmlFile fp = do h <- (DTIO.readFile fp) + return (DT.unpack h) + +-- | Set the current ResponseState's body, and add the +-- corresponding content type header +setBody :: ContentType -> ResponseBody -> HandlerM () +setBody ct rb = do setHeader hContentType ct + (HS (RS _ hs s) pm r) <- MS.get + MS.put $ (HS (RS rb hs s) pm r) + return () + +-- | Set the current ResponseState's status +setStatus :: Status -> HandlerM () +setStatus s = do (HS (RS b h _) pm r) <- MS.get + MS.put $ (HS (RS b h s) pm r) + return () + +-- | Lookup a header and set its value to the input string. +-- if the header does not exist, adds a new header. +setHeader :: HeaderName -> BS.ByteString -> HandlerM () +setHeader hname hval = do + (HS (RS b hs s) pm r) <- MS.get + case lookup hname hs of + -- if the header exists, replace its value + Just val -> MS.put $ HS (RS b (replace hname hval hs) s) pm r + -- otherwise, add a new header + Nothing -> addHeader hname hval + +replace :: Eq a => a -> b -> [(a,b)] -> [(a,b)] +replace a b ((a', b'):ps) | a == a' = (a, b):ps + | otherwise = (a, b) : replace a b ps + +-- | Add a header to the current ResponseState's headers +-- HeaderName defined in Network.HTTP.Types.Header +addHeader :: HeaderName -> BS.ByteString -> HandlerM () +addHeader hname hval = do (HS (RS b hs s) pm r) <- MS.get + MS.put $ HS (RS b ((hname, hval):hs) s) pm r + return () + +-- retrieve a field from the querystring in the request +field :: String -> HandlerM String +field key = do HS _ _ req <- MS.get + case lookup (BS.pack key) (queryString req) of + Just (Just val) -> return $ BS.unpack val + _ -> throwError $ msg + where msg = "Error: Param " ++ key ++ " not found." + +-- | Retrieve a parameter parsed from the URL. if not found, +-- search through the query fields. +param :: String -> HandlerM String +param key = do HS _ ps req <- MS.get + case lookup key ps of + Just val -> return val + Nothing -> do val' <- field key + return val' + where msg = "Error: Param " ++ key ++ " not found." + +-- | Retrieve the current request object +request :: HandlerM Request +request = do HS _ _ req <- MS.get + return req + +-- | Run the framework with the given server on the given port and application +coltrane :: Server -> Port -> ColtraneApp () -> IO () +coltrane s port capp = do + putStrLn "== Coltrane has taken the stage .." + putStr $ ">> playing on port " ++ (show port) + rs <- MS.execStateT (runCA capp) [] + case s of + Warp -> WA.run port (router rs defaultApp) + CGI -> CG.run (router rs defaultApp) diff --git a/ColtraneTests.hs b/ColtraneTests.hs new file mode 100644 --- /dev/null +++ b/ColtraneTests.hs @@ -0,0 +1,268 @@ +{- ColtraneTests.hs + +Sean Welleck | Yuanfeng Peng | 2013 + +Contains tests, and examples of usage. + +An application used for testing (testApp) is created +below, with various routes. Uses HUnit to run the test cases. + +A test case consists of making a request made to one of testApp's routes, +and checking the response contents. The requests are made using +the Network.HTTP library. + +In order to run the tests, the testApp must be running. +Run the main function to start the testApp. Then, +run the runTests function to run the tests. + +testApp2 defines various routes and handlers that are equivalent +to those defined by testApp, but with different syntax. +-} + +{-# LANGUAGE OverloadedStrings #-} + +import Coltrane +import ColtraneTypes +import Test.HUnit hiding (Path, State, path) +import Network.HTTP.Types hiding (Header) +import Network.HTTP hiding (GET, POST, PUT, DELETE, HeaderName) +import qualified Control.Monad.State as MS +import qualified Data.ByteString.Char8 as BS hiding (putStrLn) +import Network.Wai.Parse +import Network.Stream +import Text.Regex +import Network.Wai hiding (Response) + +-- appends a path to the base url +make_url :: String -> String +make_url path = "http://localhost:9000/" ++ path + +-- sends a GET or POST request to the given URL +-- returns the response and the response body +make_request :: StdMethod -> String -> IO (Result (Response String)) +make_request GET url = simpleHTTP $ getRequest url +make_request POST url = let (u:qs)= BS.split '?' (BS.pack url) in + case qs of + x:_ -> simpleHTTP $ postRequestWithBody (BS.unpack u) "application/x-www-form-urlencoded" (BS.unpack x) + _ -> simpleHTTP $ postRequest url +make_request _ _ = error "Unsupported request method." + +-- make a request and return the response's body and code +response_data :: StdMethod -> String -> IO (String, ResponseCode) +response_data m url = do resp <- make_request m url + body <- getResponseBody resp + code <- getResponseCode resp + return (body, code) + +response_all :: StdMethod -> String -> IO (String) +response_all m url = do resp <- make_request m url + case resp of + Right r -> return $ show r + Left r -> return $ show r + + +-- test whether a request to the given path returns +-- the expected body and code +test_response :: (StdMethod ,String ,(String, ResponseCode)) -> IO Test +test_response (m ,path, expected) = do + actual <- response_data m (make_url path) + return $ "request body " ++ path ~: expected ~=? actual + +-- check whether the response contains the header +test_header :: (StdMethod, String, BS.ByteString) -> IO Test +test_header (m, path, expected) = do + headers <- response_all m (make_url path) + putStrLn headers + return $ "response header " ++ path ~: (BS.isInfixOf expected (BS.pack headers)) ~=? True + +-- a test case is a 3-tuple containing: +-- HTTP method +-- path +-- expected output, as a pair: +-- (expected ResponseBody, expected ResponseCode) +testCases = [ (POST, "post?name=John+Coltrane&famous=true", (show testPostParams1, (2,0,0))), + (POST, "regex/upenn?dpt=cis", (show testPostParams2,(2,0,0))), + (POST, "regex/upenn/seas?dpt=cis", (show testPostParams3,(2,0,0))), + (POST, "regex/upenn/1seas?dpt=cis", ("404 : Page not Found.",(4,0,4))), + (GET, "hello", ("Hello World!", (2,0,0))), + (GET, "fj92i", ("404 : Page not Found.", (4,0,4))), + (GET, "raise" , ("An error has occurred!", (5,0,0))), + (GET, "status", ("Status Change", (2,0,3))), + (GET, "status2", ("Status Change", (2,0,0))), + (GET, "param/John/Coltrane", ("Hi John Coltrane!", (2,0,0))), + (GET, "paramErr/John", ("Error: Param :name not found.", (5,0,0))), + (GET, "regex/1234", ("'{'r1': '/1234'}'",(2,0,0))), + (POST, "post/employee/company/august/sth", (show testPostParams4,(2,0,0))), + (POST, "post/employee/company/august", ("404 : Page not Found.", (4,0,4)) ), + (POST, "post", ("[]", (2,0,0))), + (GET, "catchErr", ("Caught the error.", (2,0,0))), + (GET, "field?album=Soultrane", ("Soultrane", (2,0,0))), + (GET, "", ("

Giant Steps

", (2,0,0))), + (GET, "/", ("

Giant Steps

", (2,0,0)))] + +testHeaderCases = [(GET, "hello", "Content-Type: text/html"), + (GET ,"header1", "Cookie: cookie") + ] + +-- run all of the tests +runTests :: IO Counts +runTests = do ts <- sequence (map test_response testCases) + tsh <- sequence (map test_header testHeaderCases) + runTestTT $ TestList (ts ++ tsh) + +testApp :: ColtraneApp () +testApp = do post (Literal "post") postHandler + post (RegExp wordRegex) postHandler + get (Literal "hello") helloHandler + get (Literal "raise") raiseHandler + get (Literal "status") statusHandler + get (Literal "status2") status2Handler + get (Literal "param/:first/:last") paramHandler + get (Literal "paramErr/:first") paramErrHandler + get (RegExp numericalRegex ) regexHandler + post (Literal "post/:arg1/:arg2/:arg3/sth") showParams + get (Literal "catchErr") catchErrHandler + get (Literal "field") fieldHandler + get (Literal "") rootHandler + get (Literal "file") fileHandler + get (Literal "/header1") addHeaderTest + get (Literal "/htmlFile") htmlFileHandler + +helloHandler :: Handler +helloHandler = html "Hello World!" + +raiseHandler :: Handler +raiseHandler = throwError "An error has occurred!" + +statusHandler :: Handler +statusHandler = do setStatus status203 + text "Status Change" + +status2Handler :: Handler +status2Handler = do setStatus status203 + setStatus status404 + setStatus status200 + text "Status Change" + +rootHandler :: Handler +rootHandler = html "

Giant Steps

" + +postHandler :: Handler +postHandler = showParams + +htmlFileHandler :: Handler +htmlFileHandler = do h <- MS.liftIO $ htmlFile "extra/index.html" + html h + +testPostParams4 ::Params +testPostParams4 = [(":arg1","employee"),(":arg2","company"),(":arg3","august")] + +testPostParams1 :: Params +testPostParams1 =[("name","John Coltrane"),("famous","true")] + +testPostParams2 :: Params +testPostParams2 =[("r1","/upenn"),("dpt","cis")] + +testPostParams3 :: Params +testPostParams3 = [("r1","/seas"),("dpt","cis")] + +paramHandler :: Handler +paramHandler = do fname <- param ":first" + lname <- param ":last" + text $ "Hi " ++ fname ++ " " ++ lname ++ "!" + +-- the param's name is actually ":first", so an exception is thrown +paramErrHandler :: Handler +paramErrHandler = do name <- param ":name" + text $ "Hi " ++ name ++ "!" + +-- attempts to get a non-existent parameter, but catches the error +catchErrHandler :: Handler +catchErrHandler = do (do name <- param ":name" + text $ "Hi " ++ name ++ "!") + `catchError` + (\err -> text "Caught the error.") + +fieldHandler :: Handler +fieldHandler = do album <- param "album" + html album + +addHeaderTest :: Handler +addHeaderTest = do addHeader hCookie "cookie" + html "" + +regexHandler :: Handler +regexHandler = do s <- param "r1" + json $ "'{'r1': '" ++s ++ "'}'" + +fileHandler :: Handler +fileHandler = file "extra/index.html" + +--some common regular expressions for testing regex-matching functionality +numericalRegex ::Regex +numericalRegex = mkRegex "^/regex(/[0-9]+)+$" + +wordRegex :: Regex +wordRegex = mkRegex "^/regex(/[a-z]+)+$" + +--some simple handlers facilitating debugging +showParams :: Handler +showParams = do + hs <- MS.get + html $ show (pms hs) + +showRawPathInfo :: Handler +showRawPathInfo = do + req <- request + html (BS.unpack $ rawPathInfo req) + +showPathInfo :: Handler +showPathInfo = do + req <- request + html (show $ pathInfo req) + +showParsedRequestBody :: Handler +showParsedRequestBody = do + req <- request + rb <- MS.liftIO $ parseRequestBody lbsBackEnd req + html (show rb) + +-- equivalent to testApp, showing an alternative syntax +testApp2 :: ColtraneApp () +testApp2 = do + get (Literal "/") $ do + html "

Giant Steps

" + + get (Literal "hello") $ do + text "Hello World!" + + get (Literal "raise") $ do + throwError "An error has occurred!" + + get (Literal "status") $ do + setStatus status203 + text "Status Change" + + post (Literal "post") $ do + text "Post Handler" + + get (Literal "file") $ do + file "extra/index.html" + + get (Literal "param/:first/:last") $ do + fname <- param ":first" + lname <- param ":last" + text $ "Hi " ++ fname ++ " " ++ lname ++ "!" + + get (Literal "paramErr/:first") $ do + name <- param ":name" + text $ "Hi " ++ name ++ "!" + + get (Literal "catchErr") $ do + (do name <- param ":name" + text $ "Hi " ++ name ++ "!") + `catchError` + (\err -> text "Caught the error.") + +main :: IO () +main = coltrane Warp 9000 testApp diff --git a/ColtraneTypes.hs b/ColtraneTypes.hs new file mode 100644 --- /dev/null +++ b/ColtraneTypes.hs @@ -0,0 +1,96 @@ +{- ColtraneTypes.hs + +Sean Welleck | Yuanfeng Peng | 2013 + +Defines the types used by Coltrane. +-} + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module ColtraneTypes where + +import Text.Regex as TR +import qualified Data.Text as DT +import qualified Data.ByteString.Char8 as BS hiding (putStrLn) +import Network.HTTP.Types +import Network.HTTP.Types.Method +import Network.Wai +import qualified Network.Wai.Parse as Parse +import Control.Monad.Error +import qualified Control.Monad.State as MS + +-- | a Route is composed of: +-- +-- * a method (uses the StdMethod type from Network.HTTP.Types.Method) +-- +-- * a path (defined below) +-- +-- * a handler (defined below) +data Route = Route { + method :: StdMethod, + path :: Path, + handler :: Handler +} + +-- | A ResponseState holds a body, headers, and a status. When used +-- with MonadState, this type makes it easy to add headers and change +-- the response status; WAI does not provide simple mechanisms for +-- modifying the headers and status. +data ResponseState = RS { + body :: ResponseBody, + headers :: [Header], + status :: Status +} + +rsPlus :: ResponseState -> ResponseState -> ResponseState +rsPlus r1 r2 = RS (body r1 ++ body r2) (headers r1 ++ headers r2) (status r2) + +-- | The HandlerState contains the parameters, the request object, and +-- the response state. +data HandlerState = HS { + resp :: ResponseState, + pms :: Params, + req :: Request +} + +-- | Server options for running the application. +data Server = Warp | CGI + deriving (Show) + +-- | Stores the content-type constants for the response headers. +type ContentType = BS.ByteString +ctHTML = BS.pack "text/html" +ctText = BS.pack "text/plain" +ctJSON = BS.pack "application/json" +ctFile = BS.pack "application/octet-stream" + +-- | A ResponseBody is a string. +type ResponseBody = String + +-- | A path is either a String Literal or a Regular Expression. +data Path = Literal String | RegExp Regex + +type ParamKey = String +type ParamValue = String +-- | Key value pairs of URL parameters. +type Params = [(ParamKey, ParamValue)] + +-- | Converts [Parse.Param] to Params. +convertBSParams :: [Parse.Param] -> Params +convertBSParams ps = map unpack ps where + unpack (a, b) = (BS.unpack a, BS.unpack b) + +-- | A type alias to make routes intuitive for the user. +type Handler = HandlerM () + +-- | A monad that holds the application's registered routes. +newtype ColtraneApp a = C { runCA :: MS.StateT [Route] IO a } + deriving (Monad, MS.MonadState [Route]) + +-- | Stores the current parameters, Request, and the +-- ResponseState that gets 'built up' in a Handler; the response body, +-- headers, and status may be altered. The HandlerM also has +-- error handling capabilities. The Handler is the third component of a Route; +-- a Method and a Path are associated with a Handler. +newtype HandlerM a = HM { runHM :: ErrorT String (MS.StateT HandlerState IO) a } + deriving (Monad, MS.MonadState HandlerState, MonadError String, MonadIO) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Sean Welleck + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sean Welleck nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,246 @@ +#Coltrane + +####A Minimal Web Framework for Haskell + + +**Sean Welleck | Yuanfeng Peng** + +Coltrane is a minimal web framework for Haskell, inspired by +Ruby's [Sinatra](https://github.com/sinatra/sinatra/) framework. Coltrane lets you write simple +web applications in just a few lines of Haskell code. + +**Use Coltrane for concise webapps...** +```haskell +import Coltrane +import ColtraneTypes + +main = coltrane Warp 8000 $ do + get (Literal "/hello") $ do + html "Hello World!" +``` +**... and all that jazz.** +``` +$ main +$ == Coltrane has taken the stage .. +$ >> playing on port 8000 +``` + +Coltrane was built as a final project for CIS552: Advanced Programming, +and is now open-sourced! + +##Routes +A route consists of a method, a path, and a handler. A path can be: +- string literal +```haskell +get (Literal "/album") $ do + text "A Love Supreme" +``` + +- regular expression +```haskell +get (RegExp mkRegex "^(/[0-9]+)") $ do + text "I like numbers." +``` + +##Path variables +You can create variables in your paths, which can be accessed +using the `param` function: +```haskell +-- e.g. handles a request to /jazz +get (Literal "/:item") $ do + item <- param ":item" + html "My favorite thing is: " ++ item + +-- e.g. handles a request to /miles/davis +get (Literal "/:first/:last") $ do + fname <- param ":first" + lname <- param ":last" + html "John Coltrane, featuring " ++ fname ++ " " ++ lname +``` + +##GET and POST parameters +You can also access parameters from GET and POST requests using the +`param` function. +```haskell +-- e.g. handles a GET request to /submit?venue=village +get (Literal "/submit") $ do + venue <- param "venue" + html "Live at " ++ venue ++ "." + +-- e.g. handles a POST request to /submit with venue=village as a parameter +post (Literal "/submit") $ do + venue <- param "venue" + html "Live at " ++ venue ++ "." +``` + +##HTTP Methods +Coltrane provides helper functions for `get`, `post`, `put`, `delete`. + + +##Content Type Helpers +Coltrane provides helper functions for `text`, `html`, `json`, `file`. + +##HTML Files +Use `htmlFile` to load HTML from a file: +```haskell +get (Literal "/index") $ do + htmlFile "index.html" +``` + +##Exceptions +Catch errors with `catchError` and throw exceptions with `throwError`: +```haskell +put (Literal "/trouble") $ do + (throwError "catch me") + `catchError` + (\err -> text $ err ++ " if you can.") + +``` + +##Accessing the Request Data +Access the WAI Request object with `request`: +```haskell +get (Literal "/showpath") $ do + req <- request + html (show $ pathInfo req) +``` +##Modifying the Response +Change the response status code with `setStatus`: + +```haskell +get (Literal "/changestatus") $ do + setStatus status203 + text "Changed on a Moment's Notice" +``` +Add an HTTP header with `addHeader`: +```haskell +get (Literal "/addcookie") $ do + addHeader hCookie "ascension" + html "Headers up" +``` + +Alternatively, `setHeader` modifies an existing header's value, or adds a new header if it doesn't exist. + +---- +##Files +####ColtraneTypes.hs +This file contains the types used in the library. Reading through these +types first will help to understand the structure of the framework. + +Notable types include: +1. ColtraneApp: a monad that stores the application's state. Specifically, + it stores the user-specified routes that are then used by the router. + +2. Route: a method, path, and Handler. + +2. HandlerM: A monad for processing a request and building a response. + Stores information that is used and modified within a route handler, and + is able to throw and catch errors. + Specifically, contains the request, the parameters, and the response state. + Intuitively, a Handler consists of 'building' a response state that is then + turned into a response and sent to the server. + +4. HandlerState: describes the state held by the HandlerM. + +####Coltrane.hs +This file contains the core functionality of the framework. It contains: +1. Which functions are visible to the user. + +2. The router, which matches a registered route with an incoming request, + and runs the corresponding handler. + + Functions: router, route + +3. The matcher, which is used by the router to perform the actual route + matching. Matches literal strings, regular expressions, and + parses url variables. + + Functions: matchesPath + +4. Routing functions. Associates a Path and a Handler to create a route, + which is added to the ColtraneApp state. + + Functions: addroute, addroutes, get, post, put, delete + +5. Response modifiers. Changes the response state within a handler. Specifically, changes the headers, the body, and the status. + + Functions: setBody, setStatus, setHeader, addHeader. + +6. Request retrieval. Retrieve parameters and the request object. + + Functions: param, request. + +####ColtraneTests.hs +Contains all of the tests, as well as examples of how to use the framework. +In order to run the tests, the server must be running, so do the following: + +Install Dependencies: +```bash + $ cabal install warp==2.0.0.1 + $ cabal install wai-extra==2.0.0.1 + $ cabal install wai==2.0.0 +``` +GHCI one (running the server) +```bash + $ :load ColtraneTests + $ main +``` + +GHCI two (running the tests) +```bash + $ :load ColtraneTests + $ runTests +``` + +Note that the server is running on port 9000, so you can navigate to pages in the browser, e.g.: +- http://localhost:9000 +- http://localhost:9000/hello +- http://localhost:9000/param/firstname/lastname (replace firstname and lastname as desired) + +###Extra Files +####website.hs +A sample web app built using Coltrane and the Blaze HTML library. Hopefully +it's an example of how easy and concise it is to build a web app using the framework! + +To run in ghci: + +**Install Dependencies** +```bash +$ cabal install warp==2.0.0.1 +$ cabal install wai-extra==2.0.0.1 +$ cabal install wai==2.0.0 +$ cabal install blaze-html==0.6.1.1 +``` +**Run It** +``` +$ :load website.hs. +$ main +``` + Then navigate to http://localhost:8000 in a web browser. + +--- +##Libraries Used & Dependencies +**wai**: A Middleware library that provides a common interface between Coltrane and the underlying web servers. + http://hackage.haskell.org/package/wai + + cabal install wai==2.0.0 + +**wai-extra**: Provides additional tools for use with wai. We use it to parse +parameters from a Request body. + http://hackage.haskell.org/package/wai-extra + + cabal install wai-extra==2.0.0.1 + +**warp**: a haskell web server used by WAI. + + cabal install warp==2.0.0.1 + +**Network.HTTP**: A simple HTTP interface. Also contains some common types used +in web-related libraries, such as StdMethod, and HeaderName. We also use +this library to generate requests and responses for testing. + +**blaze-html** (** only used by the sample website.hs **): An HTML combinator +library that allows you to quickly write HTML within Haskell code. +``` +cabal install blaze-html +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/coltrane.cabal b/coltrane.cabal new file mode 100644 --- /dev/null +++ b/coltrane.cabal @@ -0,0 +1,29 @@ +-- Initial coltrane.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: coltrane +version: 0.1.0.0 +synopsis: A jazzy, minimal web framework for Haskell, inspired by Sinatra. +description: Coltrane is a minimal web framework for Haskell, inspired by Ruby's Sinatra framework. Coltrane lets you write simple web applications in just a few lines of Haskell code. +homepage: https://github.com/wellecks/coltrane +license: BSD3 +license-file: LICENSE +author: Sean Welleck +maintainer: Sean Welleck +copyright: (c) 2013 Sean Welleck +category: Web +build-type: Simple +cabal-version: >=1.8 + +Extra-source-files: + README.md + extra/website.hs + ColtraneTests.hs + +library + exposed-modules: Coltrane, ColtraneTypes + build-depends: base ==4.6.*, bytestring ==0.10.*, text ==0.11.*, regex-compat ==0.95.*, mtl ==2.1.*, http-types ==0.8.*, wai ==2.0.*, warp ==2.0.*, wai-extra ==2.0.*, HUnit ==1.2.*, HTTP ==4000.2.* + +source-repository head + type: git + location: https://github.com/wellecks/coltrane.git diff --git a/extra/website.hs b/extra/website.hs new file mode 100644 --- /dev/null +++ b/extra/website.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Coltrane +import ColtraneTypes +import Text.Blaze.Html.Renderer.String +import Text.Blaze.Html5 as H hiding (html, param) +import Text.Blaze.Html5.Attributes as A + +main :: IO () +main = coltrane Warp 8000 app + +app :: ColtraneApp () +app = do + get (Literal "/") $ do + html $ renderHtml home + + get (Literal "form") $ do + html $ renderHtml msgform + + get (Literal "thanks") $ do + msg <- param "msg" + html $ renderHtml (msgresp msg) + +-- uses the Blaze HTML combinator library to define the HTML +home :: Html +home = docTypeHtml $ do + H.head $ do + H.title "Coltrane" + H.body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do + h1 $ img ! src "http://i.imgur.com/7YEidGn.jpg" >> "Coltrane" + h4 "a minimal web framework for Haskell" + h3 "Sean Welleck | Yuanfeng Peng" + p $ do + "Coltrane lets you write simple web apps quickly and easily." >> br + br >> code "main :: IO ()" + br >> code "main = coltrane Warp 8000 $ do" >> br + code20 $ "get (Literal \"/\") $ html \"Hello World!\"" + br >> br + p $ do + strong "URL parameters" >> br + code20 $ "get (Literal \"/:name\") $ do" >> br + code40 $ "name <- param \":name\"" >> br + code40 $ "html \"Hello \" ++ name ++ \"!\"" + br >> br + p $ do + strong "Regular Expression routes" >> br + code20 $ "post (RegExp mkRegex \"^(/[0-9]+)\") $ do" >> br + code40 $ "text \"I like numbers.\"" + br >> br + p $ do + strong "Error handling" >> br + code20 $ "put (Literal \"/trouble\") $ do" >> br + code40 $ "(throwError \"catch me\")" >> br + code40 $ "`catchError`" >> br + code40 $ "(\\err -> text $ err ++ \" if you can.\")" + br >> br + p $ do + strong "And all that jazz" >> br + code20 $ "$ main" >> br + code20 $ "$ == Coltrane has taken the stage .." >> br + code20 $ "$ >> playing on port 8000" >> br + br >> br >> br + a ! href "/form" $ "leave a message" + where code20 = code ! A.style ("margin-left:20px;") + code40 = code ! A.style ("margin-left:40px;") + +msgform :: Html +msgform = docTypeHtml $ do + H.head $ do + H.title "Coltrane" + H.body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do + h1 $ img ! src "http://i.imgur.com/7YEidGn.jpg" >> "Coltrane" + h4 "write a message" + H.form ! A.method "get" ! A.action "/thanks" $ do + input ! A.name "msg" + input ! A.type_ "submit" + +msgresp :: String -> Html +msgresp msg = docTypeHtml $ do + H.head $ do + H.title "Coltrane" + H.body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do + h1 $ img ! src "http://i.imgur.com/7YEidGn.jpg" >> "Coltrane" + h4 $ "Thanks for writing " >> toHtml msg + a ! href "/" $ "go back"