diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,10 @@ +0.9 (Jul 8, 2014) +================= + +- Turn username argument into an option +- Prompt for a username if no username is given +- Remember the username in `~/.emacs.d/marmalade-upload.json` + 0.8.1 (Jun 5, 2014) =================== diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014 Sebastian Wiesner +Copyright (c) 2014 Sebastian Wiesner Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,18 +5,7 @@ [![License MIT][badge-license]][license] [![Build Status][badge-travis]][travis] -Haskell tool to upload packages to the Emacs package archive [Marmalade][], -published in the hopes - -- that you find it useful, -- and that Marmalade dies rather sooner than later nonetheless. - -I'm sorry for the inconvenient language, but if I'm to write a boring tool for a -stupid bug, then at least in a cool language. - -And while we're at it, I'd like to say a big thank you to [MELPA][] for building -[stable packages][] now, and bringing Marmalade a big step closer to its -passing. Well done, folks! +Haskell tool to upload packages to the Emacs package archive [Marmalade][]. [badge-travis]: https://travis-ci.org/lunaryorn/marmalade-upload.svg?branch=master [travis]: https://travis-ci.org/lunaryorn/marmalade-upload @@ -25,23 +14,26 @@ [badge-license]: https://img.shields.io/badge/license-MIT-green.svg?dummy [license]: https://github.com/lunaryorn/marmalade-upload/blob/master/LICENSE [Marmalade]: http://marmalade-repo.org -[MELPA]: http://melpa.milkbox.net -[stable packages]: https://github.com/milkypostman/melpa#stable-packages Installation ------------ ### Binaries -- [OS X 10.9](https://github.com/lunaryorn/marmalade-upload/releases/download/0.7/marmalade-upload-0.7_osx-10.9.zip) -- [Linux x86_64](https://github.com/lunaryorn/marmalade-upload/releases/download/0.7/marmalade-upload-0.7_linux-x86_64.zip) +Binaries for OS X and Linux are available on the [download page][]. To install, `unzip` the archive, and move the contained `marmalade-upload` file -somewhere into `$PATH`, e.g. `/usr/local/bin/`. +somewhere into `$PATH`, e.g.: -These binaries are statically linked and to not require Haskell or any Haskell -libraries. +```console +$ unzip +$ sudo cp ./marmalade-upload /usr/local/bin +$ sudo chmod 755 /usr/local/bin/marmalade-upload +``` +The binaries are statically linked and to not require a Haskell installation or +any Haskell libraries. + ### Building from Source Install [Haskell Platform][] and type the following command to install @@ -53,6 +45,7 @@ Don't forget to add `~/.cabal/bin` to `$PATH`. +[download page]: https://github.com/lunaryorn/marmalade-upload/releases/latest [Haskell Platform]: http://www.haskell.org/platform/ Usage @@ -68,7 +61,7 @@ License ------- -Copyright (c) 2014 Sebastian Wiesner +Copyright (c) 2014 Sebastian Wiesner Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in diff --git a/main.hs b/main.hs --- a/main.hs +++ b/main.hs @@ -1,4 +1,4 @@ --- Copyright (c) 2014 Sebastian Wiesner +-- Copyright (c) 2014 Sebastian Wiesner -- Permission is hereby granted, free of charge, to any person obtaining a copy -- of this software and associated documentation files (the "Software"), to deal @@ -18,26 +18,37 @@ -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -- THE SOFTWARE. -module Main where - -import qualified System.Keyring as K -import Web.Marmalade +{-# LANGUAGE OverloadedStrings #-} -import qualified System.IO as IO +module Main (main) where -import Control.Exception (SomeException,bracket,handle) -import Control.Monad (when) -import Control.Monad.IO.Class (liftIO) -import Data.Version (showVersion) -import Options.Applicative (Parser,execParser, - info,fullDesc,progDesc,infoOption, - helper,argument,long,short,str,metavar,help, - (<$>),(<>),(<*>)) -import System.Exit (ExitCode(ExitFailure),exitWith) -import System.IO (hPutStrLn,stderr) -import Text.Printf (printf) +import Paths_marmalade_upload (version) +import Web.Marmalade -import Paths_marmalade_upload (version) +import Control.Exception (SomeException,IOException,bracket,handle) +import Control.Monad (liftM,when,mzero) +import Control.Monad.IO.Class (liftIO) +import Data.Aeson (FromJSON(parseJSON),ToJSON(toJSON), + Value(Object),(.:),object,(.=), + decodeStrict',encode) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.Default (Default(def)) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>),mempty) +import Data.Version (showVersion) +import Options.Applicative (Parser,execParser, + info,fullDesc,progDesc, + infoOption,strOption, + helper,argument,long,short,str, + metavar,help,value,showDefault, + (<$>),(<*>)) +import System.Directory (getHomeDirectory) +import System.Exit (ExitCode(ExitFailure),exitWith) +import System.FilePath (()) +import qualified System.IO as IO +import qualified System.Keyring as K +import Text.Printf (printf) -- Program information @@ -78,6 +89,12 @@ putChar '\n' return password +askMarmaladeUsername :: IO String +askMarmaladeUsername = do + putStr "Marmalade username: " + IO.hFlush IO.stdout + getLine + -- |@'askMarmaladePassword' username@ asks for the Marmalade password of the -- given @username@ on the terminal. askMarmaladePassword :: String -> Marmalade String @@ -88,7 +105,7 @@ -- @username@. -- -- Return the authorization information, and a boolean indicating whether - -- authorization shall be stored. +-- authorization shall be stored. -- -- If the authorization token of @username@ is stored in the keyring, use it, -- otherwise fall back to password authentication. @@ -101,9 +118,43 @@ where ignoreMissingBackend :: K.KeyringMissingBackendError -> IO (Bool, Auth) ignoreMissingBackend _ = do - hPutStrLn stderr "Warning: No keyring backend found, token will not be saved" + IO.hPutStrLn IO.stderr + "Warning: No keyring backend found, token will not be saved" return (False, BasicAuth (Username username) (askMarmaladePassword username)) +-- Configuration handling + +data Configuration = Configuration { configUsername :: Maybe String } + deriving (Read,Show,Eq) + +instance Default Configuration where + def = Configuration Nothing + +instance FromJSON Configuration where + parseJSON (Object o) = Configuration <$> o .: "username" + parseJSON _ = mzero + +instance ToJSON Configuration where + toJSON config = object [ "username" .= configUsername config ] + +loadConfig :: IO Configuration +loadConfig = do + fileName <- configFile + handle returnDefault $ IO.withBinaryFile fileName IO.ReadMode $ \source -> + liftM (fromMaybe def.decodeStrict') (BS.hGetContents source) + where returnDefault :: IOException -> IO Configuration + returnDefault _ = return def + +saveConfig :: Configuration -> IO () +saveConfig config = do + fileName <- configFile + IO.withBinaryFile fileName IO.WriteMode (`LBS.hPut` encode config) + +configFile :: IO FilePath +configFile = do + home <- getHomeDirectory + return (home ".emacs.d" "marmalade-upload.json") + -- Arguments handling exitFailure :: String -> IO () @@ -112,33 +163,46 @@ exitException :: SomeException -> IO () exitException = exitFailure.show -data Arguments = Arguments { argUsername :: String - , argPackageFile :: String } +data Arguments = Arguments { argUsername :: String + , argPackageFile :: String } -parser :: Parser Arguments -parser = +parser :: Configuration -> Parser Arguments +parser config = versionInfo <*> arguments where versionInfo = infoOption versionMessage (long "version" <> short 'V' <> help "Show version number and exit") + defUsername = fromMaybe "" (configUsername config) arguments = Arguments <$> - argument str (metavar "USERNAME" <> help "Marmalade username") <*> + strOption (long "username" <> + short 'u' <> + value defUsername <> + if defUsername == "" then mempty else showDefault <> + help "Marmalade username" <> + metavar "USERNAME") <*> argument str (metavar "PACKAGE" <> help "Package file") - versionMessage = unlines [(appName ++ " " ++ appVersion) + versionMessage = unlines [appName ++ " " ++ appVersion ,"Copyright (C) 2014 Sebastian Wiesner." ,"You may redistribute marmalade-upload" ,"under the terms of the MIT/X11 license."] main :: IO () main = do - args <- execParser (info (helper <*> parser) + config <- loadConfig + args <- execParser (info (helper <*> parser config) (fullDesc <> progDesc "Upload a package to Marmalade")) - (shallSaveToken, auth) <- getAuth (argUsername args) + (shallSaveToken, auth) <- getUsername args >>= getAuth handle exitException $ runMarmalade appUserAgent auth $ do (Username username, Token token) <- login + let newConfig = Configuration (Just username) + liftIO $ when (config /= newConfig) $ do + saveConfig newConfig + configFile >>= printf "Saved username to %s\n" -- Save the token now when shallSaveToken $ liftIO (K.setPassword (K.Service appService) (K.Username username) (K.Password token)) upload <- uploadPackage (argPackageFile args) liftIO (putStrLn (uploadMessage upload)) + where getUsername Arguments{argUsername=[]} = askMarmaladeUsername + getUsername args = return (argUsername args) diff --git a/marmalade-upload.cabal b/marmalade-upload.cabal --- a/marmalade-upload.cabal +++ b/marmalade-upload.cabal @@ -1,5 +1,5 @@ name: marmalade-upload -version: 0.8.1 +version: 0.9 synopsis: Upload packages to Marmalade description: Upload Emacs packages to the ELPA @@ -10,7 +10,7 @@ extra-source-files: README.md, CHANGES.md author: Sebastian Wiesner -maintainer: lunaryorn@gmail.com +maintainer: swiesner@lunaryorn.com copyright: (C) 2014 Sebastian Wiesner bug-reports: https://github.com/lunaryorn/marmalade-upload/issues category: Development @@ -25,31 +25,36 @@ source-repository this type: git location: https://github.com/lunaryorn/marmalade-upload.git - tag: 0.8.1 + tag: 0.9 library hs-source-dirs: src/ exposed-modules: Web.Marmalade ghc-options: -Wall build-depends: base >=4.6 && <4.8, - mtl >=2.1 && <2.3, - transformers >=0.3 && <0.5, - exceptions >=0.5 && <0.7, - bytestring >=0.10 && <1.11, - utf8-string >=0.3 && <0.4, - aeson >=0.7 && <0.8, - network >=2.4 && <2.6, - http-types >=0.8 && <0.9, - http-client >=0.3 && <0.4 + mtl >=2.1, + transformers >=0.3, + exceptions >=0.5, + bytestring >=0.10, + utf8-string >=0.3, + aeson >=0.7, + network >=2.4, + http-types >=0.8, + http-client >=0.3 default-language: Haskell2010 executable marmalade-upload main-is: main.hs ghc-options: -Wall build-depends: base >=4.6 && <4.8, - transformers >=0.3 && <0.5, - optparse-applicative >=0.8 && <0.10, - keyring >=0.1 && <0.2, + bytestring >= 0.10, + aeson >= 0.7, + data-default >= 0.5, + filepath >= 1.3, + directory >= 1.2, + transformers >=0.3, + optparse-applicative >=0.8, + keyring >=0.1, marmalade-upload default-language: Haskell2010 @@ -57,12 +62,12 @@ type: exitcode-stdio-1.0 main-is: marmalade-tests.hs hs-source-dirs: test/ - build-depends: base >=4.6 && <4.8, - transformers >=0.3 && <0.5, - exceptions >=0.5 && <0.7, - aeson >=0.7 && <0.8, - tasty >=0.8 && <0.9, - tasty-hunit >=0.8 && <0.9, + build-depends: base >=4.6 && < 4.8, + transformers >=0.3, + exceptions >=0.5, + aeson >=0.7, + tasty >=0.8, + tasty-hunit >=0.8, marmalade-upload default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Web/Marmalade.hs b/src/Web/Marmalade.hs --- a/src/Web/Marmalade.hs +++ b/src/Web/Marmalade.hs @@ -1,4 +1,4 @@ --- Copyright (c) 2014 Sebastian Wiesner +-- Copyright (c) 2014 Sebastian Wiesner -- Permission is hereby granted, free of charge, to any person obtaining a copy -- of this software and associated documentation files (the "Software"), to deal diff --git a/test/marmalade-tests.hs b/test/marmalade-tests.hs --- a/test/marmalade-tests.hs +++ b/test/marmalade-tests.hs @@ -1,4 +1,4 @@ --- Copyright (c) 2014 Sebastian Wiesner +-- Copyright (c) 2014 Sebastian Wiesner -- Permission is hereby granted, free of charge, to any person obtaining a copy -- of this software and associated documentation files (the "Software"), to deal @@ -74,7 +74,7 @@ auth = BasicAuth (Username "marmalade-upload-test-user") (return "test-password") badRequest (MarmaladeBadRequest msg) = Just msg badRequest _ = Nothing - assertMessage msg = msg @?= "

Bad request

bad authentication

\r\n" + assertMessage msg = msg @?= "bad authentication" uploadNonExistingPackage :: TestTree uploadNonExistingPackage =