add guards to skip sources if failed or preconditions not met

Signed-off-by: Maximilian Huber <[email protected]>

ldbcollector.cabal

@@ -86,6 +86,7 @@ library
     , filepath
     , graphviz
     , hashable
+    , http-conduit
     , hslogger
     , libyaml
     , mtl

src/Ldbcollector/Model/LicenseGraph.hs

@@ -60,16 +60,39 @@ class (HasOriginalData a) => Source a where
   -- getLicenseNamespace _ = Nothing
   getSourceDescription :: a -> Maybe Text
   getSourceDescription _ = Nothing
+  getExpectedFiles :: a -> [FilePath]
+  getExpectedFiles _ = []
+  getExpectedDirectories :: a -> [FilePath]
+  getExpectedDirectories _ = []
+  guardSource :: a -> LicenseGraphM Bool
+  guardSource a = let
+        mkGuardFun :: (FilePath -> IO Bool) -> FilePath -> LicenseGraphM Bool
+        mkGuardFun fun path = lift $ do
+          exists <- fun path
+          unless exists $ errorM rootLoggerName ("# expected file " ++ path ++ " does not exist")
+          return exists
+    in do
+        filesExist <- mapM (mkGuardFun doesFileExist) (getExpectedFiles a)
+        directoriesExist <- mapM (mkGuardFun doesDirectoryExist) (getExpectedDirectories a)
+        return $ and (filesExist ++ directoriesExist)
   applySource :: a -> LicenseGraphM ()
   applySource a =
     let source = getSource a
-     in timedLGM (show source) $ do
-          lift $ infoM rootLoggerName ("# get " ++ show source)
-          MTL.modify (\lg -> lg {_sources = Map.insert source (WrappedSource a) (_sources lg)})
-          facts <- force <$> MTL.lift (getFacts a)
-          lift $ infoM rootLoggerName (show (V.length facts) ++ " entries")
-          V.mapM_ (\fact -> withFact (source, fact) applyFact) facts
-          debugOrderAndSize
+     in do
+        passed <- guardSource a
+        if passed
+          then timedLGM (show source) $ do
+                  lift $ infoM rootLoggerName ("# get " ++ show source)
+                  facts <- force <$> MTL.lift (getFacts a)
+                  if not (null facts)
+                    then do
+                      MTL.modify (\lg -> lg {_sources = Map.insert source (WrappedSource a) (_sources lg)})
+                      lift $ infoM rootLoggerName (show (V.length facts) ++ " entries")
+                      V.mapM_ (\fact -> withFact (source, fact) applyFact) facts
+                      debugOrderAndSize
+                    else do
+                      lift $ errorM rootLoggerName ("# " ++ show source ++ " returned no facts")
+          else lift $ errorM rootLoggerName ("# did not apply " ++ show source ++ " as guard was not satisfied")
 
 data WrappedSource where
   WrappedSource :: forall a. (Source a) => a -> WrappedSource

src/Ldbcollector/Source.hs

