diff --git a/muraine.cabal b/muraine.cabal index b279927..514788e 100644 --- a/muraine.cabal +++ b/muraine.cabal @@ -26,5 +26,7 @@ executable muraine , conduit , http-conduit , http-types + , old-locale + , time hs-source-dirs: src/ default-language: Haskell2010 diff --git a/src/.Main.hs.swo b/src/.Main.hs.swo new file mode 100644 index 0000000..b013b4f Binary files /dev/null and b/src/.Main.hs.swo differ diff --git a/src/Main.hs b/src/Main.hs index bdf40ef..5822e4d 100644 --- a/src/Main.hs +++ b/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