cabal-upload 0.2 → 0.3
raw patch · 3 files changed
+80/−26 lines, 3 files
Files
- LICENSE +30/−0
- cabal-upload.cabal +2/−2
- src/CabalUpload.hs +48/−24
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Bjorn Bringert 2007.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of the contributors may not be used to endorse or + promote products derived from this software without specific + prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
cabal-upload.cabal view
@@ -1,7 +1,7 @@ Name: cabal-upload-Version: 0.2+Version: 0.3 License: BSD4-License-File: ../LICENSE+License-File: LICENSE Author: Bjorn Bringert Maintainer: Bjorn Bringert Copyright: 2007 Bjorn Bringert <bjorn@bringert.net>
src/CabalUpload.hs view
@@ -39,24 +39,26 @@ handlePackage :: Options -> FilePath -> IO () handlePackage opts path = do (uri, auth) <- if optCheck opts - then do putStr $ "Checking " ++ path ++ "... "- hFlush stdout+ then do output 1 opts $ "Checking " ++ path ++ "... " return (checkURI, return ())- else do putStr $ "Uploading " ++ path ++ "... "- hFlush stdout+ else do output 1 opts $ "Uploading " ++ path ++ "... " return (uploadURI, setAuth uploadURI (fromJust (optUsername opts)) (fromJust (optPassword opts))) req <- mkRequest uri path+ debug opts $ "\n" ++ show req (_,resp) <- browse (setErrHandler ignoreMsg >> setOutHandler ignoreMsg >> auth >> request req)+ debug opts $ show resp case rspCode resp of- (2,0,0) -> do putStrLn "OK"- (x,y,z) -> do hPutStrLn stderr $ "ERROR: " ++ map intToDigit [x,y,z] ++ " " ++ rspReason resp- hPutStrLn stderr $ rspBody resp+ (2,0,0) -> do outputLn 1 opts "OK"+ (x,y,z) -> do outputLn 1 opts "ERROR"+ outputLn 0 opts $ "ERROR: " ++ path ++ ": " + ++ map intToDigit [x,y,z] ++ " " ++ rspReason resp+ outputLn 3 opts $ rspBody resp needsAuth :: Options -> Bool needsAuth = not . optCheck@@ -69,14 +71,22 @@ auSite = uri } getAuth :: Options -> IO Options-getAuth opts = case (optUsername opts, optPassword opts) of- (Just _, Just _ ) -> return opts- (Just _, Nothing ) -> do pwd <- promptPassword- return $ opts { optPassword = Just pwd }- (Nothing , Just _ ) -> die ["password given, but not username"]- (Nothing , Nothing ) -> do (user,pwd) <- readAuthFile- return $ opts { optUsername = Just user,- optPassword = Just pwd }+getAuth opts = + do (mu, mp) <- readAuthFile+ u <- case optUsername opts `mplus` mu of+ Just u -> return u+ Nothing -> promptUsername+ p <- case optPassword opts `mplus` mp of+ Just p -> return p+ Nothing -> promptPassword+ return $ opts { optUsername = Just u,+ optPassword = Just p }+ +promptUsername :: IO Username+promptUsername = + do putStr "Hackage username: "+ hFlush stdout+ getLine promptPassword :: IO Password promptPassword = @@ -84,15 +94,18 @@ hFlush stdout getLine -passwordFile :: IO FilePath-passwordFile = do dir <- getAppUserDataDirectory "cabal-upload"- return $ dir `joinFileName` "auth"+authFile :: IO FilePath+authFile = do dir <- getAppUserDataDirectory "cabal-upload"+ return $ dir `joinFileName` "auth" -readAuthFile :: IO (Username,Password)+readAuthFile :: IO (Maybe Username, Maybe Password) readAuthFile = - do file <- passwordFile- s <- readFile file- return $ read s+ do file <- authFile+ e <- doesFileExist file+ if e then do s <- readFile file+ let (u,p) = read s+ return (Just u, Just p)+ else return (Nothing, Nothing) ignoreMsg :: String -> IO () ignoreMsg _ = return ()@@ -181,12 +194,23 @@ exitFailure usage :: IO a-usage = do pwdFile <- passwordFile+usage = do aFile <- authFile let hdr = unlines ["cabal-upload uploads Cabal source packages to Hackage.", "",- "You can store your Hackage login in " ++ pwdFile,+ "You can store your Hackage login in " ++ aFile, "using the format (\"username\",\"password\").", "", "Usage: cabal-upload [OPTION ...] [FILE ...]"] putStrLn (usageInfo hdr optDescr) exitWith ExitSuccess++-- * Logging++debug = outputLn 5++output :: Int -> Options -> String -> IO ()+output n opts s = when (optVerbosity opts >= n) $ do hPutStr stderr s+ hFlush stderr++outputLn :: Int -> Options -> String -> IO ()+outputLn n opts s = output n opts (s++"\n")