[Initial stub for Twitter nanny. Doesn't do anything... prb@mult.ifario.us**20080616045841] { hunk ./src/Blog/Widgets/ChromeBackEnd.hs 28 - ; start_twitter_tweets socc C.twitter_user C.twitter_pass - ; start_twitter_replies socc C.twitter_user C.twitter_pass + ; tweet_worker <- start_twitter_tweets socc C.twitter_user C.twitter_pass + ; reply_worker <- start_twitter_replies socc C.twitter_user C.twitter_pass + ; start_twitter_nanny socc [(tweet_worker,1), (reply_worker,1)] C.twitter_user C.twitter_pass hunk ./src/Blog/Widgets/Delicious.hs 25 +import Data.Time.Clock.POSIX as DTCP + hunk ./src/Blog/Widgets/Delicious.hs 184 - ; let next_actions' = insert (t1,i) ts + ; let next_actions' = insert (t1,i) ts + ; L.debugM log_handle $ "Scheduling next poll for " ++ ( B.permalink m $ B.item_by_id m i ) + ++ " for " ++ ( format_posix_time t1) ++ "." hunk ./src/Blog/Widgets/Delicious.hs 277 +format_posix_time :: SP.EpochTime -> String +format_posix_time = show . DTCP.posixSecondsToUTCTime . realToFrac hunk ./src/Blog/Widgets/StreamOfConsciousness.hs 4 + , module Blog.Widgets.StreamOfConsciousness.TwitterNanny hunk ./src/Blog/Widgets/StreamOfConsciousness.hs 10 +import Blog.Widgets.StreamOfConsciousness.TwitterNanny hunk ./src/Blog/Widgets/StreamOfConsciousness.hs 13 -import Blog.Widgets.StreamOfConsciousness.Controller +import Blog.Widgets.StreamOfConsciousness.Controller + hunk ./src/Blog/Widgets/StreamOfConsciousness/Controller.hs 39 + +change_worker_polling_frequency :: Worker -> Int -> IO () +change_worker_polling_frequency w n = change_polling_frequency (poller w) n addfile ./src/Blog/Widgets/StreamOfConsciousness/TwitterNanny.hs hunk ./src/Blog/Widgets/StreamOfConsciousness/TwitterNanny.hs 1 +module Blog.Widgets.StreamOfConsciousness.TwitterNanny ( start_twitter_nanny ) where + +import qualified Control.Monad as CM +import Blog.Widgets.StreamOfConsciousness.Controller + +import qualified System.Log.Logger as L + +import Network.HTTP +import Network.HTTP.Headers +import Network.URI ( parseURI ) +import Data.Maybe ( fromJust ) + +import qualified Text.Json as J + +import qualified Codec.Binary.Base64.String as B64 + +import Blog.Widgets.JsonUtilities + +import Blog.BackEnd.HttpPoller + +nanny_period :: Int +nanny_period = 60 * 10^6 -- supposedly cheap. + +log_handle :: String +log_handle = "TwitterNanny" + +start_twitter_nanny :: SoCController -> [(Worker,Int)] -> String -> String -> IO Worker +start_twitter_nanny socc kids user password = do { let req = build_request user password + ; p <- start_poller log_handle req (handle_throttle kids) nanny_period + ; return $ Worker socc p } + +build_request :: String -> String -> Request +build_request user password = Request uri GET heads "" + where + uri = fromJust $ parseURI $ "http://twitter.com/account/rate_limit_status.json" + heads = [ Header HdrAuthorization $ (++) "Basic " $ B64.encode $ user ++ ":" ++ password ] + +handle_throttle :: [(Worker,Int)] -> String -> IO () +handle_throttle ws body = case parse_utf8_json body of + Right v@(J.Object _) -> + compute_new_delays ws v + Right _ -> + L.errorM log_handle $ "Unexpected non-array JSON response that starts with: " + ++ (take 100 body) ++ " [...]" + Left err_message -> + L.errorM log_handle err_message + +compute_new_delays :: [(Worker,Int)] -> J.Value -> IO () +compute_new_delays _ v = do { let throttle = unn $ v "remaining_hits" + ; L.infoM log_handle $ "Twitter throttle is " ++ (show throttle) ++ " requests per hour." + } }