Ketchup 0.4.2 → 0.4.3

raw patch · 42 files changed

+84/−83 lines, 42 filesbinary-added

Files

• .git/COMMIT_EDITMSG +1/−0
• .git/FETCH_HEAD +0/−2
• .git/ORIG_HEAD +0/−1
• .git/hooks/pre-rebase.sample +1/−1
• .git/hooks/prepare-commit-msg.sample +2/−2
• .git/index binary
• .git/logs/HEAD +3/−2
• .git/logs/refs/heads/master +3/−2
• .git/logs/refs/remotes/origin/HEAD +1/−1
• .git/logs/refs/remotes/origin/master +1/−1
• .git/objects/1f/56ef23c0106b5444dc25ad9f19c9be4e96cef8 binary
• .git/objects/26/aa433ce02a16e4f0887189d56ca66cc0fab283 +0/−1
• .git/objects/3f/019d6c6041e82845c87d8f620f5f836fe5f910 binary
• .git/objects/4a/dce353f058a268b5565349aaefe1a2419a56f2 binary
• .git/objects/50/fa42a70dbd9482c9a7c0c1a6aac8563970f108 binary
• .git/objects/54/0238ab17beeafc9cf736595a50f3e395b598f9 binary
• .git/objects/68/78b322a446ec4337878b41b3d936ec33c0d6cc binary
• .git/objects/86/e9a37eb9143efde77b690fb554c11978f44c74 binary
• .git/objects/92/c5178c0ccb169a557f9faa90f9987dc11438b6 +2/−0
• .git/objects/94/75063d562b53bde97cd1f0942a6a64301858fe binary
• .git/objects/d8/abe9cd8e6cbb5710cc48f789786c73a2a5ab83 binary
• .git/objects/e7/25ada9cc43e2d766778305005cc39061a3ddea binary
• .git/objects/e9/73b1dbbeec389cd09e15e3e2e5bf48df82b0aa binary
• .git/objects/f4/3a124452e69b4f2ef92bc8388796f2af9d88f3 binary
• .git/objects/f4/fbb9267e9f93a8f6f17cbd03c173236389eb0d binary
• .git/objects/fb/67a7de0eed8fc7135bd98454beb024f1ff0ca2 binary
• .git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.idx binary
• .git/objects/pack/pack-8d5add9960807749627b85586af48b5f93746c56.pack binary
• .git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.idx binary
• .git/objects/pack/pack-d6ff85d54b6030b3e478283c6ab6acff3593fb26.pack binary
• .git/packed-refs +1/−1
• .git/refs/heads/master +1/−1
• .git/refs/remotes/origin/master +1/−1
• Ketchup.cabal +2/−2
• Ketchup/Auth.hs +5/−5
• Ketchup/Chunked.hs +1/−1
• Ketchup/Httpd.hs +10/−10
• Ketchup/Routing.hs +6/−6
• Ketchup/Static.hs +37/−37
• Ketchup/Utils.hs +4/−4
• README.md +1/−1
• gendocs.sh +1/−1

@@ -0,0 +1,1 @@+Version bump

@@ -1,2 +0,0 @@-26aa433ce02a16e4f0887189d56ca66cc0fab283		branch 'master' of github.com:hamcha/ketchup-4c2353910734c89633d869f0ffccf8f565c93221	not-for-merge	branch 'gh-pages' of github.com:hamcha/ketchup

@@ -1,1 +0,0 @@-fcf776ea249603cba21a7e735ac877482693b3e1

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

@@ -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" ;; 

binary file changed (1136 → 1202 bytes)

@@ -1,2 +1,3 @@-0000000000000000000000000000000000000000 fcf776ea249603cba21a7e735ac877482693b3e1 Hamcha <zikyky@gmail.com> 1424005085 +0100	clone: from git@github.com:hamcha/ketchup.git-fcf776ea249603cba21a7e735ac877482693b3e1 26aa433ce02a16e4f0887189d56ca66cc0fab283 Hamcha <zikyky@gmail.com> 1424005457 +0100	pull: Fast-forward+0000000000000000000000000000000000000000 3a1ba7b0bbe9096210dff4e72ff4336cff1064ce Hamcha <zikyky@gmail.com> 1424769202 +0100	clone: from git@github.com:hamcha/ketchup.git+3a1ba7b0bbe9096210dff4e72ff4336cff1064ce 92c5178c0ccb169a557f9faa90f9987dc11438b6 Hamcha <zikyky@gmail.com> 1424770202 +0100	commit: Linted and fixed+92c5178c0ccb169a557f9faa90f9987dc11438b6 1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 Hamcha <zikyky@gmail.com> 1424770218 +0100	commit: Version bump

