sign packages by default

dysinger · dysinger · commit 61570fc1a63d · 2016-04-06T17:08:21.000-07:00
diff --git a/src/Stack/Sig.hs b/src/Stack/Sig.hs
@@ -12,54 +12,18 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-module Stack.Sig
-       ( module Sig
-       , sigCmdName
-       , sigSignCmdName
-       , sigSignHackageCmdName
-       , sigSignHackageOpts
-       , sigSignSdistCmdName
-       , sigSignSdistOpts
-       )
-       where
+module Stack.Sig (module Sig, signOpts) where
 
 import Options.Applicative
 import Stack.Sig.GPG as Sig
 import Stack.Sig.Sign as Sig
 
--- | The command name for dealing with signatures.
-sigCmdName :: String
-sigCmdName = "sig"
-
--- | The command name for signing packages.
-sigSignCmdName :: String
-sigSignCmdName = "sign"
-
--- | The command name for signing an sdist package file.
-sigSignSdistCmdName :: String
-sigSignSdistCmdName = "sdist"
-
--- | The command name for signing all your packages from hackage.org.
-sigSignHackageCmdName :: String
-sigSignHackageCmdName = "hackage"
-
--- | The URL of the running signature service to use (sig-service)
-url :: Parser String
-url = strOption
-        (long "url" <>
-         short 'u' <>
-         metavar "URL" <>
-         showDefault <>
-         value "https://sig.commercialhaskell.org")
-
--- | Signature sign (sdist) options
-sigSignSdistOpts :: Parser (String, String)
-sigSignSdistOpts = helper <*>
-    ((,) <$> url <*>
-     argument str (metavar "PATH"))
-
--- | Signature sign (hackage) options
-sigSignHackageOpts :: Parser (String, String)
-sigSignHackageOpts = helper <*>
-    ((,) <$> url <*>
-     argument str (metavar "USER"))
+-- | Options for commands that sign packages
+signOpts :: Parser (Bool, String)
+signOpts =
+    (,) <$>
+    switch (long "no-signature" <> help "Do not sign & upload signatures") <*>
+    strOption
+        (long "sig-server" <> metavar "URL" <> showDefault <>
+         value "https://sig.commercialhaskell.org" <>
+         help "URL")
diff --git a/src/Stack/Sig/Sign.hs b/src/Stack/Sig/Sign.hs
@@ -108,10 +108,10 @@ signPackage url pkg filePath = do
         name = show n
         version = show v
     fingerprint <- GPG.verifyFile sig filePath
-    req <-
-        parseUrl
-            (url <> "/upload/signature/" <> name <> "/" <> version <> "/" <>
-             show fingerprint)
+    let fullUrl =
+            url <> "/upload/signature/" <> name <> "/" <> version <> "/" <>
+            show fingerprint
+    req <- parseUrl fullUrl
     let put =
             req
             { method = methodPut
@@ -122,7 +122,7 @@ signPackage url pkg filePath = do
     when
         (responseStatus res /= status200)
         (throwM (GPGSignException "unable to sign & upload package"))
-    $logInfo ("Signed successfully with key " <> (T.pack . show) fingerprint)
+    $logInfo ("Signature uploaded to " <> T.pack fullUrl)
 
 withStackWorkTempDir
     :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env)
diff --git a/src/main/Main.hs b/src/main/Main.hs
@@ -276,23 +276,21 @@ commandLineHandler progName isInterpreter = complicatedOptions
                              <> help "Clone from specified git repository"
                              <> value "https://github.com/commercialhaskell/stack"
                              <> showDefault ))
-        addCommand' "upload"
-                    "Upload a package to Hackage"
-                    uploadCmd
-                    ((,,,)
-                     <$> many (strArgument $ metavar "TARBALL/DIR")
-                     <*> optional pvpBoundsOption
-                     <*> ignoreCheckSwitch
-                     <*> flag False True
-                          (long "sign" <>
-                           help "GPG sign & submit signature"))
-        addCommand' "sdist"
-                    "Create source distribution tarballs"
-                    sdistCmd
-                    ((,,)
-                     <$> many (strArgument $ metavar "DIR")
-                     <*> optional pvpBoundsOption
-                     <*> ignoreCheckSwitch)
+        addCommand'
+            "upload"
+            "Upload a package to Hackage"
+            uploadCmd
+            ((,,,) <$> many (strArgument $ metavar "TARBALL/DIR") <*>
+             optional pvpBoundsOption <*>
+             ignoreCheckSwitch <*>
+             Sig.signOpts)
+        addCommand'
+            "sdist"
+            "Create source distribution tarballs"
+            sdistCmd
+            ((,,,) <$> many (strArgument $ metavar "DIR") <*> optional pvpBoundsOption <*>
+             ignoreCheckSwitch <*>
+             Sig.signOpts)
         addCommand' "dot"
                     "Visualize your project's dependency graph using Graphviz dot"
                     dotCmd
