packages feed

private-hackage-uploader (empty) → 0.2.3.0

raw patch · 6 files changed

+366/−0 lines, 6 filesdep +basedep +directorydep +optparse-applicativesetup-changed

Dependencies added: base, directory, optparse-applicative, private-hackage-uploader, shelly, text

Files

+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014--2017 Iris Connect Ltd++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ private-hackage-uploader.cabal view
@@ -0,0 +1,52 @@+name:                private-hackage-uploader+version:             0.2.3.0+synopsis:            Upload a package to the public or private hackage, building its docs+description:         An opinionated utility that uploads a package to a private or public hackage, building its docs+bug-reports:         https://github.com/iconnect/hackage-uploader/issues+license:             MIT+license-file:        LICENSE+author:              Alfredo Di Napoli+maintainer:          alfredo.dinapoli@gmail.com+category:            System+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:               git+  location:           git@github.com:iconnect/hackage-uploader.git++flag library-only+     default: False++library+  hs-source-dirs:+    src+  exposed-modules:+    Distribution.Hackage.Upload+  other-modules:+    CLI+  build-depends:+      base >= 4.6 && < 5.0,+      directory >= 1.2.0.1,+      optparse-applicative >= 0.7.0.2,+      shelly >= 1.5.0,+      text >= 0.11+  default-language:   Haskell2010++executable private-hackage-uploader+  hs-source-dirs:+      src+  other-modules:+    Distribution.Hackage.Upload+  main-is:+      Main.hs+  if flag(library-only)+    Buildable: False+  else+    build-depends:+        base >= 4.6 && < 5.0,+        text >= 0.11,+        shelly >= 1.5.0,+        directory >= 1.2.0.1,+        private-hackage-uploader+  default-language:   Haskell2010
+ src/CLI.hs view
@@ -0,0 +1,3 @@+module CLI where++--to be coded
+ src/Distribution/Hackage/Upload.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+-- | Upload a package to the public or private hackage, building its docs.+module Distribution.Hackage.Upload+       ( HackageSettings(..)+       , UploadStatus(..)+       , PackageName+       , Uploader(..)+       , buildAndUploadPackage+       , hackageUpload+       , uploadDocs) where++import Prelude hiding (FilePath)+import System.Directory+import Shelly+import Data.String+import System.Info+import Text.Printf+import qualified Data.Text as T+import Data.Monoid+++--------------------------------------------------------------------------------+type PackageName = String++--------------------------------------------------------------------------------+data Uploader =+    UPL_cabal+  | UPL_stack+  deriving (Show, Eq, Enum, Bounded)++--------------------------------------------------------------------------------+-- | A small subset of all available hackage paths and flags+-- that can be specified to be used when uploading.+data HackageSettings = HackageSettings {+    hackageUrl  :: !T.Text+  , hackageUser :: !T.Text+  , hackageWhiteList :: [T.Text]+  , hackagePrivatePackage :: !Bool+  , hackagePwd  :: !T.Text+  , hackageUploader :: Uploader+  , hackageBuildDocs :: !Bool+  , hackagePackageName :: PackageName+  , hackagePackageVersion :: !T.Text+  } deriving Show+++--------------------------------------------------------------------------------+data UploadStatus = Uploaded | Skipped deriving Show+++--------------------------------------------------------------------------------+-- | Upload a package with the specified hackage settings.+hackageUpload :: HackageSettings -> IO ()+hackageUpload settings@HackageSettings{..} = shelly $ verbosely $ do+  status <- buildAndUploadPackage settings+  when hackageBuildDocs $ uploadDocs status settings++--------------------------------------------------------------------------------+cabal :: [T.Text] -> Sh ()+cabal = command_ "cabal" []++--------------------------------------------------------------------------------+stack :: [T.Text] -> Sh ()+stack = command_ "stack" []++--------------------------------------------------------------------------------+htmlLocation :: HackageSettings -> T.Text+htmlLocation HackageSettings{..} =+  T.pack "--html-location=\"" <>+  hackageUrl <>+  "/package/" <> T.pack hackagePackageName <> "-" <>+  hackagePackageVersion <> "/docs\""+++--------------------------------------------------------------------------------+contentsLocation :: HackageSettings -> T.Text+contentsLocation HackageSettings{..} =+  T.pack "--contents-location=\"" <>+  hackageUrl <>+  "/package/" <> T.pack hackagePackageName <> "-" <>+  hackagePackageVersion <> "\""+++--------------------------------------------------------------------------------+-- Strip the dev flags so that the package would pass `cabal sdist`.+-- For stack we don't call this as those should be outsourced into the+-- `stack.yaml` file. Exception has to be made for flags controlled by a flag,+-- which apparently gets rejected nevertheless..+stripDevFlags :: Uploader -> HackageSettings -> Sh ()+stripDevFlags UPL_stack HackageSettings{..} = do+  echo $ "* Not stripping dev flags as stack has been detected as the uploader.\n" <>+         "Please consider outsourcing flags like -Wall or -Werror into the stack.yaml manifest."+  let manifest = T.pack hackagePackageName <> ".cabal"+  let bakFile  = manifest <> ".bak"+  stripPerfAndTestFlags manifest bakFile+stripDevFlags UPL_cabal HackageSettings{..} = do+  echo "Stripping dev flags (if needed) ..."+  let manifest = T.pack hackagePackageName <> ".cabal"+  let bakFile  = manifest <> ".bak"+  stripCompilationFlags manifest bakFile+  stripPerfAndTestFlags manifest bakFile++--------------------------------------------------------------------------------+-- | Strip things like "-Wall" and "-Werror" from the manifest.+stripCompilationFlags :: T.Text -> T.Text -> Sh ()+stripCompilationFlags manifest bakFile = do+  let removeWError = T.pack "/.*-Werror.*$/d"+  run_ "sed" ["-i.bak", removeWError, manifest]+  run_ "rm" ["-rf", bakFile]++--------------------------------------------------------------------------------+-- | Strip things like "-fhpc".+stripPerfAndTestFlags :: T.Text -> T.Text -> Sh ()+stripPerfAndTestFlags manifest bakFile = do+  let removeHpcIf = T.pack "/.*if.*flag.*(hpc).*$/d"+  let removeHpc = T.pack "/.*ghc-options:.*-fhpc.*$/d"+  run_ "sed" ["-i.bak", removeHpcIf, manifest]+  run_ "rm" ["-rf", bakFile]+  run_ "sed" ["-i.bak", removeHpc, manifest]+  run_ "rm" ["-rf", bakFile]++--------------------------------------------------------------------------------+alreadyUploaded :: HackageSettings -> Sh Bool+alreadyUploaded HackageSettings{..} = do+  resp <- run "curl" ["-I", hackageUri]+  echo resp+  return $ "200" `T.isInfixOf` resp+  where+    hackageUri = T.pack $+      printf "%s/package/%s-%s"+             (T.unpack hackageUrl)+             hackagePackageName+             (T.unpack hackagePackageVersion)++--------------------------------------------------------------------------------+toUploader :: Uploader -> [T.Text] -> Sh ()+toUploader UPL_cabal = cabal+toUploader UPL_stack = stack++--------------------------------------------------------------------------------+-- | Build a package and upload it.+buildAndUploadPackage :: HackageSettings -> Sh UploadStatus+buildAndUploadPackage settings@HackageSettings{..} = do+  skipIt <- alreadyUploaded settings+  if skipIt+    then return Skipped+    else do+      let uploader = toUploader hackageUploader+      when (hackageUploader == UPL_cabal) $ uploader ["configure"]+      uploader ["build"]+      uploader ["sdist"]+      let fileName = fromString (hackagePackageName+                                 <> "-"+                                 <> T.unpack hackagePackageVersion)+      ddir <- distDir hackageUploader+      chdir ddir $ do+        run_ "rm"  ["-rf", toTextIgnore fileName]+        run_ "tar" ["-xzf", toTextIgnore fileName <> ".tar.gz"]+        run_ "rm"  ["-rf", toTextIgnore fileName <> ".tar.gz"]+        chdir fileName (stripDevFlags hackageUploader settings)+        run_ "tar" (extraTarFlags <> ["-czf", toTextIgnore fileName <> ".tar.gz", toTextIgnore fileName])+        echo "Uploading package to Hackage..."+        -- Use cabal for the final upload step. This is necessary+        -- as stack does not allow you to specify things like user/pwd etc.+        case (hackageUrl == "hackage.haskell.org" && hackagePrivatePackage ||+             (hackageUrl `notElem` hackageWhiteList) && hackagePrivatePackage) of+          True -> error "Cowardly refusing to upload: This package is marked as private."+          False -> do+            cabal ["upload", "-v3", "-u", hackageUser, "-p", hackagePwd, tarball fileName]+        return Uploaded++  where+    tarball fl = toTextIgnore fl <> ".tar.gz"++--------------------------------------------------------------------------------+extraTarFlags :: [T.Text]+extraTarFlags = case System.Info.os of+  "linux"  -> ["--format=ustar"]+  _        -> mempty++--------------------------------------------------------------------------------+distDir :: Uploader -> Sh FilePath+distDir UPL_cabal = return "dist"+distDir UPL_stack = escaping False (fromText . T.strip <$> run "stack" ["path", "--dist-dir"])++--------------------------------------------------------------------------------+-- | Create and upload haddocks of a package.+--+-- This uses the old method that should work with old cabals and+-- old hackage servers. TODO: update it to the method used in @cabal upload@+-- or perhaps switch to @cabal upload@ altogether as soon as in handles+-- private hackage servers and more options.+uploadDocs :: UploadStatus -> HackageSettings -> Sh ()+uploadDocs status settings@HackageSettings{..} =+  case status of+    Skipped -> do+      cabal ["configure"]+      upload_+    _ -> upload_+  where+    upload_ = do+        let docsFilename = T.pack $ printf "%s-%s-docs"+                                    hackagePackageName+                                    (T.unpack hackagePackageVersion)+        let docsTarball = docsFilename <> ".tar.gz"+        alreadyGenerated <- liftIO (doesFileExist . T.unpack $ "dist/doc/html/" <> docsTarball)+        unless alreadyGenerated $ errExit False $ do+          cabal ["haddock", "--hyperlink-source",+                 htmlLocation settings,+                 contentsLocation settings, "--executables"]+          out <- lastStderr+          let failedForTransitivity   = "transitive" `T.isInfixOf` out+          when failedForTransitivity $+            -- back off and build only libraries+            cabal ["haddock", "--hyperlink-source",+                   htmlLocation settings,+                   contentsLocation settings]+        run_ "mkdir" ["-p", "dist/doc/html"]+        chdir "dist/doc/html" $ do+          run_ "cp"  ["-r", T.pack hackagePackageName, docsFilename]+          run_ "gtar" ["-cvz", "-Hustar",+                      "-f", docsTarball, docsFilename]+          echo "Uploading docs to Hackage..."+          run_ "curl" ["-X", "PUT",+                       "-H", "Content-Type: application/x-tar",+                       "-H", "Content-Encoding: gzip",+                       "--data-binary", "@" <> docsTarball,+                       hackageUploadUrl]+    hackageUploadUrl = T.pack $+      printf "http://%s:%s@%s/package/%s-%s/docs"+             (T.unpack hackageUser)+             (T.unpack hackagePwd)+             (T.unpack $ T.replace "http://" "" hackageUrl)+             hackagePackageName+             (T.unpack hackagePackageVersion)
+ src/Main.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Distribution.Hackage.Upload+import System.Environment+import Control.Monad+import qualified Data.Text as T++main :: IO ()+main = do+   args <- getArgs+   case args of+     [url, pkg, ver, usr, pwd ] ->+       let settings = HackageSettings {+            hackageUrl = T.pack url+          , hackageUser = T.pack usr+          , hackageWhiteList = [T.pack url]+          , hackagePwd  = T.pack pwd+          , hackageUploader = UPL_cabal+          , hackagePackageName = pkg+          , hackageBuildDocs = True+          , hackagePrivatePackage = False+          , hackagePackageVersion = T.pack ver+       } in hackageUpload settings+     [pkg, ver, usr, pwd ] -> do+       putStrLn "Going to upload to main Hackage. ARE YOU SURE??? [y/n]"+       areYouSure <- getLine+       putStrLn "Are you REALLY sure??? [y/n]"+       reallySure <- getLine+       when (yesNoParse [areYouSure, reallySure]) $ do+         let settings = HackageSettings {+              hackageUrl = T.pack "http://hackage.haskell.org"+            , hackageUser = T.pack usr+            , hackageUploader = UPL_cabal+            , hackageWhiteList = ["http://hackage.haskell.org"]+            , hackagePwd  = T.pack pwd+            , hackagePackageName = pkg+            , hackageBuildDocs = True+            , hackagePrivatePackage = False+            , hackagePackageVersion = T.pack ver+         }+         hackageUpload settings+     _ -> putStrLn "Usage: [url] pkgName version username pwd"+  where+   yesNoParse :: [String] -> Bool+   yesNoParse = all parseIt++   parseIt "y" = True+   parseIt "Y" = True+   parseIt _   = False