@@ -1,2 +1,3 @@-0000000000000000000000000000000000000000 fcf776ea249603cba21a7e735ac877482693b3e1 Hamcha <zikyky@gmail.com> 1424005085 +0100	clone: from git@github.com:hamcha/ketchup.git-fcf776ea249603cba21a7e735ac877482693b3e1 26aa433ce02a16e4f0887189d56ca66cc0fab283 Hamcha <zikyky@gmail.com> 1424005457 +0100	pull: Fast-forward+0000000000000000000000000000000000000000 3a1ba7b0bbe9096210dff4e72ff4336cff1064ce Hamcha <zikyky@gmail.com> 1424769202 +0100	clone: from git@github.com:hamcha/ketchup.git+3a1ba7b0bbe9096210dff4e72ff4336cff1064ce 92c5178c0ccb169a557f9faa90f9987dc11438b6 Hamcha <zikyky@gmail.com> 1424770202 +0100	commit: Linted and fixed+92c5178c0ccb169a557f9faa90f9987dc11438b6 1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 Hamcha <zikyky@gmail.com> 1424770218 +0100	commit: Version bump

@@ -1,1 +1,1 @@-0000000000000000000000000000000000000000 fcf776ea249603cba21a7e735ac877482693b3e1 Hamcha <zikyky@gmail.com> 1424005085 +0100	clone: from git@github.com:hamcha/ketchup.git+0000000000000000000000000000000000000000 3a1ba7b0bbe9096210dff4e72ff4336cff1064ce Hamcha <zikyky@gmail.com> 1424769202 +0100	clone: from git@github.com:hamcha/ketchup.git

@@ -1,1 +1,1 @@-fcf776ea249603cba21a7e735ac877482693b3e1 26aa433ce02a16e4f0887189d56ca66cc0fab283 Hamcha <zikyky@gmail.com> 1424005457 +0100	pull: fast-forward+3a1ba7b0bbe9096210dff4e72ff4336cff1064ce 1f56ef23c0106b5444dc25ad9f19c9be4e96cef8 Hamcha <zikyky@gmail.com> 1424770221 +0100	update by push

binary file changed (absent → 159 bytes)

@@ -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È

binary file changed (891 → absent bytes)

binary file changed (absent → 320 bytes)

binary file changed (absent → 616 bytes)

binary file changed (208 → absent bytes)

binary file changed (absent → 1365 bytes)

binary file changed (absent → 627 bytes)

@@ -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´

binary file changed (absent → 954 bytes)

binary file changed (absent → 320 bytes)

binary file changed (absent → 891 bytes)

binary file changed (1358 → absent bytes)

binary file changed (321 → absent bytes)

binary file changed (absent → 1347 bytes)

binary file changed (absent → 207 bytes)

binary file changed (8632 → absent bytes)

binary file changed (63400 → absent bytes)

binary file changed (absent → 8884 bytes)

binary file changed (absent → 64211 bytes)

@@ -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

@@ -1,1 +1,1 @@-26aa433ce02a16e4f0887189d56ca66cc0fab283+1f56ef23c0106b5444dc25ad9f19c9be4e96cef8

@@ -1,1 +1,1 @@-26aa433ce02a16e4f0887189d56ca66cc0fab283+1f56ef23c0106b5444dc25ad9f19c9be4e96cef8

@@ -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!
     .

@@ -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"])]
-                             "<h1>401 Unauthorized</h1>"
+    send401 = sendReply hnd 401 [("WWW-Authenticate", [authField])
+                                ,("Content-Type", ["text/html"])]
+                                "<h1>401 Unauthorized</h1>"
 
 parseAuth :: B.ByteString -> (B.ByteString, B.ByteString)
 parseAuth authStr =

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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!
 

@@ -1,1 +1,1 @@-haddock --html --hoogle -U -o docs Ketchup/*.hs+haddock --html --hoogle -U -o docs Ketchup/*.hs