haven (empty) → 0.1.0.0

raw patch · 4 files changed

+204/−0 lines, 4 filesdep +SHAdep +basedep +bytestringsetup-changed

Dependencies added: SHA, base, bytestring, containers, http-conduit, http-types, mtl, xml

Files

LICENSE +30/−0
Setup.hs +2/−0
haven.cabal +28/−0
src/Main.hs +144/−0

+ LICENSE view

@@ -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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ haven.cabal view

@@ -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

+ src/Main.hs view

@@ -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)