diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Ali Abrar, Will Fancher + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ali Abrar, Will Fancher nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 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/haven.cabal b/haven.cabal new file mode 100644 --- /dev/null +++ b/haven.cabal @@ -0,0 +1,28 @@ +name: haven +synopsis: Recursively retrieve maven dependencies +description: A haskell project that retrieves maven package dependencies recursively given a starting set of packages. The primary output format is a list of nix sets describing the maven packages. +category: Java +version: 0.1.0.0 +license: BSD3 +license-file: LICENSE +author: Ali Abrar, Will Fancher +maintainer: maintenance@obsidian.systems +build-type: Simple +cabal-version: >=1.10 + +executable haven + main-is: Main.hs + build-depends: base >=4.9 && <4.10 + , bytestring + , containers + , http-conduit + , http-types + , mtl + , SHA + , xml + hs-source-dirs: src + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/obsidiansystems/haven diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,144 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import Control.Monad.State +import Data.Digest.Pure.SHA +import Data.List +import Data.Maybe +import Data.Semigroup +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Traversable +import Network.HTTP.Conduit +import Network.HTTP.Types.Status +import System.Environment +import Text.XML.Light + +-- | Takes multiple maven package descriptions as command line arguments +-- and finds the dependencies of those maven packages. +-- Package descriptions should be of the form @groupid:artifactid:version@ +main :: IO () +main = do + mavens <- getArgs + mgr <- newManager tlsManagerSettings + (_, deps) <- flip runStateT Set.empty $ traverse (recurseDependencies mgr) $ parseMaven <$> mavens + putStrLn $ "[" <> (concatMap toNix deps) <> "]" + + +data Maven = Maven + { _maven_groupId :: String + , _maven_artifactId :: String + , _maven_version :: String + } + deriving (Show, Read, Eq, Ord) + +data MavenNix = MavenNix + { _mavenNix_maven :: Maven + , _mavenNix_jarSha256 :: Maybe (Digest SHA256State) + , _mavenNix_pomSha256 :: Maybe (Digest SHA256State) + } + deriving (Show, Eq, Ord) + +-- | Parses strings of the form @groupid:artifactid:version@, +-- e.g., @com.android.build.tools:gradle:2.3.0@ +parseMaven :: String -> Maven +parseMaven s = + let (groupId, _:rest) = break (==':') s + (artifactId, _:version) = break (==':') rest + in Maven groupId artifactId version + +-- | Create a nix record for a hashed maven package +toNix :: MavenNix -> String +toNix m = + let mvn = _mavenNix_maven m + showHash h = fromMaybe "null" $ (\x -> "\"" <> x <> "\"") . showDigest <$> h + in unlines + [ " { artifactId = \"" <> _maven_artifactId mvn <> "\";" + , " groupId = \"" <> _maven_groupId mvn <> "\";" + , " version = \"" <> _maven_version mvn <> "\";" + , " jarSha256 = " <> showHash (_mavenNix_jarSha256 m) <> ";" + , " pomSha256 = " <> showHash (_mavenNix_pomSha256 m) <> "; }" + ] + +-- | Maven repositories in which to look for packages +mirrors :: [String] +mirrors = + [ "https://repo1.maven.org/maven2/" + , "https://jcenter.bintray.com/" + , "http://central.maven.org/maven2/" + ] + +-- | Hash a particular maven package's .pom and .jar files and parse the .pom file as xml +fetch :: [String] -> Manager -> Maven -> IO (MavenNix, Element) +fetch (mirror:fallbacks) mgr mvn = do + let version = takeWhile (/= ',') $ dropWhile (\c -> c == '[' || c == '(') $ _maven_version mvn + url ext = mconcat + [ mirror + , (\x -> if x == '.' then '/' else x) <$> _maven_groupId mvn + , "/" + , _maven_artifactId mvn + , "/" + , version + , "/" + , _maven_artifactId mvn + , "-" + , version + , ext + ] + hash rsp = if responseStatus rsp == status200 + then Just $ sha256 $ responseBody rsp + else Nothing + reqPom <- parseRequest $ url ".pom" + reqJar <- parseRequest $ url ".jar" + pom <- httpLbs reqPom mgr + jar <- httpLbs reqJar mgr + if responseStatus jar /= status200 && responseStatus pom /= status200 + then fetch fallbacks mgr mvn + else return $ + let Just e = parseXMLDoc $ responseBody pom + mvnNix = MavenNix + { _mavenNix_maven = mvn + , _mavenNix_jarSha256 = hash jar + , _mavenNix_pomSha256 = hash pom + } + in (mvnNix, e) +fetch [] _ mvn = error $ mconcat + [ "Error: Could not find " + , _maven_groupId mvn + , ":" + , _maven_artifactId mvn + , ":" + , _maven_version mvn + , " in any mirror." + ] + +-- | Extract the dependencies from a package's pom xml +getDepsFor :: Element -> [Maven] +getDepsFor x = do + deps <- findChildrenByTagName "dependencies" x + dep <- findChildrenByTagName "dependency" deps + groupId <- findChildrenByTagName "groupId" dep + artifactId <- findChildrenByTagName "artifactId" dep + version <- findChildrenByTagName "version" dep + let optional = case findChildrenByTagName "optional" dep of + [] -> False + xs -> any ((=="true") . strContent) xs + guard (not ("$" `isPrefixOf` strContent version) && not optional) + return $ Maven + { _maven_groupId = strContent groupId + , _maven_artifactId = strContent artifactId + , _maven_version = strContent version + } + +-- | Given a starting maven package, retrieve its dependencies recursively +recurseDependencies :: Manager -> Maven -> StateT (Set MavenNix) IO () +recurseDependencies mgr mvn = do + s <- get + when (not $ any (\mvnNix -> _mavenNix_maven mvnNix == mvn) s) $ do + (mvnNix, e) <- liftIO $ fetch mirrors mgr mvn + modify $ Set.insert mvnNix + void $ traverse (recurseDependencies mgr) $ getDepsFor e + +-- | Retrieve an XML Element's children by tag name +findChildrenByTagName :: String -> Element -> [Element] +findChildrenByTagName n = filterChildren (\a -> qName (elName a) == n)