Update.hs

-- Copyright: 2010 Dino Morelli
-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli <dino@ui3.info>

module Cltw.Update
   ( postUpdate
   )
   where

import Control.Monad.Error
import Control.Monad.Reader
import Network.Curl
import System.Random

import Cltw.Common
import Cltw.Opts


pad :: Int -> String -> String
pad l = reverse . take l . (flip (++) $ repeat '0') . reverse


base36Encode :: Int -> String
base36Encode = reverse . base36Encode'
   where
      base36Encode' 0 = []
      base36Encode' n = alphabet !! f : base36Encode' w
         where
            (w, f) = n `divMod` 36
            alphabet = "0123456789abcdefghijklmnopqrstuvwxyz"


postUpdate :: [String] -> Cltw ()

postUpdate (msg:_) = do
   uri <- constructUri "statuses/update"

   echo <- asks optEchoReqUri
   when echo $ liftIO $ putStrLn uri

   addNoise <- asks optAddNoise
   noise <- liftIO $ case addNoise of
         -- The range of ints from 0 to 1295 generate the base36 numbers
         -- 00 to zz
         True -> liftM ((' ' :) . pad 2 . base36Encode)
            $ randomRIO (0, 1295)
         False -> return ""

   let status = msg ++ noise

   when (length status > 140) $
      throwError "Update length is longer than 140 characters"

   mbErr <- liftIO $ withCurlDo $ do
      let curlOpts = [ CurlCookieJar "cookies" ]

      curl <- initialize
      setopts curl curlOpts

      r <- do_curl_ curl uri $ CurlPostFields ["status=" ++ status]
            : method_POST :: IO CurlResponse

      if respCurlCode r /= CurlOK || respStatus r /= 200
         then return . Just . respBody $ r
         else return Nothing

   maybe (return ()) throwError mbErr

postUpdate [] =
   throwError "Posting an update requires a status message"