{-# LANGUAGE OverloadedStrings #-} module Main (main) where import ProgOpts (ProgOpts(..), parseOpts) import Data.Maybe import System.Directory import System.Environment import System.Exit import System.IO import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Control.Exception.Lifted import Network.HTTP.Conduit import Network.HTTP.Types import Options.Applicative import System.Cmd main :: IO () main = parseOpts >>= realMain realMain :: ProgOpts -> IO () realMain PasteOpts { optFile = opt_file , optTitle = opt_title , optAuthor = opt_author , optLanguage = opt_language , optChannel = opt_channel } = do paste <- case opt_file of "-" -> BS.getContents file -> BS.readFile file res <- withManager $ \man -> try $ do rq <- parseUrl "http://hpaste.org/new" let rq' = urlEncodedBody [ ("title" , BS.pack opt_title ) , ("author" , BS.pack opt_author ) , ("language", BS.pack opt_language) , ("channel" , BS.pack opt_channel ) , ("paste" , paste ) , ("email" , "" ) ] rq -- hpaste.org redirects us to the URL of the paste if pasting succeeds. -- In order to grab the URL we explicitly don't follow redirects. httpLbs (rq' { redirectCount = 0 }) man case res of -- An exception is thrown if the server issues a redirect. Left (StatusCodeException (Status 302 _) hdrs) | Just loc <- lookup "Location" hdrs -> do putStrLn ("http://hpaste.org" ++ BS.unpack loc) exitSuccess Left exc -> do hPutStrLn stderr "Encountered unexpected HttpException:\n" hPutStrLn stderr (show exc) exitFailure Right resp -> do hPutStrLn stderr "Encountered unexpected response:\n" hPutStrLn stderr (show resp) exitFailure realMain ViewOpts { optPasteID = opt_paste_id } = do res <- withManager $ \man -> try $ do rq <- parseUrl ("http://hpaste.org/raw/" ++ show opt_paste_id) httpLbs (rq { redirectCount = 0}) man case res of Left (StatusCodeException (Status 302 _) hdrs) | Just "/" <- lookup "Location" hdrs -> do hPutStrLn stderr $ "Paste #" ++ show opt_paste_id ++ " does not exist" exitFailure Left exc -> do hPutStrLn stderr "Encountered unexpected HttpException:\n" hPutStrLn stderr (show (exc :: HttpException)) exitFailure Right resp -> do tmp_dir <- getTemporaryDirectory withTempFile tmp_dir "hpasteit" $ \hdl file -> do LBS.hPutStrLn hdl (responseBody resp) hFlush hdl editor <- fromMaybe "vi" <$> lookupEnv "EDITOR" exit_code <- rawSystem editor [file] exitWith exit_code where withTempFile :: FilePath -> String -> (Handle -> FilePath -> IO a) -> IO a withTempFile tmp_dir prefix thing = do (file,hdl) <- openTempFile tmp_dir prefix thing hdl file `finally` (hClose hdl `finally` removeFile file)