diff --git a/hscli.cabal b/hscli.cabal index 4b0c8b529..744f8079f 100644 --- a/hscli.cabal +++ b/hscli.cabal @@ -107,6 +107,8 @@ library LabeledGraphing Parse.XML Prologue + Strategy.Cocoapods.Podfile + Strategy.Cocoapods.PodfileLock Strategy.Carthage Strategy.Go.GlideLock Strategy.Go.GoList @@ -161,6 +163,8 @@ test-suite tests -- cabal-fmt: expand test other-modules: + Cocoapods.PodfileTest + Cocoapods.PodfileLockTest Carthage.CarthageTest Go.GlideLockTest Go.GoListTest diff --git a/src/DepTypes.hs b/src/DepTypes.hs index f0b274b53..6fce29e9f 100644 --- a/src/DepTypes.hs +++ b/src/DepTypes.hs @@ -22,6 +22,7 @@ data DepType = | NodeJSType -- ^ NPM registry (or similar) | NuGetType -- ^ Nuget registry | PipType -- ^ Pip registry + | PodType -- ^ Cocoapods registry | GoType -- ^ Go dependency -- TODO: does this break the "location" abstraction? | CarthageType -- ^ A Carthage dependency -- effectively a "git" dependency. Name is repo path and version is tag/branch/hash diff --git a/src/Discovery.hs b/src/Discovery.hs index 53e61bb57..e97ee27aa 100644 --- a/src/Discovery.hs +++ b/src/Discovery.hs @@ -3,6 +3,8 @@ module Discovery , strategyGroups ) where +import qualified Strategy.Cocoapods.Podfile as Podfile +import qualified Strategy.Cocoapods.PodfileLock as PodfileLock import qualified Strategy.Carthage as Carthage import qualified Strategy.Go.GoList as GoList import qualified Strategy.Go.Gomod as Gomod @@ -31,7 +33,10 @@ import Types discoverFuncs :: [Discover] discoverFuncs = - [ GoList.discover + [ Podfile.discover + , PodfileLock.discover + + , GoList.discover , Gomod.discover , GopkgToml.discover , GopkgLock.discover @@ -67,7 +72,11 @@ discoverFuncs = strategyGroups :: [StrategyGroup] strategyGroups = - [ StrategyGroup "dotnet" + [ StrategyGroup "cocoapods" + [ SomeStrategy Podfile.strategy + , SomeStrategy PodfileLock.strategy + ] + , StrategyGroup "dotnet" [ SomeStrategy PackagesConfig.strategy , SomeStrategy PackageReference.strategy , SomeStrategy ProjectAssetsJson.strategy diff --git a/src/Strategy/Cocoapods/Podfile.hs b/src/Strategy/Cocoapods/Podfile.hs new file mode 100644 index 000000000..44b90784f --- /dev/null +++ b/src/Strategy/Cocoapods/Podfile.hs @@ -0,0 +1,161 @@ +module Strategy.Cocoapods.Podfile + ( discover + , strategy + , analyze + , configure + , parsePodfile + + , Pod (..) + , Podfile (..) + , PropertyType (..) + ) where + +import Prologue + +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import Polysemy +import Polysemy.Input +import Polysemy.Output + +import DepTypes +import Discovery.Walk +import Effect.ReadFS +import Graphing (Graphing, unfold) +import Types +import Text.Megaparsec hiding (label) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L + +discover :: Discover +discover = Discover + { discoverName = "podfile" + , discoverFunc = discover' + } + +discover' :: Members '[Embed IO, Output ConfiguredStrategy] r => Path Abs Dir -> Sem r () +discover' = walk $ \_ _ files -> do + for_ files $ \f -> + when (fileName f == "Podfile") $ output (configure f) + walkContinue + +strategy :: Strategy BasicFileOpts +strategy = Strategy + { strategyName = "podfile" + , strategyAnalyze = \opts -> analyze & fileInputParser parsePodfile (targetFile opts) + , strategyModule = parent . targetFile + , strategyOptimal = Optimal + , strategyComplete = Complete + } + +configure :: Path Rel File -> ConfiguredStrategy +configure = ConfiguredStrategy strategy . BasicFileOpts + +analyze :: Member (Input Podfile) r => Sem r (Graphing Dependency) +analyze = buildGraph <$> input + +buildGraph :: Podfile -> Graphing Dependency +buildGraph podfile = unfold direct (const []) toDependency + where + direct = pods podfile + toDependency Pod{..} = + Dependency { dependencyType = PodType + , dependencyName = name + , dependencyVersion = case version of + Nothing -> Nothing + Just ver -> Just (CEq ver) + , dependencyLocations = case M.lookup SourceProperty properties of + Just repo -> [repo] + _ -> [source podfile] + , dependencyTags = M.empty + } + +type Parser = Parsec Void Text + +data Pod = Pod + { name :: Text + , version :: Maybe Text + , properties :: Map PropertyType Text + } deriving (Eq, Ord, Show, Generic) + +data PropertyType = GitProperty | CommitProperty | SourceProperty | PathProperty + deriving (Eq, Ord, Show, Generic) + +data Podfile = Podfile + { pods :: [Pod] + , source :: Text + } deriving (Eq, Ord, Show, Generic) + +data Line = + PodLine Pod + | SourceLine Text + deriving (Eq, Ord, Show, Generic) + +parsePodfile :: Parser Podfile +parsePodfile = linesToPodfile (Podfile [] "") . concat <$> ((try podParser <|> findSource <|> ignoredLine) `sepBy` eol) <* eof + +linesToPodfile :: Podfile -> [Line] -> Podfile +linesToPodfile file (PodLine pod : xs) = linesToPodfile (file { pods = pod : pods file }) xs +linesToPodfile file (SourceLine sourceLine : xs) = linesToPodfile (file { source = sourceLine }) xs +linesToPodfile file [] = file + +findSource :: Parser [Line] +findSource = do + _ <- chunk "source \'" + source <- takeWhileP (Just "source parser") (/= '\'') + _ <- char '\'' + pure [SourceLine source] + +podParser :: Parser [Line] +podParser = do + sc + _ <- symbol "pod" + name <- stringLiteral + version <- optional (try (comma *> stringLiteral)) + properties <- many property + _ <- restOfLine + pure [PodLine $ Pod name version (M.fromList properties)] + +comma :: Parser () +comma = () <$ symbol "," + +property :: Parser (PropertyType, Text) +property = do + comma + propertyType <- choice + [ GitProperty <$ symbol ":git" + , CommitProperty <$ symbol ":commit" + , SourceProperty <$ symbol ":source" + , PathProperty <$ symbol ":path" + ] + _ <- symbol "=>" + value <- stringLiteral + pure (propertyType, value) + +symbol :: Text -> Parser Text +symbol = lexeme . chunk + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +stringLiteral :: Parser Text +stringLiteral = T.pack <$> go + where + go = (char '"' *> manyTill L.charLiteral (char '"')) + <|> (char '\'' *> manyTill L.charLiteral (char '\'')) + +sc :: Parser () +sc = L.space (void $ some (char ' ')) (L.skipLineComment "#") empty + +restOfLine :: Parser Text +restOfLine = takeWhileP (Just "ignored") (not . isEndLine) + +isEndLine :: Char -> Bool +isEndLine '\n' = True +isEndLine '\r' = True +isEndLine _ = False + +ignoredLine :: Parser [Line] +ignoredLine = do + _ <- restOfLine + pure [] \ No newline at end of file diff --git a/src/Strategy/Cocoapods/PodfileLock.hs b/src/Strategy/Cocoapods/PodfileLock.hs new file mode 100644 index 000000000..03faa5deb --- /dev/null +++ b/src/Strategy/Cocoapods/PodfileLock.hs @@ -0,0 +1,229 @@ + +module Strategy.Cocoapods.PodfileLock + ( discover + , strategy + , analyze + , configure + , findSections + + , Dep (..) + , Pod (..) + , Section (..) + ) where + +import Prologue + +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import qualified Data.Char as C +import Polysemy +import Polysemy.Input +import Polysemy.Output + +import DepTypes +import Discovery.Walk +import Effect.LabeledGrapher +import Effect.ReadFS +import Graphing (Graphing) +import Types +import Text.Megaparsec hiding (label) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L + +discover :: Discover +discover = Discover + { discoverName = "podfilelock" + , discoverFunc = discover' + } + +discover' :: Members '[Embed IO, Output ConfiguredStrategy] r => Path Abs Dir -> Sem r () +discover' = walk $ \_ _ files -> do + for_ files $ \f -> + when (fileName f == "Podfile.lock") $ output (configure f) + walkContinue + +strategy :: Strategy BasicFileOpts +strategy = Strategy + { strategyName = "podfile-lock" + , strategyAnalyze = \opts -> analyze & fileInputParser findSections (targetFile opts) + , strategyModule = parent . targetFile + , strategyOptimal = Optimal + , strategyComplete = Complete + } + +configure :: Path Rel File -> ConfiguredStrategy +configure = ConfiguredStrategy strategy . BasicFileOpts + +analyze :: Member (Input [Section]) r => Sem r (Graphing Dependency) +analyze = buildGraph <$> input + +newtype PodfilePkg = PodfilePkg { pkgName :: Text } + deriving (Eq, Ord, Show, Generic) + +type instance PkgLabel PodfilePkg = PodfileLabel + +newtype PodfileLabel = + PodfileVersion Text + deriving (Eq, Ord, Show, Generic) + +toDependency :: PodfilePkg -> Set PodfileLabel -> Dependency +toDependency pkg = foldr applyLabel start + where + + start :: Dependency + start = Dependency + { dependencyType = PodType + , dependencyName = pkgName pkg + , dependencyVersion = Nothing + , dependencyLocations = [] + , dependencyTags = M.empty + } + + applyLabel :: PodfileLabel -> Dependency -> Dependency + applyLabel (PodfileVersion ver) dep = dep { dependencyVersion = Just (CEq ver) } + +buildGraph :: [Section] -> Graphing Dependency +buildGraph sections = run . withLabeling toDependency $ + traverse_ addSection sections + where + addSection :: Member (LabeledGrapher PodfilePkg) r => Section -> Sem r () + addSection (DependencySection deps) = traverse_ (direct . PodfilePkg . depName) deps + addSection (PodSection pods) = traverse_ addSpec pods + addSection _ = pure () + + addSpec :: Member (LabeledGrapher PodfilePkg) r => Pod -> Sem r () + addSpec pod = do + let pkg = PodfilePkg (name pod) + -- add edges between spec and specdeps + traverse_ (edge pkg . PodfilePkg . depName) (specs pod) + -- add a label for version + label pkg (PodfileVersion (version pod)) + +type Parser = Parsec Void Text + +data Section = + PodSection [Pod] + | DependencySection [Dep] + | SpecRepos [Remote] + | ExternalSources [SourceDep] + | CheckoutOptions [SourceDep] + | UnknownSection Text + deriving (Eq, Ord, Show, Generic) + +newtype Dep = Dep + { depName :: Text + } deriving (Eq, Ord, Show, Generic) + +data SourceDep = SourceDep + { sDepName :: Text + , tags :: Map Text Text + } deriving (Eq, Ord, Show, Generic) + +data Pod = Pod + { name :: Text + , version :: Text + , specs :: [Dep] + } deriving (Eq, Ord, Show, Generic) + +data Remote = Remote + { location :: Text + , deps :: [Dep] + } deriving (Eq, Ord, Show, Generic) + +findSections :: Parser [Section] +findSections = many (try podSectionParser <|> try dependenciesSectionParser <|> try specRepoParser <|> try externalSourcesParser <|> try checkoutOptionsParser <|> try emptySection) <* eof + +emptySection :: Parser Section +emptySection = do + emptyLine <- restOfLine + _ <- eol + pure $ UnknownSection emptyLine + +podSectionParser :: Parser Section +podSectionParser = sectionParser "PODS:" PodSection podParser + +dependenciesSectionParser :: Parser Section +dependenciesSectionParser = sectionParser "DEPENDENCIES:" DependencySection depParser + +specRepoParser :: Parser Section +specRepoParser = sectionParser "SPEC REPOS:" SpecRepos remoteParser + +externalSourcesParser :: Parser Section +externalSourcesParser = sectionParser "EXTERNAL SOURCES:" ExternalSources externalDepsParser + +checkoutOptionsParser :: Parser Section +checkoutOptionsParser = sectionParser "CHECKOUT OPTIONS:" CheckoutOptions externalDepsParser + +sectionParser :: Text -> ([a] -> Section) -> Parser a -> Parser Section +sectionParser section lambda parser = L.nonIndented scn (L.indentBlock scn p) + where + p = do + _ <- chunk section + return (L.IndentMany Nothing (pure . lambda) parser) + +externalDepsParser :: Parser SourceDep +externalDepsParser = L.indentBlock scn p + where + p = do + depName <- lexeme (takeWhileP (Just "external dep parser") (/= ':')) + _ <- restOfLine + return (L.IndentMany Nothing (\exDeps -> pure $ SourceDep depName $ M.fromList exDeps) tagParser) + +tagParser :: Parser (Text, Text) +tagParser = do + _ <- chunk ":" + tag <- lexeme (takeWhileP (Just "tag parser") (/= ':')) + _ <- chunk ": " + value <- restOfLine + pure (tag, value) + +remoteParser :: Parser Remote +remoteParser = L.indentBlock scn p + where + p = do + location <- restOfLine + pure (L.IndentMany Nothing (\deps -> pure $ Remote (T.dropWhileEnd (==':') location) deps) depParser) + +podParser :: Parser Pod +podParser = L.indentBlock scn p + where + p = do + _ <- chunk "- " + name <- findDep + version <- findVersion + _ <- restOfLine + pure (L.IndentMany Nothing (\deps -> pure $ Pod name version deps) depParser) + +depParser :: Parser Dep +depParser = do + _ <- chunk "- " + name <- findDep + _ <- restOfLine + pure $ Dep name + +findDep :: Parser Text +findDep = lexeme (takeWhile1P (Just "dep") (not . C.isSpace)) + +findVersion :: Parser Text +findVersion = do + _ <- char '(' + result <- lexeme (takeWhileP (Just "version") (/= ')')) + _ <- char ')' + pure result + +restOfLine :: Parser Text +restOfLine = takeWhileP (Just "ignored") (not . isEndLine) + +isEndLine :: Char -> Bool +isEndLine '\n' = True +isEndLine '\r' = True +isEndLine _ = False + +scn :: Parser () +scn = L.space space1 empty empty + +lexeme :: Parser a -> Parser a +lexeme = L.lexeme sc + +sc :: Parser () +sc = L.space (void $ some (char ' ')) empty empty diff --git a/test/Cocoapods/PodfileLockTest.hs b/test/Cocoapods/PodfileLockTest.hs new file mode 100644 index 000000000..15d1f69e6 --- /dev/null +++ b/test/Cocoapods/PodfileLockTest.hs @@ -0,0 +1,78 @@ +module Cocoapods.PodfileLockTest + ( spec_analyze + ) where + +import Prologue + +import qualified Data.Map.Strict as M +import Polysemy +import Polysemy.Input +import qualified Data.Text.IO as TIO +import Text.Megaparsec + +import DepTypes +import Strategy.Cocoapods.PodfileLock +import GraphUtil + +import qualified Test.Tasty.Hspec as T + +dependencyOne :: Dependency +dependencyOne = Dependency { dependencyType = PodType + , dependencyName = "one" + , dependencyVersion = Just (CEq "1.0.0") + , dependencyLocations = [] + , dependencyTags = M.empty + } + +dependencyTwo :: Dependency +dependencyTwo = Dependency { dependencyType = PodType + , dependencyName = "two" + , dependencyVersion = Just (CEq "2.0.0") + , dependencyLocations = [] + , dependencyTags = M.empty + } + +dependencyThree :: Dependency +dependencyThree = Dependency { dependencyType = PodType + , dependencyName = "three" + , dependencyVersion = Just (CEq "3.0.0") + , dependencyLocations = [] + , dependencyTags = M.empty + } + +dependencyFour :: Dependency +dependencyFour = Dependency { dependencyType = PodType + , dependencyName = "four" + , dependencyVersion = Just (CEq "4.0.0") + , dependencyLocations = [] + , dependencyTags = M.empty + } + +podSection :: Section +podSection = PodSection [Pod "one" "1.0.0" [Dep "two", Dep "three"], Pod "two" "2.0.0" [], Pod "three" "3.0.0" [Dep "four"], Pod "four" "4.0.0" []] + +dependencySection :: Section +dependencySection = DependencySection [Dep "one", Dep "three"] + +spec_analyze :: T.Spec +spec_analyze = do + T.describe "podfile lock analyzer" $ + T.it "produces the expected output" $ do + let graph = analyze + & runInputConst @[Section] [podSection, dependencySection] + & run + expectDeps [dependencyOne, dependencyTwo, dependencyThree, dependencyFour] graph + expectDirect [dependencyOne, dependencyThree] graph + expectEdges [ (dependencyOne, dependencyTwo) + , (dependencyOne, dependencyThree) + , (dependencyThree, dependencyFour) + ] graph + + podLockFile <- T.runIO (TIO.readFile "test/Cocoapods/testdata/Podfile.lock") + T.describe "podfile lock parser" $ + T.it "parses error messages into an empty list" $ + case runParser findSections "" podLockFile of + Left _ -> T.expectationFailure "failed to parse" + Right result -> do + result `T.shouldContain` [podSection] + result `T.shouldContain` [dependencySection] \ No newline at end of file diff --git a/test/Cocoapods/PodfileTest.hs b/test/Cocoapods/PodfileTest.hs new file mode 100644 index 000000000..5a0fe8ea0 --- /dev/null +++ b/test/Cocoapods/PodfileTest.hs @@ -0,0 +1,87 @@ +module Cocoapods.PodfileTest + ( spec_analyze + ) where + +import Prologue + +import qualified Data.Map.Strict as M +import Polysemy +import Polysemy.Input +import qualified Data.Text.IO as TIO +import Text.Megaparsec + +import DepTypes +import Strategy.Cocoapods.Podfile +import GraphUtil + +import qualified Test.Tasty.Hspec as T + +dependencyOne :: Dependency +dependencyOne = Dependency { dependencyType = PodType + , dependencyName = "one" + , dependencyVersion = Just (CEq "1.0.0") + , dependencyLocations = ["test.repo"] + , dependencyTags = M.empty + } + +dependencyTwo :: Dependency +dependencyTwo = Dependency { dependencyType = PodType + , dependencyName = "two" + , dependencyVersion = Just (CEq "2.0.0") + , dependencyLocations = ["custom.repo"] + , dependencyTags = M.empty + } + +dependencyThree :: Dependency +dependencyThree = Dependency { dependencyType = PodType + , dependencyName = "three" + , dependencyVersion = Just (CEq "3.0.0") + , dependencyLocations = ["test.repo"] + , dependencyTags = M.empty + } + +dependencyFour :: Dependency +dependencyFour = Dependency { dependencyType = PodType + , dependencyName = "four" + , dependencyVersion = Nothing + , dependencyLocations = ["test.repo"] + , dependencyTags = M.empty + } + +podOne :: Pod +podOne = Pod "one" (Just "1.0.0") M.empty + +podTwo :: Pod +podTwo = Pod "two" (Just "2.0.0") (M.fromList [(SourceProperty, "custom.repo")]) + +podThree :: Pod +podThree = Pod "three" (Just "3.0.0") (M.fromList [(PathProperty, "internal/path")]) + +podFour :: Pod +podFour = Pod "four" Nothing (M.fromList [(GitProperty, "fossa/spectrometer"), (CommitProperty, "12345")]) + +testPods :: [Pod] +testPods = [podOne, podTwo, podThree, podFour] + +testPodfile :: Podfile +testPodfile = Podfile testPods "test.repo" + +spec_analyze :: T.Spec +spec_analyze = do + T.describe "podfile analyzer" $ + T.it "produces the expected output" $ do + let graph = analyze + & runInputConst @Podfile testPodfile + & run + expectDeps [dependencyOne, dependencyTwo, dependencyThree, dependencyFour] graph + expectDirect [dependencyOne, dependencyTwo, dependencyThree, dependencyFour] graph + expectEdges [] graph + + podLockFile <- T.runIO (TIO.readFile "test/Cocoapods/testdata/Podfile") + T.describe "podfile parser" $ do + T.it "correctly parses a file" $ do + case runParser parsePodfile "" podLockFile of + Left _ -> T.expectationFailure "failed to parse" + Right result -> do + pods result `T.shouldMatchList` testPods + source result `T.shouldBe` "test.repo" \ No newline at end of file diff --git a/test/Cocoapods/testdata/Podfile b/test/Cocoapods/testdata/Podfile new file mode 100644 index 000000000..69f2705d9 --- /dev/null +++ b/test/Cocoapods/testdata/Podfile @@ -0,0 +1,34 @@ +# Disable CocoaPods deterministic UUIDs as Pods are not checked in +ENV["COCOAPODS_DISABLE_DETERMINISTIC_UUIDS"] = "true" + +# Disable Bitcode for all targets http://stackoverflow.com/a/32685434/805882 +post_install do |installer| + installer.pods_project.targets.each do |target| + target.build_configurations.each do |config| + config.build_settings['ENABLE_BITCODE'] = 'NO' + config.build_settings['CLANG_WARN_DOCUMENTATION_COMMENTS'] = 'NO' + config.build_settings['CLANG_WARN_STRICT_PROTOTYPES'] = 'NO' + if config.build_settings['IPHONEOS_DEPLOYMENT_TARGET'].to_f < 8.0 + config.build_settings['IPHONEOS_DEPLOYMENT_TARGET'] = '8.0' + end + end + end +end + +platform :ios, "9.0" + +use_modular_headers! +inhibit_all_warnings! + +source 'test.repo' + +abstract_target 'ChatSecureCorePods' do + # User Interface + pod "one", '1.0.0' + pod 'two', '2.0.0', :source => 'custom.repo' + # pod 'ParkedTextField', '~> 0.3.1' + pod 'four', :git => 'fossa/spectrometer', :commit => '12345' # Swift 4.2 + + pod 'three', '3.0.0', :path => 'internal/path' + +end diff --git a/test/Cocoapods/testdata/Podfile.lock b/test/Cocoapods/testdata/Podfile.lock new file mode 100644 index 000000000..94b2dd8ae --- /dev/null +++ b/test/Cocoapods/testdata/Podfile.lock @@ -0,0 +1,39 @@ +PODS: + - one (1.0.0): + - two (= 3.2.1) + - three (= 3.2.1) + - two (2.0.0) + - three (3.0.0) + - four (= 2.3.3) + - four (4.0.0): + +DEPENDENCIES: + - one (> 4.4) + - three (from `Submodules/subproject/.podspec`) + +SPEC REPOS: + https://github.com/cocoapods/specs.git: + - AFNetworking + - Appirater + +EXTERNAL SOURCES: + ChatSecure-Push-iOS: + :path: Submodules/ChatSecure-Push-iOS/ChatSecure-Push-iOS.podspec + ChatSecureCore: + :path: ChatSecureCore.podspec + +CHECKOUT OPTIONS: + Mantle: + :commit: 9aadbd27b1cc161dca884ec0cef198fa56e83d11 + :git: https://github.com/ChatSecure/Mantle.git + ParkedTextField: + :commit: a3800e3 + :git: https://github.com/gmertk/ParkedTextField.git + +SPEC CHECKSUMS: + AFNetworking: b6f891fdfaed196b46c7a83cf209e09697b94057 + Alamofire: ae5c501addb7afdbb13687d7f2f722c78734c2d3 + +PODFILE CHECKSUM: b141f51290d05663f08b633a34ffb15eee02707b + +COCOAPODS: 1.7.5