@@ -921,9 +919,9 @@ upgradeCmd (fromGit, repo) go = withConfigAndLock go $
 #endif
 
 -- | Upload to Hackage
-uploadCmd :: ([String], Maybe PvpBounds, Bool, Bool) -> GlobalOpts -> IO ()
+uploadCmd :: ([String], Maybe PvpBounds, Bool, (Bool,String)) -> GlobalOpts -> IO ()
 uploadCmd ([], _, _, _) _ = error "To upload the current package, please run 'stack upload .'"
-uploadCmd (args, mpvpBounds, ignoreCheck, shouldSign) go = do
+uploadCmd (args, mpvpBounds, ignoreCheck, (dontSign, sigServerUrl)) go = do
     let partitionM _ [] = return ([], [])
         partitionM f (x:xs) = do
             r <- f x
@@ -942,7 +940,6 @@ uploadCmd (args, mpvpBounds, ignoreCheck, shouldSign) go = do
             let uploadSettings =
                     Upload.setGetManager (return manager) Upload.defaultUploadSettings
             liftIO $ Upload.mkUploader config uploadSettings
-        sigServiceUrl = "https://sig.commercialhaskell.org/"
     withBuildConfigAndLock go $ \_ -> do
         uploader <- getUploader
         unless ignoreCheck $
@@ -953,11 +950,11 @@ uploadCmd (args, mpvpBounds, ignoreCheck, shouldSign) go = do
                   do tarFile <- resolveFile' file
                      liftIO
                          (Upload.upload uploader (toFilePath tarFile))
-                     when
-                         shouldSign
+                     unless
+                         dontSign
                          (Sig.sign
                               (lcProjectRoot lc)
-                              sigServiceUrl
+                              sigServerUrl
                               tarFile))
         unless (null dirs) $
             forM_ dirs $ \dir -> do
@@ -966,16 +963,16 @@ uploadCmd (args, mpvpBounds, ignoreCheck, shouldSign) go = do
                 unless ignoreCheck $ checkSDistTarball' tarName tarBytes
                 liftIO $ Upload.uploadBytes uploader tarName tarBytes
                 tarPath <- parseRelFile tarName
-                when
-                    shouldSign
+                unless
+                    dontSign
                     (Sig.signTarBytes
                          (lcProjectRoot lc)
-                         sigServiceUrl
+                         sigServerUrl
                          tarPath
                          tarBytes)
 
-sdistCmd :: ([String], Maybe PvpBounds, Bool) -> GlobalOpts -> IO ()
-sdistCmd (dirs, mpvpBounds, ignoreCheck) go =
+sdistCmd :: ([String], Maybe PvpBounds, Bool, (Bool,String)) -> GlobalOpts -> IO ()
+sdistCmd (dirs, mpvpBounds, ignoreCheck, (dontSign,sigServerUrl)) go =
     withBuildConfig go $ do -- No locking needed.
         -- If no directories are specified, build all sdist tarballs.
         dirs' <- if null dirs
@@ -989,6 +986,8 @@ sdistCmd (dirs, mpvpBounds, ignoreCheck) go =
             liftIO $ L.writeFile (toFilePath tarPath) tarBytes
             unless ignoreCheck (checkSDistTarball tarPath)
             $logInfo $ "Wrote sdist tarball to " <> T.pack (toFilePath tarPath)
+            (_,lc) <- liftIO $ loadConfigWithOpts go
+            unless dontSign (Sig.sign (lcProjectRoot lc) sigServerUrl tarPath)
 
 -- | Execute a command.
 execCmd :: ExecOpts -> GlobalOpts -> IO ()
