diff --git a/.git/COMMIT_EDITMSG b/.git/COMMIT_EDITMSG new file mode 100644 --- /dev/null +++ b/.git/COMMIT_EDITMSG @@ -0,0 +1,1 @@ +Version bump diff --git a/.git/FETCH_HEAD b/.git/FETCH_HEAD deleted file mode 100644 --- a/.git/FETCH_HEAD +++ /dev/null @@ -1,2 +0,0 @@ -26aa433ce02a16e4f0887189d56ca66cc0fab283 branch 'master' of github.com:hamcha/ketchup -4c2353910734c89633d869f0ffccf8f565c93221 not-for-merge branch 'gh-pages' of github.com:hamcha/ketchup diff --git a/.git/ORIG_HEAD b/.git/ORIG_HEAD deleted file mode 100644 --- a/.git/ORIG_HEAD +++ /dev/null @@ -1,1 +0,0 @@ -fcf776ea249603cba21a7e735ac877482693b3e1 diff --git a/.git/hooks/pre-rebase.sample b/.git/hooks/pre-rebase.sample --- a/.git/hooks/pre-rebase.sample +++ b/.git/hooks/pre-rebase.sample @@ -65,7 +65,7 @@ fi else not_in_next=`git rev-list --pretty=oneline ^${publish} "$topic"` - /usr/local/bin/perl -e ' + /usr/bin/perl -e ' my $topic = $ARGV[0]; my $msg = "* $topic has commits already merged to public branch:\n"; my (%not_in_next) = map { diff --git a/.git/hooks/prepare-commit-msg.sample b/.git/hooks/prepare-commit-msg.sample --- a/.git/hooks/prepare-commit-msg.sample +++ b/.git/hooks/prepare-commit-msg.sample @@ -22,10 +22,10 @@ case "$2,$3" in merge,) - /usr/local/bin/perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;; + /usr/bin/perl -i.bak -ne 's/^/# /, s/^# #/#/ if /^Conflicts/ .. /#/; print' "$1" ;; # ,|template,) -# /usr/local/bin/perl -i.bak -pe ' +# /usr/bin/perl -i.bak -pe ' # print "\n" . `git diff --cached --name-status -r` # if /^#/ && $first++ == 0' "$1" ;; diff --git a/.git/index b/.git/index Binary files a/.git/index and b/.git/index differ diff --git a/.git/logs/HEAD b/.git/logs/HEAD --- a/.git/logs/HEAD +++ b/.git/logs/HEAD @@ -1,2 +1,3 @@ -0000000000000000000000000000000000000000 fcf776ea249603cba21a7e735ac877482693b3e1 Hamcha 1424005085 +0100 clone: from git@github.com:hamcha/ketchup.git -fcf776ea249603cba21a7e735ac877482693b3e1 26aa433ce02a16e4f0887189d56ca66cc0fab283 Hamcha 1424005457 +0100 pull: Fast-forward +0000000000000000000000000000000000000000 3a1ba7b0bbe9096210dff4e72ff4336cff1064ce Hamcha 1424769202 +0100 clone: from git@github.com:hamcha/ketchup.git +3a1ba7b0bbe9096210dff4e72ff4336cff1064ce 92c5178c0ccb169a557f9faa90f9987dc11438b6 Hamcha 1424770202 +0100 commit: Linted and fixed +92c5178c0ccb169a557f9faa90f9987dc11438b6 1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 Hamcha 1424770218 +0100 commit: Version bump diff --git a/.git/logs/refs/heads/master b/.git/logs/refs/heads/master --- a/.git/logs/refs/heads/master +++ b/.git/logs/refs/heads/master @@ -1,2 +1,3 @@ -0000000000000000000000000000000000000000 fcf776ea249603cba21a7e735ac877482693b3e1 Hamcha 1424005085 +0100 clone: from git@github.com:hamcha/ketchup.git -fcf776ea249603cba21a7e735ac877482693b3e1 26aa433ce02a16e4f0887189d56ca66cc0fab283 Hamcha 1424005457 +0100 pull: Fast-forward +0000000000000000000000000000000000000000 3a1ba7b0bbe9096210dff4e72ff4336cff1064ce Hamcha 1424769202 +0100 clone: from git@github.com:hamcha/ketchup.git +3a1ba7b0bbe9096210dff4e72ff4336cff1064ce 92c5178c0ccb169a557f9faa90f9987dc11438b6 Hamcha 1424770202 +0100 commit: Linted and fixed +92c5178c0ccb169a557f9faa90f9987dc11438b6 1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 Hamcha 1424770218 +0100 commit: Version bump diff --git a/.git/logs/refs/remotes/origin/HEAD b/.git/logs/refs/remotes/origin/HEAD --- a/.git/logs/refs/remotes/origin/HEAD +++ b/.git/logs/refs/remotes/origin/HEAD @@ -1,1 +1,1 @@ -0000000000000000000000000000000000000000 fcf776ea249603cba21a7e735ac877482693b3e1 Hamcha 1424005085 +0100 clone: from git@github.com:hamcha/ketchup.git +0000000000000000000000000000000000000000 3a1ba7b0bbe9096210dff4e72ff4336cff1064ce Hamcha 1424769202 +0100 clone: from git@github.com:hamcha/ketchup.git diff --git a/.git/logs/refs/remotes/origin/master b/.git/logs/refs/remotes/origin/master --- a/.git/logs/refs/remotes/origin/master +++ b/.git/logs/refs/remotes/origin/master @@ -1,1 +1,1 @@ -fcf776ea249603cba21a7e735ac877482693b3e1 26aa433ce02a16e4f0887189d56ca66cc0fab283 Hamcha 1424005457 +0100 pull: fast-forward +3a1ba7b0bbe9096210dff4e72ff4336cff1064ce 1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 Hamcha 1424770221 +0100 update by push diff --git a/.git/objects/1f/56ef23c0106b5444dc25ad9f19c9be4e96cef8 b/.git/objects/1f/56ef23c0106b5444dc25ad9f19c9be4e96cef8 new file mode 100644 Binary files /dev/null and b/.git/objects/1f/56ef23c0106b5444dc25ad9f19c9be4e96cef8 differ diff --git a/.git/objects/26/aa433ce02a16e4f0887189d56ca66cc0fab283 b/.git/objects/26/aa433ce02a16e4f0887189d56ca66cc0fab283 deleted file mode 100644 --- a/.git/objects/26/aa433ce02a16e4f0887189d56ca66cc0fab283 +++ /dev/null @@ -1,1 +0,0 @@ -x•ÎMjÃ0@á¬uŠÙZi4Ö„’e×¹ÁX™IL¬¸XJÁ9}}…n|ðÊRëÔ1ú*Jž (!¤(šq,ɧsPdÍהԛ^åÙA‹Æ„‘r°¾ŒŒŽ£D?pI1RýèÅ~õû²Â7×rg8½§ÇöØηÊÓüQ–úŽ¬ˆ2­³Öìu_ëò/d.R—_W“YZmý³=¯Pxž›ùݙGÈ diff --git a/.git/objects/3f/019d6c6041e82845c87d8f620f5f836fe5f910 b/.git/objects/3f/019d6c6041e82845c87d8f620f5f836fe5f910 deleted file mode 100644 Binary files a/.git/objects/3f/019d6c6041e82845c87d8f620f5f836fe5f910 and /dev/null differ diff --git a/.git/objects/4a/dce353f058a268b5565349aaefe1a2419a56f2 b/.git/objects/4a/dce353f058a268b5565349aaefe1a2419a56f2 new file mode 100644 Binary files /dev/null and b/.git/objects/4a/dce353f058a268b5565349aaefe1a2419a56f2 differ diff --git a/.git/objects/50/fa42a70dbd9482c9a7c0c1a6aac8563970f108 b/.git/objects/50/fa42a70dbd9482c9a7c0c1a6aac8563970f108 new file mode 100644 Binary files /dev/null and b/.git/objects/50/fa42a70dbd9482c9a7c0c1a6aac8563970f108 differ diff --git a/.git/objects/54/0238ab17beeafc9cf736595a50f3e395b598f9 b/.git/objects/54/0238ab17beeafc9cf736595a50f3e395b598f9 deleted file mode 100644 Binary files a/.git/objects/54/0238ab17beeafc9cf736595a50f3e395b598f9 and /dev/null differ diff --git a/.git/objects/68/78b322a446ec4337878b41b3d936ec33c0d6cc b/.git/objects/68/78b322a446ec4337878b41b3d936ec33c0d6cc new file mode 100644 Binary files /dev/null and b/.git/objects/68/78b322a446ec4337878b41b3d936ec33c0d6cc differ diff --git a/.git/objects/86/e9a37eb9143efde77b690fb554c11978f44c74 b/.git/objects/86/e9a37eb9143efde77b690fb554c11978f44c74 new file mode 100644 Binary files /dev/null and b/.git/objects/86/e9a37eb9143efde77b690fb554c11978f44c74 differ diff --git a/.git/objects/92/c5178c0ccb169a557f9faa90f9987dc11438b6 b/.git/objects/92/c5178c0ccb169a557f9faa90f9987dc11438b6 new file mode 100644 --- /dev/null +++ b/.git/objects/92/c5178c0ccb169a557f9faa90f9987dc11438b6 @@ -0,0 +1,2 @@ +x•ŽK +Â0@]ç³d2ù´—.¼Ä$™ØPÓJ‰`=½½‚›·xðàÅ¥ÖҀ´;´U,§(ƙŒ®gò}pÎ;cfÉ¢™¬ØùLêÅ«Ì ëÀ]ÀdÀÁ“Æ”³•Žvãcν¢øÝÆe…×82œ¿eÚ¦íú¨\ž§¸Ô hK¶ëàˆQív_kòW¤îen’€ç¹|$©óÝC´ diff --git a/.git/objects/94/75063d562b53bde97cd1f0942a6a64301858fe b/.git/objects/94/75063d562b53bde97cd1f0942a6a64301858fe new file mode 100644 Binary files /dev/null and b/.git/objects/94/75063d562b53bde97cd1f0942a6a64301858fe differ diff --git a/.git/objects/d8/abe9cd8e6cbb5710cc48f789786c73a2a5ab83 b/.git/objects/d8/abe9cd8e6cbb5710cc48f789786c73a2a5ab83 new file mode 100644 Binary files /dev/null and b/.git/objects/d8/abe9cd8e6cbb5710cc48f789786c73a2a5ab83 differ diff --git a/.git/objects/e7/25ada9cc43e2d766778305005cc39061a3ddea b/.git/objects/e7/25ada9cc43e2d766778305005cc39061a3ddea new file mode 100644 Binary files /dev/null and b/.git/objects/e7/25ada9cc43e2d766778305005cc39061a3ddea differ diff --git a/.git/objects/e9/73b1dbbeec389cd09e15e3e2e5bf48df82b0aa b/.git/objects/e9/73b1dbbeec389cd09e15e3e2e5bf48df82b0aa deleted file mode 100644 Binary files a/.git/objects/e9/73b1dbbeec389cd09e15e3e2e5bf48df82b0aa and /dev/null differ diff --git a/.git/objects/f4/3a124452e69b4f2ef92bc8388796f2af9d88f3 b/.git/objects/f4/3a124452e69b4f2ef92bc8388796f2af9d88f3 deleted file mode 100644 Binary files a/.git/objects/f4/3a124452e69b4f2ef92bc8388796f2af9d88f3 and /dev/null differ diff --git a/.git/objects/f4/fbb9267e9f93a8f6f17cbd03c173236389eb0d b/.git/objects/f4/fbb9267e9f93a8f6f17cbd03c173236389eb0d new file mode 100644 Binary files /dev/null and b/.git/objects/f4/fbb9267e9f93a8f6f17cbd03c173236389eb0d differ diff --git a/.git/objects/fb/67a7de0eed8fc7135bd98454beb024f1ff0ca2 b/.git/objects/fb/67a7de0eed8fc7135bd98454beb024f1ff0ca2 new file mode 100644 Binary files /dev/null and b/.git/objects/fb/67a7de0eed8fc7135bd98454beb024f1ff0ca2 differ diff --git a/.git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.idx b/.git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.idx deleted file mode 100644 Binary files a/.git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.idx and /dev/null differ diff --git a/.git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.pack b/.git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.pack deleted file mode 100644 Binary files a/.git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.pack and /dev/null differ diff --git a/.git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.idx b/.git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.idx new file mode 100644 Binary files /dev/null and b/.git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.idx differ diff --git a/.git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.pack b/.git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.pack new file mode 100644 Binary files /dev/null and b/.git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.pack differ diff --git a/.git/packed-refs b/.git/packed-refs --- a/.git/packed-refs +++ b/.git/packed-refs @@ -1,3 +1,3 @@ # pack-refs with: peeled fully-peeled 4c2353910734c89633d869f0ffccf8f565c93221 refs/remotes/origin/gh-pages -fcf776ea249603cba21a7e735ac877482693b3e1 refs/remotes/origin/master +3a1ba7b0bbe9096210dff4e72ff4336cff1064ce refs/remotes/origin/master diff --git a/.git/refs/heads/master b/.git/refs/heads/master --- a/.git/refs/heads/master +++ b/.git/refs/heads/master @@ -1,1 +1,1 @@ -26aa433ce02a16e4f0887189d56ca66cc0fab283 +1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 diff --git a/.git/refs/remotes/origin/master b/.git/refs/remotes/origin/master --- a/.git/refs/remotes/origin/master +++ b/.git/refs/remotes/origin/master @@ -1,1 +1,1 @@ -26aa433ce02a16e4f0887189d56ca66cc0fab283 +1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 diff --git a/Ketchup.cabal b/Ketchup.cabal --- a/Ketchup.cabal +++ b/Ketchup.cabal @@ -1,5 +1,5 @@ Name: Ketchup -Version: 0.4.2 +Version: 0.4.3 Cabal-Version: >= 1.6 Build-Type: Simple License: MIT @@ -10,7 +10,7 @@ Category: Web, Ketchup Synopsis: A super small web framework for those who don't like big and fancy codebases Description: - Ketchup is a very small HTTP server implementation, currently under 400 LoC (for the whole thing)! + Ketchup is a very small HTTP server implementation, currently 300 LoC (for the whole thing)! . Ketchup is also made to be as modular and embeddable as possible, if you want a cabal-free Haskell app, just take those two/three files you need and put it in your project! . diff --git a/Ketchup/Auth.hs b/Ketchup/Auth.hs --- a/Ketchup/Auth.hs +++ b/Ketchup/Auth.hs @@ -16,18 +16,18 @@ -> Handler basicAuth couples realm success hnd req = case authHead of - Nothing -> fail + Nothing -> send401 Just x -> case authData `elem` couples of - False -> fail + False -> send401 True -> success hnd req where authData = parseAuth $ x !! 0 where authHead = lookup "Authorization" $ headers req authField = B.concat ["Basic realm=\"",realm,"\""] - fail = sendReply hnd 401 [("WWW-Authenticate", [authField]) - ,("Content-Type", ["text/html"])] - "

