diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/private-hackage-uploader.cabal b/private-hackage-uploader.cabal new file mode 100644 --- /dev/null +++ b/private-hackage-uploader.cabal @@ -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 diff --git a/src/CLI.hs b/src/CLI.hs new file mode 100644 --- /dev/null +++ b/src/CLI.hs @@ -0,0 +1,3 @@ +module CLI where + +--to be coded diff --git a/src/Distribution/Hackage/Upload.hs b/src/Distribution/Hackage/Upload.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/Hackage/Upload.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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