Haskell Quiz/Cat2Rafb/Solution Burton
< Haskell Quiz | Cat2Rafb
Jump to navigation
Jump to search
-- post the contents of stdin to hpaste.org
--
-- e.g. $ cat Cat2hpaste.hs | ./cat2hpaste
import Network.HTTP
import Network.URI
import System
import System.IO
import System.Time
import Data.Maybe
main = do contents <- getContents
title <- getClockTime
url <- post (show title) "cat2hpaste" contents
putStrLn url
err :: String -> IO a
err msg = do hPutStrLn stderr msg
exitFailure
post :: String -> String -> String -> IO String
post title nick content = do
eresp <- simpleHTTP postRequest
resp <- handleE (err . show) eresp
let locs = retrieveHeaders HdrLocation resp
return (show (head locs))
where postRequest :: Request
postRequest =
Request { rqURI = fromJust $ parseURI "http://hpaste.org/new",
rqMethod = POST,
rqHeaders = [uaHeader,
Header HdrContentLength (show $ length body),
Header HdrAccept ("text/xml,application/xml,application/xhtml+xml,text/html"),
Header HdrContentType "application/x-www-form-urlencoded" ],
rqBody = body }
body = urlEncodeVars [ ("content", content),
("nick", nick),
("title", title)]
uaHeader :: Header
uaHeader = Header HdrUserAgent "Firefox/1.5.0.4"
handleE :: Monad m => (ConnError -> m a) -> Either ConnError a -> m a
handleE h (Left e) = h e
handleE _ (Right v) = return v