Add repoVisibility

1 files changed, 43 insertions, 9 deletions

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 2efd8fb..d7a43ea 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -83,6 +83,7 @@ import Data.IxSet (Indexable (..), IxSet, ixFun, ixSet, (&&&), (@=))
 import qualified Data.IxSet as IxSet
 import qualified Data.List as List
 import Data.SafeCopy (base, deriveSafeCopy)
+import qualified Data.SafeCopy as SafeCopy
 import qualified Data.Set as Set
 import qualified Data.String as String
 import qualified Data.Text as Text
@@ -224,6 +225,28 @@ instance Lucid.ToHtml URL where
 
 $(deriveSafeCopy 0 'base ''URL)
 
+data Visibility = Public | Private
+  deriving (Eq, Ord, Generic, Show, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Visibility)
+
+data Analysis0 = Analysis0
+  { analysisId :: Id.Id Analysis0,
+    url :: URL,
+    bareRepo :: FilePath,
+    blackholes :: [Text],
+    liabilities :: [Text],
+    stale :: [(FilePath, Int)],
+    score :: Integer,
+    totalFiles :: Integer,
+    activeAuthors :: [Text],
+    commit :: Commit,
+    askedBy :: Id.Id User
+  }
+  deriving (Eq, Ord, Generic, Show, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''Analysis0)
+
 -- | The result of analyzing a git repo.
 data Analysis = Analysis
   { -- | Monotonic incrementing integer id
@@ -233,6 +256,8 @@ data Analysis = Analysis
     url :: URL,
     -- | Where the repo is stored on the local disk.
     bareRepo :: FilePath,
+    -- | If the repo is OSS or not
+    repoVisibility :: Visibility,
     -- | A path with no active contributors
     blackholes :: [Text],
     -- | A path with < 3 active contributors
@@ -252,16 +277,25 @@ data Analysis = Analysis
   }
   deriving (Eq, Ord, Generic, Show, Data, Typeable)
 
+instance SafeCopy.Migrate Analysis where
+  type MigrateFrom Analysis = Analysis0
+  migrate Analysis0 {..} =
+    Analysis
+      { analysisId = Id.mk (Proxy :: Proxy Analysis) <| Id.untag analysisId,
+        repoVisibility = Public,
+        ..
+      }
+
 $(deriveSafeCopy 0 'base ''Id.Id)
 $(deriveSafeCopy 0 'base ''Analysis)
 
 instance Indexable Analysis where
   empty =
     ixSet
-      [ ixFun <| \a -> [analysisId a],
-        ixFun <| \a -> [askedBy a],
-        ixFun <| \a -> [url a],
-        ixFun <| \a -> [commit a]
+      [ ixFun <| \Analysis {..} -> [analysisId],
+        ixFun <| \Analysis {..} -> [askedBy],
+        ixFun <| \Analysis {..} -> [url],
+        ixFun <| \Analysis {..} -> [commit]
       ]
 
 -- | The database.
@@ -310,7 +344,7 @@ getUsers = do
 createAnalysis :: Analysis -> Acid.Update Keep Analysis
 createAnalysis a = do
   keep@Keep {..} <- get
-  let newAnalysis = a {analysisId = nextAnalysisId}
+  let newAnalysis = a {analysisId = nextAnalysisId} :: Analysis
   put
     <| keep
       { analyses = IxSet.insert newAnalysis analyses,
@@ -1176,8 +1210,8 @@ instance Lucid.ToHtml Analysis where
       slen = tshow <. length
 
 -- | Run a full analysis on a git repo
-analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> IO Analysis
-analyze keep askedBy activeAuthors url bareRepo = do
+analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> Bool -> IO Analysis
+analyze keep askedBy activeAuthors url bareRepo repoPrivate = do
   commit <- Sha </ Text.strip </ Text.pack </ git ["log", "-n1", "--format=%H"]
   Acid.query keep (GetAnalysisByUrlAndCommit url commit) +> \case
     Just analysis -> pure analysis
@@ -1223,6 +1257,7 @@ analyze keep askedBy activeAuthors url bareRepo = do
             ],
           score = calculateScore numTotal numBlackholes numLiabilities,
           totalFiles = toInteger <| length tree,
+          repoVisibility = repoPrivate ?: (Private, Public),
           ..
         }
         |> CreateAnalysis
@@ -1314,7 +1349,6 @@ authorsFor gitDir path =
       )
 
 -- | Clones a repo from GitHub and does the analysis.
--- TODO: break this up into fetchGitHub and analyze functions.
 analyzeGitHub ::
   Acid.AcidState Keep ->
   -- | The User asking for the analysis, we auth as them
@@ -1339,7 +1373,7 @@ analyzeGitHub keep User {..} depo o r = do
     Right repo -> do
       let GitHub.URL url = GitHub.repoHtmlUrl repo
       bareRepo <- fetchBareRepo depo <. GitHub.getUrl <| GitHub.repoHtmlUrl repo
-      analyze keep userId activeAuthors (URL url) bareRepo
+      analyze keep userId activeAuthors (URL url) bareRepo (GitHub.repoPrivate repo)
   where
     ghAuth = GitHub.OAuth <| Encoding.encodeUtf8 userGitHubToken
     ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o