@@ -34,7 +34,7 @@ applySources curation = do
   lift $ infoM rootLoggerName "# get sources ..."
   let sources =
         [ applySource (SPDXData "./data/spdx-license-list-data/json/details/"),
-          -- applySource OSI,
+          applySource OSI,
           applySource (GoogleLicensePolicy "./data/google-licensecheck.license_type.go.json"),
           applySource (FedoraLicenseData "./data/fedora-legal-fedora-license-data.jsons"),
           applySource (BlueOakCouncilLicenseList "./data/blueoakcouncil/blue-oak-council-license-list.json"),

src/Ldbcollector/Source/BlueOak.hs

@@ -154,6 +154,8 @@ instance HasOriginalData BlueOakCouncil where
 
 instance Source BlueOakCouncil where
   getSource _ = Source "BlueOakCouncil"
+  getExpectedFiles (BlueOakCouncilLicenseList file) = [file]
+  getExpectedFiles (BlueOakCouncilCopyleftList file) = [file]
   getFacts (BlueOakCouncilLicenseList file) = do
     logFileReadIO file
     decoded <- eitherDecodeFileStrict file :: IO (Either String BlueOakData)

src/Ldbcollector/Source/Cavil.hs

@@ -49,6 +49,7 @@ instance HasOriginalData CavilLicenseChanges where
 
 instance Source CavilLicenseChanges where
   getSource _ = Source "CavilLicenseChanges"
+  getExpectedFiles (CavilLicenseChanges txt) = [txt]
   getSourceDescription _ = Just "Cavil is a legal review system for the Open Build Service. It is used in the development of openSUSE Tumbleweed, openSUSE Leap, as well as SUSE Linux Enterprise."
   getFacts (CavilLicenseChanges txt) = do
     logFileReadIO txt

src/Ldbcollector/Source/FOSSLight.hs

@@ -181,6 +181,7 @@ instance HasOriginalData FOSSLight where
 
 instance Source FOSSLight where
   getSource _ = Source "FOSSLight"
+  getExpectedFiles (FOSSLight sqlite) = [sqlite]
   getFacts (FOSSLight sqlite) =
     let extractLicensesFromSqlite :: IO ([FOSSLight_License], [FOSSLight_Nick])
         extractLicensesFromSqlite = do
@@ -208,16 +209,10 @@ instance Source FOSSLight where
           S.close conn
           return (licenses, nicks)
      in do
-          sqliteFileExists <- doesFileExist sqlite
-          if sqliteFileExists
-            then do
               (licenses, nicks) <- extractLicensesFromSqlite
               let rawFromLicense (license@FOSSLight_License {_fossLight_name = name}) =
                     let nicksForLicense = map (\(FOSSLight_Nick _ nick) -> nick) $ filter (\n@(FOSSLight_Nick name' _) -> name == name') nicks
                      in FOSSLightFact license nicksForLicense
                   facts = map (wrapFact . rawFromLicense) licenses
 
               return (V.fromList facts)
-            else do
-              stderrLogIO ("missing file: " ++ sqlite)
-              return mempty

src/Ldbcollector/Source/FSF.hs

@@ -69,6 +69,8 @@ instance HasOriginalData FSF where
 
 instance Source FSF where
   getSource _ = Source "FSF"
+  getExpectedDirectories (FSF dir) = [dir]
+  getExpectedFiles (FSF dir) = [dir </> "licenses-full.json", dir </> "licenses.json"]
   getFacts (FSF dir) = do
     jsons <- (fmap (filter (not . isSuffixOf "licenses-full.json") . filter (not . isSuffixOf "licenses.json")) . glob) (dir </> "*.json")
     V.fromList . wrapFacts <$> mapM parseFsfJSON jsons

src/Ldbcollector/Source/FossLicense.hs

@@ -83,6 +83,7 @@ instance HasOriginalData FossLicenseVar where
 
 instance Source FossLicenseVar where
   getSource _ = Source "FOSS License"
+  getExpectedDirectories (FossLicenseVar var) = [var </> "licenses"]
   getFacts (FossLicenseVar var) =
     let parseOrFailJson json = do
           logFileReadIO json

src/Ldbcollector/Source/OKFN.hs

@@ -108,6 +108,7 @@ instance HasOriginalData OKFN where
 
 instance Source OKFN where
   getSource _ = Source "OKFN"
+  getExpectedFiles (OKFN allJSON) = [allJSON]
   getFacts (OKFN allJSON) = do
     logFileReadIO allJSON
     decoded <- eitherDecodeFileStrict allJSON :: IO (Either String (Map.Map String OKFNLicense))

src/Ldbcollector/Source/OSI.hs

@@ -12,6 +12,8 @@ import Data.Text qualified as T
 import Data.Vector qualified as V
 import Ldbcollector.Model
 import Network.Protocol.OpenSource.License qualified as OSI
+import Network.HTTP.Simple (httpLBS, getResponseStatusCode, parseRequest, Response)
+import Control.Exception (try, SomeException)
 
 newtype OSILicense
   = OSILicense OSI.OSILicense
@@ -61,6 +63,14 @@ instance HasOriginalData OSI where
 
 instance Source OSI where
   getSource _ = Source "OSI"
+  guardSource _ = lift $ do
+    request <- parseRequest "https://api.opensource.org"
+    result <- try (httpLBS request) :: IO (Either SomeException (Response ByteString))
+    case result of
+        Left err -> do
+            errorM rootLoggerName "Network is not accessible"
+            return False
+        Right _ -> return True
   getFacts OSI = do
     response <- runExceptT OSI.allLicenses
     case response of