401 Unauthorized

" + send401 = sendReply hnd 401 [("WWW-Authenticate", [authField]) + ,("Content-Type", ["text/html"])] + "

401 Unauthorized

" parseAuth :: B.ByteString -> (B.ByteString, B.ByteString) parseAuth authStr = diff --git a/Ketchup/Chunked.hs b/Ketchup/Chunked.hs --- a/Ketchup/Chunked.hs +++ b/Ketchup/Chunked.hs @@ -8,7 +8,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.List as List -import Ketchup.Httpd +import Ketchup.Httpd() import Ketchup.Utils import Network import Network.Socket.ByteString diff --git a/Ketchup/Httpd.hs b/Ketchup/Httpd.hs --- a/Ketchup/Httpd.hs +++ b/Ketchup/Httpd.hs @@ -2,8 +2,8 @@ module Ketchup.Httpd ( HTTPRequest (..) -, Headers (..) -, Handler (..) +, Headers +, Handler , listenHTTP ) where @@ -40,17 +40,17 @@ getRequest :: Socket -> IO ([B.ByteString], B.ByteString) getRequest client = do content <- recv client 1024 - let (headers, body) = breakBS "\r\n\r\n" content - return (B.lines headers, body) + let (reqheaders, reqbody) = breakBS "\r\n\r\n" content + return (B.lines reqheaders, reqbody) -- Parses requests parseRequest :: ([B.ByteString], B.ByteString) -> HTTPRequest parseRequest reqlines = - HTTPRequest { method=met, uri=ur, httpver=ver, headers=heads, body=body } + HTTPRequest { method=met, uri=ur, httpver=ver, headers=heads, body=reqbody } where - [met, ur, ver] = B.words $ head headers -- First line is METHOD URI VERSION - heads = map parseRequestLine $ tail headers - (body, headers) = reqlines + [met, ur, ver] = B.words $ head reqheaders -- First line is METHOD URI VERSION + heads = map parseRequestLine $ tail reqheaders + (reqheaders, reqbody) = reqlines -- Handles each client request handleRequest :: Socket -> Handler -> IO () @@ -71,9 +71,9 @@ -- Creates Acceptor pools createAcceptorPool :: Socket -> Int -> Handler -> IO () createAcceptorPool sock 0 cback = acceptAll sock cback -createAcceptorPool sock max cback = do +createAcceptorPool sock cur cback = do forkIO (acceptAll sock cback) - createAcceptorPool sock (max-1) cback + createAcceptorPool sock (cur-1) cback -- Gets host from hostname string getHostaddr :: String -> IO NS.HostAddress diff --git a/Ketchup/Routing.hs b/Ketchup/Routing.hs --- a/Ketchup/Routing.hs +++ b/Ketchup/Routing.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Ketchup.Routing -( Route (..) +( Route , match , prefix , route @@ -22,7 +22,7 @@ -- Takes a list of routes and iterates through them for every requeust route :: [(Matcher, Route)] -- ^ Routes -> Handler -route [] handle request = sendNotFound handle +route [] handle _ = sendNotFound handle route (r:routes) handle request | isMatch = (snd r) handle request (get params) | otherwise = route routes handle request @@ -32,7 +32,7 @@ -- |Wrap a handler in a route -- Lets you use a handler (no parameters) as a route useHandler :: Handler -> Route -useHandler handler hnd req params = handler hnd req +useHandler handler hnd req _ = handler hnd req -- |Create a matchable template with parameters (:param) match :: B.ByteString -> Matcher @@ -49,8 +49,8 @@ -> (Bool, [(B.ByteString, B.ByteString)]) parse [] [] params = (True, params) parse [""] [] params = (True, params) -parse (u:url) [] params = (False, []) -parse [] (t:temp) params = (False, []) +parse _ [] _ = (False, []) +parse [] _ _ = (False, []) parse (u:url) (t:temp) params | B.length t < 1 = parse url temp params | B.length u < 1 = parse url (t:temp) params @@ -64,4 +64,4 @@ get :: Arguments -> B.ByteString -> Maybe B.ByteString get (Parameters params) x = lookup x params -get None x = Nothing +get None _ = Nothing diff --git a/Ketchup/Static.hs b/Ketchup/Static.hs --- a/Ketchup/Static.hs +++ b/Ketchup/Static.hs @@ -1,37 +1,37 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Ketchup.Static -( static -) where - -import qualified Data.ByteString.Char8 as B -import Data.Text.Encoding -import Ketchup.Httpd -import Ketchup.Utils -import Network.Mime -import System.Directory (doesFileExist) - --- |Static file handler --- Takes a directory and returns a route -static :: B.ByteString -- ^ Path to serve static files from - -> Handler -static folder hnd req = - doesFileExist strPath - >>= \exists -> - case and [sanecheck path, exists] of - False -> sendNotFound hnd - True -> B.readFile strPath - >>= sendReply hnd 200 [("Content-Type",[mime])] - where - mime = defaultMimeLookup $ decodeUtf8 fname - fname = last $ B.split '/' path - where - strPath = B.unpack path - path = B.concat [folder, uri req] - -sanecheck :: B.ByteString -> Bool -sanecheck url = - and [parentcheck] - where - parentcheck = length (filter (== "..") pieces) < 1 - pieces = B.split '/' url +{-# LANGUAGE OverloadedStrings #-} + +module Ketchup.Static +( static +) where + +import qualified Data.ByteString.Char8 as B +import Data.Text.Encoding +import Ketchup.Httpd +import Ketchup.Utils +import Network.Mime +import System.Directory (doesFileExist) + +-- |Static file handler +-- Takes a directory and returns a route +static :: B.ByteString -- ^ Path to serve static files from + -> Handler +static folder hnd req = + doesFileExist strPath + >>= \exists -> + case and [sanecheck path, exists] of + False -> sendNotFound hnd + True -> B.readFile strPath + >>= sendReply hnd 200 [("Content-Type",[mime])] + where + mime = defaultMimeLookup $ decodeUtf8 fname + fname = last $ B.split '/' path + where + strPath = B.unpack path + path = B.concat [folder, uri req] + +sanecheck :: B.ByteString -> Bool +sanecheck url = + and [parentcheck] + where + parentcheck = length (filter (== "..") pieces) < 1 + pieces = B.split '/' url diff --git a/Ketchup/Utils.hs b/Ketchup/Utils.hs --- a/Ketchup/Utils.hs +++ b/Ketchup/Utils.hs @@ -39,7 +39,7 @@ statusMsg 501 = "501 Not Implemented" statusMsg 502 = "502 Bad Gateway" statusMsg 503 = "503 Service Unavailable" -statusMsg x = "500 Internal Server Error" +statusMsg _ = "500 Internal Server Error" -- |Send 400 Bad Request error sendBadRequest :: Socket -> IO () @@ -85,7 +85,7 @@ -- |Get a substring of a ByteString subBS :: Int -> Int -> B.ByteString -> B.ByteString -subBS start length = B.take length . B.drop start +subBS start len = B.take len . B.drop start -- |Parse a URL-encoded Request parseBody :: B.ByteString -> [(B.ByteString, B.ByteString)] @@ -93,5 +93,5 @@ -- |Maybe a -> a with fallback (if Nothing) fallback :: Maybe a -> a -> a -fallback (Just x) fallback = x -fallback Nothing fallback = fallback +fallback (Just x) _ = x +fallback Nothing def = def diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Howdy, this is Ketchup! -Ketchup is a very small HTTP server implementation, currently [less than 400 LoC total](http://ix.io/dch)! +Ketchup is a very small HTTP server implementation, currently [300 LoC total](http://ix.io/gkV)! Ketchup is also made to be as modular and embeddable as possible, if you want a cabal-free Haskell app, just take those two/three files you need and put it in your project! diff --git a/gendocs.sh b/gendocs.sh --- a/gendocs.sh +++ b/gendocs.sh @@ -1,1 +1,1 @@ -haddock --html --hoogle -U -o docs Ketchup/*.hs +haddock --html --hoogle -U -o docs Ketchup/*.hs