stackage-upload (empty) → 0.1.0.0

raw patch · 7 files changed

+449/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, directory, filepath, http-client, http-client-tls, http-types, optparse-applicative, stackage-cli, stackage-upload, text

Files

• ChangeLog.md +3/−0
• LICENSE +22/−0
• README.md +58/−0
• Setup.hs +2/−0
• Stackage/Upload.hs +302/−0
• app/stackage-upload.hs +18/−0
• stackage-upload.cabal +44/−0

@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release

@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2015 FP Complete++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 the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.+

@@ -0,0 +1,58 @@+# stackage-upload++A more secure version of cabal upload which uses HTTPS. When uploading a+package to Hackage, `cabal-install` will perform the upload in plain-text,+unencrypted HTTP, which is vulnerable to man in the middle (MITM) attacks. This+package instead uses secure HTTPS upload to avoid both MITM attacks, and+possibly eavesdropping attacks (though the latter are yet unproven). In the+future, additionally functionality may be added.++To install, simply run `cabal update && cabal install stackage-upload`. Usage+is quite similar `cabal upload`: just call `stackage-upload` and pass in a list+of tarballs to upload. (If you have+[stackage-cli](https://github.com/fpco/stackage-cli) installed, you can call+`stk upload` instead.) `stackage-upload --help` will provide full options.++## Why not fix cabal?++A legitimate question is why not add HTTPS support to cabal-install? The answer+is that I tried. At least as of April 2015, there was no proposal I was able to+make that allowed TLS support to be added to cabal-install, due to policies+regarding dependencies in the Cabal project. I would be much happier to add+this support there (and, at the same time, add secure *download* support, which+is also severely lacking). I made an open offer in April 2015, and the offer+stands: if the Cabal project gives me the green light to add http-client as a+dependency to cabal-install, I'll send the pull request myself.++To give some more background: Cabal currently requires that all dependencies+be part of the Haskell Platform. I disagree with this decision, since+distributing a binary does not require that the libraries be available as well.+The last time TLS support in the Platform was raised, the best option for this+support (Vincent's wonderful [tls+package](https://www.stackage.org/package/tls) was vetoed because [it didn't+follow the Package Versioning Policy's strict upper bounds+approach](https://mail.haskell.org/pipermail/libraries/2014-April/022554.html).+(Ironically, the alternative package mentioned there, http-streams, *also*+doesn't have upper bounds on all dependencies.)++## Why Stackage?++See [the same question and its answer on stackage-update](https://github.com/fpco/stackage-update#why-stackage).++## Future enhancements++* Store passwords securely via GPG encryption+* Upload documentation to Hackage (work around the sometimes-broken doc builder)+* Perform pre-upload checks, such as running the test suite from the tarball to check for missing files++## History++This tool was something that I (Michael Snoyman) wrote for myself a while back,+and decided to rebrand as `stackage-upload` when the severity of the insecure+upload situation became apparent to me, and it became obvious that there was no+path forward for getting `cabal-install` fixed.++I actually consider this situation to be so dangerous, I would like to ask the+Hackage Server team to consider turning off insecure uploads to Hackage. The+current possibility for corrupted uploads to infect all users of a package is+alarmingly high.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,302 @@+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Provide ability to upload tarballs to Hackage.+module Stackage.Upload+    ( -- * Upload+      mkUploader+    , Uploader+    , upload+    , UploadSettings+    , defaultUploadSettings+    , setUploadUrl+    , setGetManager+    , setCredsSource+    , setSaveCreds+      -- * Credentials+    , HackageCreds+    , loadCreds+    , saveCreds+    , FromFile+      -- ** Credentials source+    , HackageCredsSource+    , fromAnywhere+    , fromPrompt+    , fromFile+    , fromMemory+    ) where++import           Control.Applicative                   ((<$>), (<*>))+import           Control.Exception                     (bracket)+import qualified Control.Exception                     as E+import           Control.Monad                         (when)+import           Data.Aeson                            (FromJSON (..),+                                                        ToJSON (..),+                                                        eitherDecode', encode,+                                                        object, withObject,+                                                        (.:), (.=))+import qualified Data.ByteString.Char8                 as S+import qualified Data.ByteString.Lazy                  as L+import           Data.Text                             (Text)+import qualified Data.Text                             as T+import           Data.Text.Encoding                    (encodeUtf8)+import qualified Data.Text.IO                          as TIO+import           Data.Typeable                         (Typeable)+import           Network.HTTP.Client                   (BodyReader, Manager,+                                                        Response,+                                                        applyBasicAuth, brRead,+                                                        checkStatus, newManager,+                                                        parseUrl,+                                                        requestHeaders,+                                                        responseBody,+                                                        responseStatus,+                                                        withResponse)+import           Network.HTTP.Client.MultipartFormData (formDataBody, partFile)+import           Network.HTTP.Client.TLS               (tlsManagerSettings)+import           Network.HTTP.Types                    (statusCode)+import           System.Directory                      (createDirectoryIfMissing,+                                                        getAppUserDataDirectory,+                                                        removeFile)+import           System.FilePath                       ((</>))+import           System.IO                             (hFlush, hGetEcho,+                                                        hSetEcho, stdin, stdout)++-- | Username and password to log into Hackage.+--+-- Since 0.1.0.0+data HackageCreds = HackageCreds+    { hcUsername :: !Text+    , hcPassword :: !Text+    }+    deriving Show++instance ToJSON HackageCreds where+    toJSON (HackageCreds u p) = object+        [ "username" .= u+        , "password" .= p+        ]+instance FromJSON HackageCreds where+    parseJSON = withObject "HackageCreds" $ \o -> HackageCreds+        <$> o .: "username"+        <*> o .: "password"++-- | A source for getting Hackage credentials.+--+-- Since 0.1.0.0+newtype HackageCredsSource = HackageCredsSource+    { getCreds :: IO (HackageCreds, FromFile)+    }++-- | Whether the Hackage credentials were loaded from a file.+--+-- This information is useful since, typically, you only want to save the+-- credentials to a file if it wasn't already loaded from there.+--+-- Since 0.1.0.0+type FromFile = Bool++-- | Load Hackage credentials from the given source.+--+-- Since 0.1.0.0+loadCreds :: HackageCredsSource -> IO (HackageCreds, FromFile)+loadCreds = getCreds++-- | Save the given credentials to the credentials file.+--+-- Since 0.1.0.0+saveCreds :: HackageCreds -> IO ()+saveCreds creds = do+    fp <- credsFile+    L.writeFile fp $ encode creds++-- | Load the Hackage credentials from the prompt, asking the user to type them+-- in.+--+-- Since 0.1.0.0+fromPrompt :: HackageCredsSource+fromPrompt = HackageCredsSource $ do+    putStr "Hackage username: "+    hFlush stdout+    username <- TIO.getLine+    password <- promptPassword+    return (HackageCreds+        { hcUsername = username+        , hcPassword = password+        }, False)++credsFile :: IO FilePath+credsFile = do+    dir <- getAppUserDataDirectory "stackage-upload"+    createDirectoryIfMissing True dir+    return $ dir </> "credentials.json"++-- | Load the Hackage credentials from the JSON config file.+--+-- Since 0.1.0.0+fromFile :: HackageCredsSource+fromFile = HackageCredsSource $ do+    fp <- credsFile+    lbs <- L.readFile fp+    case eitherDecode' lbs of+        Left e -> E.throwIO $ Couldn'tParseJSON fp e+        Right creds -> return (creds, True)++-- | Load the Hackage credentials from the given arguments.+--+-- Since 0.1.0.0+fromMemory :: Text -> Text -> HackageCredsSource+fromMemory u p = HackageCredsSource $ return (HackageCreds+    { hcUsername = u+    , hcPassword = p+    }, False)++data HackageCredsExceptions = Couldn'tParseJSON FilePath String+    deriving (Show, Typeable)+instance E.Exception HackageCredsExceptions++-- | Try to load the credentials from the config file. If that fails, ask the+-- user to enter them.+--+-- Since 0.1.0.0+fromAnywhere = HackageCredsSource $+    getCreds fromFile `E.catches`+        [ E.Handler $ \(_ :: E.IOException) -> getCreds fromPrompt+        , E.Handler $ \(_ :: HackageCredsExceptions) -> getCreds fromPrompt+        ]++-- | Lifted from cabal-install, Distribution.Client.Upload+promptPassword :: IO Text+promptPassword = do+  putStr "Hackage password: "+  hFlush stdout+  -- save/restore the terminal echoing status+  passwd <- bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do+    hSetEcho stdin False  -- no echoing for entering the password+    fmap T.pack getLine+  putStrLn ""+  return passwd++-- | Turn the given settings into an @Uploader@.+--+-- Since 0.1.0.0+mkUploader :: UploadSettings -> IO Uploader+mkUploader us = do+    manager <- usGetManager us+    (creds, fromFile) <- loadCreds $ usCredsSource us+    when (not fromFile && usSaveCreds us) $ saveCreds creds+    req0 <- parseUrl $ usUploadUrl us+    let req1 = req0+            { requestHeaders = [("Accept", "text/plain")]+            , checkStatus = \_ _ _ -> Nothing+            }+    return Uploader+        { upload_ = \fp -> do+            let formData = [partFile "package" fp]+            req2 <- formDataBody formData req1+            let req3 = applyBasicAuth+                    (encodeUtf8 $ hcUsername creds)+                    (encodeUtf8 $ hcPassword creds)+                    req2+            putStr $ "Uploading " ++ fp ++ "... "+            hFlush stdout+            withResponse req3 manager $ \res ->+                case statusCode $ responseStatus res of+                    200 -> putStrLn "done!"+                    401 -> do+                        putStrLn "authentication failure"+                        cfp <- credsFile+                        handleIO (const $ return ()) (removeFile cfp)+                        error $ "Authentication failure uploading to server"+                    403 -> do+                        putStrLn "forbidden upload"+                        putStrLn "Usually means: you've already uploaded this package/version combination"+                        putStrLn "Ignoring error and continuing, full message from Hackage below:\n"+                        printBody res+                    code -> do+                        putStrLn $ "unhandled status code: " ++ show code+                        printBody res+                        error $ "Upload failed on " ++ fp+        }++printBody :: Response BodyReader -> IO ()+printBody res =+    loop+  where+    loop = do+        bs <- brRead $ responseBody res+        when (not $ S.null bs) $ do+            S.hPut stdout bs+            loop++-- | The computed value from a @UploadSettings@.+--+-- Typically, you want to use this with 'upload'.+--+-- Since 0.1.0.0+data Uploader = Uploader+    { upload_ :: !(FilePath -> IO ())+    }++-- | Upload a single tarball with the given @Uploader@.+--+-- Since 0.1.0.0+upload :: Uploader -> FilePath -> IO ()+upload = upload_++-- | Settings for creating an @Uploader@.+--+-- Since 0.1.0.0+data UploadSettings = UploadSettings+    { usUploadUrl   :: !String+    , usGetManager  :: !(IO Manager)+    , usCredsSource :: !HackageCredsSource+    , usSaveCreds   :: !Bool+    }++-- | Default value for @UploadSettings@.+--+-- Use setter functions to change defaults.+--+-- Since 0.1.0.0+defaultUploadSettings :: UploadSettings+defaultUploadSettings = UploadSettings+    { usUploadUrl = "https://hackage.haskell.org/packages/"+    , usGetManager = newManager tlsManagerSettings+    , usCredsSource = fromAnywhere+    , usSaveCreds = True+    }++-- | Change the upload URL.+--+-- Default: "https://hackage.haskell.org/packages/"+--+-- Since 0.1.0.0+setUploadUrl :: String -> UploadSettings -> UploadSettings+setUploadUrl x us = us { usUploadUrl = x }++-- | How to get an HTTP connection manager.+--+-- Default: @newManager tlsManagerSettings@+--+-- Since 0.1.0.0+setGetManager :: IO Manager -> UploadSettings -> UploadSettings+setGetManager x us = us { usGetManager = x }++-- | How to get the Hackage credentials.+--+-- Default: @fromAnywhere@+--+-- Since 0.1.0.0+setCredsSource :: HackageCredsSource -> UploadSettings -> UploadSettings+setCredsSource x us = us { usCredsSource = x }++-- | Save new credentials to the config file.+--+-- Default: @True@+--+-- Since 0.1.0.0+setSaveCreds :: Bool -> UploadSettings -> UploadSettings+setSaveCreds x us = us { usSaveCreds = x }++handleIO :: (E.IOException -> IO a) -> IO a -> IO a+handleIO = E.handle

