Haskell Quiz/Cat2Rafb/Solution Burton
< Haskell Quiz | Cat2Rafb
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
-- 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