diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 0.5.0 (2021-05-30) + +- Add `--licenses` option to collect the license files for dependencies + # 0.4.3 (2021-02-06) - Use System.Console.GetOpt instead of cmdargs diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -81,11 +81,25 @@ $ cd licensor/ && stack build --exec licensor ``` +To generate a report including license files for all dependencies, +use the `--licenses` option and redirect the output to a file: + +``` +$ licensor --quiet --licenses > licenses.md +``` + +See [licenses.md](licenses.md) for an example. + +NOTE: This is currently using the Hackage API, which doesn't require +building any package, but could probably be improved to use the +installed packages if present. + For more information, run `licensor --help`: ``` usage: licensor -q, -s --quiet, --silent Quiet/silent mode + --licenses Fetch license files -h --help Display help message -V --version Print version information ``` @@ -139,24 +153,31 @@ ### License report -Licensor (0.4.3) depends on the following libraries: +Licensor (0.5.0) depends on the following libraries: Library | License ------------------------- | ------------------------- Cabal | BSD-3 base | BSD-3 +bytestring | BSD-3 containers | BSD-3 directory | BSD-3 +http-client | MIT +http-client-tls | MIT process | BSD-3 +tar | BSD-3 +temporary | BSD-3 +zlib | BSD-3 And the following licenses (including transitive dependencies): License | Number of libraries ------------------------- | ------------------------- BSD-2 | 1 -BSD-3 | 20 +BSD-3 | 22 +MIT | 5 -(Tested with Licensor 0.4.3, Stack 2.5.1, and LTS Haskell 15.8.) +(Tested with Licensor 0.5.0, Stack 2.7.1, and LTS Haskell 17.13.) ## Additional resources diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -17,8 +17,8 @@ import Distribution.Text -- base -import Control.Monad (unless) -import Data.Foldable (for_) +import Control.Monad (unless, when) +import Data.Foldable (for_, traverse_) import Data.List (foldl', intercalate) import Data.Version (showVersion) import System.Console.GetOpt @@ -47,11 +47,14 @@ unwords [progName, showVersion version] -optDescrs :: [OptDescr (Bool -> IO Bool)] +optDescrs :: [OptDescr ((Bool, Bool) -> IO (Bool, Bool))] optDescrs = [ Option ['q', 's'] ["quiet", "silent"] - (NoArg (\_ -> pure False)) + (NoArg (\(_, b) -> pure (False, b))) "Quiet/silent mode" + , Option [] ["licenses"] + (NoArg (\(a, _) -> pure (a, True))) + "Fetch license files" , Option ['h'] ["help"] (NoArg (\_ -> exitWith prettyUsageInfo)) "Display help message" @@ -72,7 +75,7 @@ progName <- getProgName case getOpt' Permute optDescrs args of (opts, [], [], []) -> do - verbose <- foldl' (>>=) (pure True) opts + verbose <- foldl' (>>=) (pure (True, False)) opts main' verbose (_, command:_, _, _) -> do hPutStrLn stderr ("unknown command: " <> command) @@ -87,8 +90,8 @@ exitFailure -main' :: Bool -> IO () -main' verbose = do +main' :: (Bool, Bool) -> IO () +main' (verbose, fetchLicenses) = do let silent = not verbose maybePackage <- getPackage @@ -105,6 +108,9 @@ die "Error: No stack.yaml file found." Just pd -> do + when fetchLicenses $ do + putStrLn $ "# " <> display (package pd) + putStrLn "" putStrLn $ "Package: " <> display (package pd) @@ -119,24 +125,27 @@ case (maybeDependencies, maybeLicenses) of (Just dependencies, Just licenses) -> do - (dependenciesByLicense', failed) <- + (dependenciesByLicense, failed) <- orderPackagesByLicense silent pid licenses dependencies - let dependenciesByLicense = fmap (Set.map display) dependenciesByLicense' - for_ (Map.keys dependenciesByLicense) $ \li -> let n = dependenciesByLicense Map.! li in do - putStrLn "-----" + when fetchLicenses $ do + putStrLn "" + putStrLn $ "## " <> display li + putStrLn "" putStrLn $ show (Set.size n) <> (if Set.size n == 1 then " package " else " packages ") <> "licensed under " <> display li <> ": " - <> intercalate ", " (Set.toList n) + <> intercalate ", " (Set.toList (Set.map display n)) + when fetchLicenses $ + traverse_ getPackageLicenseFiles (Set.toList n) unless (null failed) $ do putStr "Failed: " diff --git a/licensor.cabal b/licensor.cabal --- a/licensor.cabal +++ b/licensor.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: licensor -version: 0.4.3 +version: 0.5.0 synopsis: A license compatibility helper description: A license compatibility helper. category: Distribution @@ -21,8 +21,8 @@ common common build-depends: - Cabal >= 3.0 - , base >= 4.8 && < 5 + Cabal >= 3.0.1 && < 3.3 + , base >= 4.13.0 && < 4.15 , containers , directory default-language: Haskell2010 @@ -41,7 +41,13 @@ autogen-modules: Paths_licensor build-depends: - process + bytestring + , http-client >= 0.6.4 && < 0.8 + , http-client-tls >= 0.3.5 && < 0.4 + , process + , tar >= 0.5.1 && < 0.6 + , temporary >= 1.3 && < 1.4 + , zlib >= 0.6.2 && < 0.7 executable licensor import: diff --git a/src/Licensor.hs b/src/Licensor.hs --- a/src/Licensor.hs +++ b/src/Licensor.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} ---------------------------------------------------------------------- -- | @@ -16,6 +17,7 @@ , getDependencies , getLicenses , getPackage + , getPackageLicenseFiles , orderPackagesByLicense , version ) @@ -24,13 +26,19 @@ -- base import qualified Control.Exception as Exception import Control.Monad (unless) +import Data.Traversable (for) import Data.Version (Version) +-- bytestring +import qualified Data.ByteString.Lazy as LBS + -- Cabal import Distribution.License (License) -import Distribution.Package (PackageIdentifier(..), PackageName) -import Distribution.PackageDescription (PackageDescription, packageDescription) -import Distribution.PackageDescription.Parsec (readGenericPackageDescription) +import Distribution.Package (PackageIdentifier(..), PackageName, unPackageName) +import Distribution.PackageDescription + (PackageDescription, licenseFiles, packageDescription) +import Distribution.PackageDescription.Parsec + (parseGenericPackageDescriptionMaybe, readGenericPackageDescription) import Distribution.Pretty (Pretty) import Distribution.Simple.Utils (comparing, findPackageDesc) import Distribution.Text (display, simpleParse) @@ -45,13 +53,27 @@ -- directory import System.Directory (getCurrentDirectory) +-- http-client +import Network.HTTP.Client (httpLbs, parseRequest, responseBody) + +-- http-client-tls +import Network.HTTP.Client.TLS (getGlobalManager) + -- licensor import qualified Paths_licensor -- process import System.Process (readProcess) +-- tar +import qualified Codec.Archive.Tar as Tar +-- temporary +import qualified System.IO.Temp as Temp + +-- zlib +import qualified Codec.Compression.GZip as GZip + -- | -- -- @@ -206,3 +228,42 @@ version :: Version version = Paths_licensor.version + + +getPackageLicenseFiles :: PackageIdentifier -> IO (Maybe [String]) +getPackageLicenseFiles packageIdentifier = + getPackageLicenseFiles' + (unPackageName (pkgName packageIdentifier)) + (display packageIdentifier) + +getPackageLicenseFiles' :: String -> String -> IO (Maybe [String]) +getPackageLicenseFiles' packageName packageId = do + putStrLn "" + putStrLn ("### " <> packageId) + putStrLn "" + manager <- getGlobalManager + genPkgDescrReq <- parseRequest (mkRequest (packageName <> ".cabal")) + genPkgDescr <- LBS.toStrict . responseBody <$> httpLbs genPkgDescrReq manager + let mGenPkgDescr = parseGenericPackageDescriptionMaybe genPkgDescr + case licenseFiles . packageDescription <$> mGenPkgDescr of + Just files -> do + pkgReq <- parseRequest (mkRequest (packageId <> ".tar.gz")) + pkg <- responseBody <$> httpLbs pkgReq manager + let entries = Tar.read (GZip.decompress pkg) + pkgLicenseFiles <- + Temp.withSystemTempDirectory packageId $ \tmpDir -> do + Tar.unpack tmpDir entries + for files $ \file -> do + contents <- readFile (tmpDir <> "/" <> packageId <> "/" <> file) + putStrLn (file <> ":") + putStrLn "" + putStrLn "```" + putStrLn contents + putStrLn "```" + pure file + pure (Just pkgLicenseFiles) + Nothing -> + pure Nothing + where + mkRequest r = + "GET https://hackage.haskell.org/package/" <> packageId <> "/" <> r