haven 0.1.0.0 → 0.2.0.0
raw patch · 2 files changed
+169/−90 lines, 2 filesdep +directorydep +filepathdep +processdep ~base
Dependencies added: directory, filepath, process, temporary, transformers
Dependency ranges changed: base
Files
- haven.cabal +8/−2
- src/Main.hs +161/−88
haven.cabal view
@@ -2,11 +2,11 @@ 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+version: 0.2.0.0 license: BSD3 license-file: LICENSE author: Ali Abrar, Will Fancher-maintainer: maintenance@obsidian.systems+maintainer: maintainer@obsidian.systems build-type: Simple cabal-version: >=1.10 @@ -20,8 +20,14 @@ , mtl , SHA , xml+ , process+ , temporary+ , filepath+ , directory+ , transformers hs-source-dirs: src default-language: Haskell2010+ ghc-options: -O2 -Wall source-repository head type: git
src/Main.hs view
@@ -1,30 +1,92 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where -import Control.Monad.State+import Control.Applicative+import Control.Monad+import Control.Monad.Reader+import Control.Monad.Trans.Maybe+import Control.Monad.Writer hiding ((<>))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.Char import Data.Digest.Pure.SHA-import Data.List+import Data.Foldable+import Data.Map (Map)+import qualified Data.Map as Map 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.Conduit hiding (path) import Network.HTTP.Types.Status+import System.Directory import System.Environment+import System.Exit+import System.FilePath+import System.IO+import System.IO.Temp+import System.Process import Text.XML.Light +data HavenEnv = HavenEnv+ { _havenEnv_manager :: Manager+ , _havenEnv_repos :: Map String String+ , _havenEnv_m2Local :: FilePath+ }+ -- | 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) <> "]"+ [pomXml] <- getArgs+ Just repos <- fmap parseRepos . parseXMLDoc <$> BS.readFile pomXml + withSystemTempFile "out.txt" $ \tmpFile hTmpFile -> withSystemTempDirectory "m2" $ \m2Repo -> do+ let havenEnv = HavenEnv mgr repos m2Repo+ hProc <- runProcess+ "mvn"+ ["-f", pomXml, "dependency:tree", "-Dverbose", "-DoutputFile=" <> tmpFile, "-Dmaven.repo.local=" <> m2Repo]+ Nothing+ Nothing+ Nothing+ (Just stderr)+ Nothing+ ExitSuccess <- waitForProcess hProc + _ <- hGetLine hTmpFile -- skip local package name+ (_, mavenNixs) <- runWriterT $ fix $ \loop -> do+ e <- liftIO $ hIsEOF hTmpFile+ unless e $ do+ line <- liftIO $ hGetLine hTmpFile+ let mavenGrArTyVr = dropWhile (not . isAlphaNum) line -- Skip leading symbols; we don't care about parsing this+ (groupId, ':':mavenArTyVr) = break (==':') mavenGrArTyVr+ (artifactId, ':':mavenTyVr) = break (==':') mavenArTyVr+ (fileType, ':':mavenVr) = break (==':') mavenTyVr -- File type that Maven has decided on+ version = takeWhile (/=':') mavenVr -- Version number+ maven = Maven groupId artifactId version+ unless (all isSpace line) $ do+ mMvnNix <- runReaderT (runMaybeT $ fetch fileType maven) havenEnv+ case mMvnNix of+ Just mvnNix -> tell $ Set.fromList mvnNix+ Nothing -> liftIO $ do+ hPutStrLn stderr $ "Failed for " <> unlines [show fileType, show maven]+ exitFailure+ loop+ putStrLn "["+ traverse_ (putStrLn . toNix) mavenNixs+ putStrLn "]"++parseRepos :: Element -> Map String String+parseRepos pom = Map.fromList $ do+ repoList <- findChildrenByTagName "repositories" pom+ repo <- findChildrenByTagName "repository" repoList+ repoId <- findChildrenByTagName "id" repo+ repoUrl <- findChildrenByTagName "url" repo+ return (strContent repoId, strContent repoUrl)+ data Maven = Maven { _maven_groupId :: String , _maven_artifactId :: String@@ -34,19 +96,13 @@ data MavenNix = MavenNix { _mavenNix_maven :: Maven+ , _mavenNix_repo :: String , _mavenNix_jarSha256 :: Maybe (Digest SHA256State) , _mavenNix_pomSha256 :: Maybe (Digest SHA256State)+ , _mavenNix_aarSha256 :: 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 =@@ -56,89 +112,106 @@ [ " { artifactId = \"" <> _maven_artifactId mvn <> "\";" , " groupId = \"" <> _maven_groupId mvn <> "\";" , " version = \"" <> _maven_version mvn <> "\";"+ , " repo = \"" <> _mavenNix_repo m <> "\";" , " jarSha256 = " <> showHash (_mavenNix_jarSha256 m) <> ";"- , " pomSha256 = " <> showHash (_mavenNix_pomSha256 m) <> "; }"+ , " pomSha256 = " <> showHash (_mavenNix_pomSha256 m) <> ";"+ , " aarSha256 = " <> showHash (_mavenNix_aarSha256 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/"- ]+-- | Gets the repo with the given id, calling 'empty' when it's not present+getRepo :: (MonadReader HavenEnv m, MonadPlus m) => String -> m String+getRepo repoId = do+ repos <- asks _havenEnv_repos+ maybe empty pure $ Map.lookup repoId repos --- | 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- , ":"+m2Directory :: Maven -> String+m2Directory mvn = foldl (</>) ""+ [ (\x -> if x == '.' then '/' else x) <$> _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- }+-- | Gets a given artifact for a 'Maven' and hashes it. It will first+-- check the local m2 dir, and then it will try to download it from+-- the online repo. If both fail, an error is logged to 'stderr', and+-- 'empty' is called.+getArtifactFile+ :: (MonadIO m, MonadPlus m, MonadReader HavenEnv m)+ => Maven+ -> String+ -> String+ -> m BL.ByteString+getArtifactFile mvn ext repo = do+ mgr <- asks _havenEnv_manager+ m2Repo <- asks _havenEnv_m2Local+ let m2Dir = m2Directory mvn+ m2Filename = _maven_artifactId mvn <> "-" <> _maven_version mvn <> ext+ path = m2Repo </> m2Dir </> m2Filename+ m2ArtifactExists <- liftIO $ doesFileExist path+ if m2ArtifactExists then liftIO (BL.readFile path) else do+ let url = repo </> m2Dir </> m2Filename+ req <- liftIO $ parseRequest url+ liftIO $ hPutStrLn stderr $ "Getting URL: " <> url+ rsp <- liftIO $ httpLbs req mgr+ when (responseStatus rsp /= status200) $ do+ liftIO $ hPutStrLn stderr $ "Failed to get URL: " <> url+ empty+ return $ responseBody rsp --- | 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+-- | Hash a particular maven package's .pom and .jar files and parse the .pom file as xml+fetch+ :: (MonadIO m, MonadReader HavenEnv m)+ => String+ -> Maven+ -> MaybeT m [MavenNix]+fetch fileType mvn = do+ m2Repo <- asks _havenEnv_m2Local+ let m2Dir = m2Repo </> m2Directory mvn+ findRepoId = takeWhile (/='=') . drop 1 . dropWhile (/='>') + repoId <- findRepoId <$> liftIO (readFile (m2Dir </> "_remote.repositories"))+ repo <- getRepo repoId++ pom <- runMaybeT $ getArtifactFile mvn ".pom" repo+ + let noArtifacts = MavenNix+ { _mavenNix_maven = mvn+ , _mavenNix_repo = repo+ , _mavenNix_jarSha256 = Nothing+ , _mavenNix_pomSha256 = sha256 <$> pom+ , _mavenNix_aarSha256 = Nothing+ }++ parents <- fmap (fromMaybe []) $ for pom $ \pomContents -> do+ pomEl <- maybe empty pure $ parseXMLDoc pomContents+ fmap mconcat $ traverse (fetch "pom") $ do+ parent <- findChildrenByTagName "parent" pomEl+ groupId <- strContent <$> findChildrenByTagName "groupId" parent+ artifactId <- strContent <$> findChildrenByTagName "artifactId" parent+ version <- strContent <$> findChildrenByTagName "version" parent+ return $ Maven groupId artifactId version++ -- TODO: Match the 'type' to the correct file extension.+ -- The extension is _usually_ equal to the type, but it's not necessarily.+ -- See: https://maven.apache.org/pom.html#Dependencies+ mavenNix <- asum+ [ do+ guard (fileType == "jar")+ jarSha <- sha256 <$> getArtifactFile mvn ".jar" repo+ return $ noArtifacts { _mavenNix_jarSha256 = Just jarSha }+ , do+ guard (fileType == "aar")+ aarSha <- sha256 <$> getArtifactFile mvn ".aar" repo+ return $ noArtifacts { _mavenNix_aarSha256 = Just aarSha }+ , do+ guard (fileType == "pom") -- This is used when getting parents+ return noArtifacts+ ]+ return (mavenNix:parents)+ -- | Retrieve an XML Element's children by tag name findChildrenByTagName :: String -> Element -> [Element] findChildrenByTagName n = filterChildren (\a -> qName (elName a) == n)++firstChildByTagName :: String -> Element -> Maybe Element+firstChildByTagName n = listToMaybe . findChildrenByTagName n