progress toward retrieving datas

muraine.cabal

@@ -26,5 +26,7 @@ executable muraine
                        , conduit
                        , http-conduit
                        , http-types
+                       , old-locale
+                       , time
   hs-source-dirs:      src/
   default-language:    Haskell2010

src/Main.hs

@@ -9,8 +9,13 @@ import qualified Data.ByteString.Lazy.Char8 as LZ
 import qualified Data.ByteString.Char8 as B
 import Data.CaseInsensitive (original)
 import Data.Monoid ((<>))
+import Control.Concurrent (threadDelay)
 import System.Environment (getArgs)
 import System.Exit (exitFailure)
+import Data.Time.Format (readTime)
+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
@@ -19,6 +24,14 @@ simpleHTTPWithUserAgent url user pass = do
         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)
+
 showHeader :: Header -> IO ()
 showHeader (name, value) = B.putStrLn $ original name <> ": " <> value
 
@@ -31,15 +44,49 @@ main :: IO ()
 main = do
     args <- getArgs
     case args of
-         [user,pass] -> continueWithUserAndPass user pass
+         [user,pass] -> getEvents user pass Nothing
          _ -> showHelpAndExit
 
-continueWithUserAndPass :: String -> String -> IO ()
-continueWithUserAndPass user pass = do
-    response <- simpleHTTPWithUserAgent "https://api.github.com/events" user pass
+rfc822DateFormat :: String
+rfc822DateFormat = "%a, %_d %b %Y %H:%M:%S %Z"
+
+epochFromString :: String -> Int
+epochFromString = floor . utcTimeToPOSIXSeconds . readTime defaultTimeLocale rfc822DateFormat
+
+time :: IO a -> IO (Double, a)
+time action = do
+    startTime <- getCPUTime
+    res <- action
+    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
     if statusIsSuccessful (responseStatus response)
-       then do
-              LZ.putStrLn (responseBody response)
-              mapM_ showHeader (responseHeaders response)
-       else
-              putStrLn "Something went wrong"
+        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)
+            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
+                timeBeforeReset = reset - serverDateEpoch
+                t = 1000000 * timeBeforeReset `div` remaining
+                timeToWaitIn_us = max 0 (t - floor (1000000 * req_time))
+            print req_time
+            print timeToWaitIn_us
+            publish (responseBody response)
+            threadDelay timeToWaitIn_us
+            getEvents user pass etagResponded
+        else
+            putStrLn "Something went wrong"
+
+publish :: LZ.ByteString -> IO ()
+publish = LZ.putStrLn . LZ.take 40