small refacto

src/Main.hs

@@ -3,8 +3,8 @@ module Main where
 
 -- import           Data.Conduit
 import           Network.HTTP.Conduit
-import           Network.HTTP.Types.Header (Header)
-import           Network.HTTP.Types.Status (statusIsSuccessful)
+import           Network.HTTP.Types.Header (Header,RequestHeaders)
+import           Network.HTTP.Types.Status (statusIsSuccessful,notModified304)
 import qualified Data.ByteString.Lazy.Char8 as LZ
 import qualified Data.ByteString.Char8 as B
 import Data.CaseInsensitive (original)
@@ -17,23 +17,26 @@ import Data.Time.Clock.POSIX (getPOSIXTime,utcTimeToPOSIXSeconds)
 import System.Locale (defaultTimeLocale)
 import System.CPUTime (getCPUTime)
 
-simpleHTTPWithUserAgent :: String -> String -> String -> IO (Response LZ.ByteString)
-simpleHTTPWithUserAgent url user pass = do
+httpCall :: String -> RequestHeaders -> IO (Response LZ.ByteString)
+httpCall url headers = do
     r <- parseUrl url
-    let request = r {requestHeaders = [("User-Agent","HTTP-Conduit")]}
+    let request = r { requestHeaders = headers }
+    withManager (httpLbs request)
+
+authHttpCall :: String -> String -> String -> RequestHeaders -> IO (Response LZ.ByteString)
+authHttpCall url user pass headers = do
+    r <- parseUrl url
+    let request = r {requestHeaders = headers }
         requestWithAuth = applyBasicAuth (B.pack user) (B.pack pass) request
     withManager (httpLbs requestWithAuth)
 
-simpleHTTPWithUserAgentETag :: String -> String -> String -> Maybe B.ByteString -> IO (Response LZ.ByteString)
-simpleHTTPWithUserAgentETag url user pass etag = do
-    r <- parseUrl url
-    let request = r {requestHeaders = ("User-Agent","HTTP-Conduit"):
-                                      maybe [] (\e -> [("If-None-Match",B.tail (B.tail e))]) etag}
-        requestWithAuth = applyBasicAuth (B.pack user) (B.pack pass) request
-    withManager (httpLbs requestWithAuth)
+httpGHEvents :: String -> String -> Maybe B.ByteString -> IO (Response LZ.ByteString)
+httpGHEvents user pass etag = authHttpCall  "https://api.github.com/events" user pass headers
+      where
+          headers = ("User-Agent","HTTP-Conduit"):maybe [] (\e -> [("If-None-Match",B.tail (B.tail e))]) etag
 
 showHeader :: Header -> IO ()
-showHeader (name, value) = B.putStrLn $ original name <> ": " <> value
+showHeader (name, value) = B.putStrLn (original name <> ": " <> value)
 
 showHelpAndExit :: IO ()
 showHelpAndExit = do
@@ -44,7 +47,7 @@ main :: IO ()
 main = do
     args <- getArgs
     case args of
-         [user,pass] -> getEvents user pass Nothing
+         [user,pass] -> getEvents user pass Nothing 100000
          _ -> showHelpAndExit
 
 rfc822DateFormat :: String
@@ -60,33 +63,49 @@ time action = do
     endTime <- getCPUTime
     return (fromIntegral (endTime - startTime)/(10**12),res)
 
-getEvents :: String             -- ^ Github username
-          -> String             -- ^ Github password
-          -> Maybe B.ByteString -- ^ ETag
-          -> IO ()
-getEvents user pass etag = do
-    (req_time, response) <- time $ simpleHTTPWithUserAgentETag "https://api.github.com/events" user pass etag
+getTimeAndEtagFromResponse :: Int
+                           -> Maybe B.ByteString
+                           -> Response LZ.ByteString
+                           -> Double
+                           -> IO (Int, Maybe B.ByteString)
+getTimeAndEtagFromResponse oldTime etag response req_time =
     if statusIsSuccessful (responseStatus response)
         then do
             let headers = responseHeaders response
             -- If the server returned a date we use it
             -- otherwise we use the local current time
             serverDateEpoch <- case lookup "Date" headers of
-                                Nothing -> getPOSIXTime >>= \t -> return ( round t)
-                                Just d -> return $ epochFromString (B.unpack d)
+                                Nothing -> fmap round getPOSIXTime
+                                Just d -> return (epochFromString (B.unpack d))
             let etagResponded = lookup "ETag" headers
-                remaining = maybe 1 (read . B.unpack) $ lookup "X-RateLimit-Remaining" headers
-                reset = maybe 1 (read . B.unpack) $ lookup "X-RateLimit-Reset" headers
+                remainingHeader = lookup "X-RateLimit-Remaining" headers
+                remaining = maybe 1 (read . B.unpack) remainingHeader
+                resetHeader = lookup "X-RateLimit-Reset" headers
+                reset = maybe 1 (read . B.unpack) resetHeader
                 timeBeforeReset = reset - serverDateEpoch
                 t = 1000000 * timeBeforeReset `div` remaining
                 timeToWaitIn_us = max 0 (t - floor (1000000 * req_time))
-            print req_time
-            print timeToWaitIn_us
+            -- TODO: read all pages until we reach the first ID of the first page
+            -- of the preceeding loop
             publish (responseBody response)
-            threadDelay timeToWaitIn_us
-            getEvents user pass etagResponded
-        else
-            putStrLn "Something went wrong"
+            return (timeToWaitIn_us,etagResponded)
+        else do
+            putStrLn (if notModified304 == responseStatus response
+                        then "Nothing changed"
+                        else "Something went wrong")
+            return (oldTime,etag)
+
+getEvents :: String             -- ^ Github username
+          -> String             -- ^ Github password
+          -> Maybe B.ByteString -- ^ ETag
+          -> Int                -- ^ Time to wait in micro seconds
+          -> IO ()
+getEvents user pass etag t = do
+    -- Call /events on github
+    (req_time, response) <- time (httpGHEvents user pass etag)
+    (timeToWaitIn_us,etagResponded) <- getTimeAndEtagFromResponse t etag response req_time
+    threadDelay timeToWaitIn_us
+    getEvents user pass etagResponded timeToWaitIn_us
 
 publish :: LZ.ByteString -> IO ()
 publish = LZ.putStrLn . LZ.take 40