@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}+import Options.Applicative   (argument, empty, metavar, some, str)+import Paths_stackage_upload (version)+import Stackage.CLI          (simpleOptions, simpleVersion)+import Stackage.Upload++main :: IO ()+main = do+    (files, ()) <- simpleOptions+        $(simpleVersion version)+        "Secure upload of packages to Hackage"+        "Secure upload of packages to Hackage"+        options+        empty+    uploader <- mkUploader defaultUploadSettings+    mapM_ (upload uploader) files+  where+    options = some (argument str (metavar "TARBALLS..."))

@@ -0,0 +1,44 @@+-- Initial stackage-upload.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                stackage-upload+version:             0.1.0.0+synopsis:            A more secure version of cabal upload which uses HTTPS+description:         For more information, see <https://www.stackage.org/package/stackage-upload>+homepage:            https://github.com/fpco/stackage-upload+license:             MIT+license-file:        LICENSE+author:              Michael Snoyman+maintainer:          michael@snoyman.com+category:            Distribution+build-type:          Simple+extra-source-files:  ChangeLog.md, README.md+cabal-version:       >=1.10++library+  exposed-modules:     Stackage.Upload+  build-depends:       base            >= 4.5 && < 5+                     , aeson+                     , bytestring      >= 0.9+                     , text            >= 0.11+                     , http-client     >= 0.4+                     , http-client-tls >= 0.2+                     , http-types+                     , directory       >= 1.1+                     , filepath        >= 1.2+  default-language:    Haskell2010++executable stackage-upload+  main-is:             stackage-upload.hs+  other-modules:       Paths_stackage_upload+  hs-source-dirs:      app+  build-depends:       base+                     , stackage-upload+                     , stackage-cli+                     , optparse-applicative+  default-language:    Haskell2010+  other-extensions:    TemplateHaskell++source-repository head+  type:     git+  location: git://github.com/fpco/stackage-upload.git