Test analyzing a public repo

1 files changed, 76 insertions, 15 deletions

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index cad343b..93af04f 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -46,6 +46,7 @@
 -- : dep tasty-quickcheck
 -- : dep uuid
 -- : dep vector
+-- : dep vector-algorithms
 -- : dep warp
 module Biz.Devalloc
   ( main,
@@ -59,7 +60,7 @@ import qualified Biz.Cli as Cli
 import qualified Biz.Id as Id
 import qualified Biz.Log as Log
 import qualified Biz.Look
-import Biz.Test ((@=?), (@?!=))
+import Biz.Test ((@=?), (@?!=), (@?=))
 import qualified Biz.Test as Test
 import qualified CMark as Cmark
 import qualified CMark.Lucid as Cmark
@@ -67,6 +68,7 @@ import Clay (em, pct, px, rem, sec, (?))
 import qualified Clay
 import qualified Clay.Font
 import qualified Clay.Render as Clay
+import qualified Control.Concurrent.Async as Async
 import qualified Control.Exception as Exception
 import Control.Monad ((>=>))
 import Crypto.JOSE.JWK (JWK)
@@ -89,6 +91,7 @@ import qualified Data.Time.Clock as Time
 import qualified Data.Time.Format as Time
 import Data.Vector (Vector)
 import qualified Data.Vector as Vector
+-- import qualified Data.Vector.Algorithms.Intro as Vector
 import qualified GitHub
 import qualified Lucid
 import qualified Lucid.Base as Lucid
@@ -105,6 +108,7 @@ import qualified Servant.Auth.Server as Auth
 import qualified Servant.HTML.Lucid as Lucid
 import Servant.Server.Generic (AsServer)
 import qualified System.Directory as Directory
+import qualified System.Environment as Env
 import qualified System.Envy as Envy
 import System.FilePath ((<.>), (</>))
 import qualified System.Process as Process
@@ -462,7 +466,8 @@ test =
   Test.group
     "Biz.Devalloc"
     [ test_calculateScore,
-      Test.with startup shutdown test_upsertGitHubUser
+      Test.with startup (\t@(c, _, _) -> shutdown t >> tidy c) test_upsertGitHubUser,
+      Test.with startup (\t@(c, _, _) -> shutdown t >> tidy c) test_analyzeGitHub
     ]
 
 -- * app configurations
@@ -715,7 +720,7 @@ htmlApp cooks kp cfg jwk oAuthArgs =
       githubAnalysis = \a owner repo ->
         guardAuth a
           +> \user ->
-            analyzeGitHub kp user cfg owner repo
+            analyzeGitHub kp user (depo cfg) owner repo
               |> liftIO
               +> AnalysisDisplay user
               .> HtmlApp
@@ -1222,7 +1227,7 @@ lastTouched bareRepo path = do
 authorsFor ::
   FilePath ->
   FilePath ->
-  -- | pures (number of commits, author name, author email)
+  -- | returns (number of commits, author name, author email)
   IO [(Text, Text, Text)]
 authorsFor gitDir path =
   Process.readProcess
@@ -1253,38 +1258,94 @@ authorsFor gitDir path =
 -- TODO: break this up into fetchGitHub and analyze functions.
 analyzeGitHub ::
   Acid.AcidState Keep ->
+  -- | The User asking for the analysis, we auth as them
   User ->
-  Config ->
+  -- | The repo depo
+  FilePath ->
   -- | GitHub owner
   Text ->
   -- | GitHub repo
   Text ->
   IO Analysis
-analyzeGitHub keep User {..} cfg o r = do
-  let githubAuth = GitHub.OAuth <| Encoding.encodeUtf8 userGitHubToken
+analyzeGitHub keep User {..} depo o r = do
   activeAuthors <-
     GitHub.collaboratorsOnR ghOwner ghRepo GitHub.FetchAll
-      |> GitHub.github githubAuth
-      /> either (panic <. tshow) identity
+      |> GitHub.github ghAuth
+      +> either getTopContributors (identity .> pure)
       /> Vector.map (GitHub.simpleUserLogin .> GitHub.userInfoForR)
-      +> Vector.mapM (GitHub.github githubAuth)
-      /> Vector.map (either (panic <. tshow) GitHub.userEmail)
       /> Vector.toList
+      +> Async.mapConcurrently (GitHub.github ghAuth)
+      /> map (either (panic <. tshow) GitHub.userEmail)
       /> catMaybes
-  GitHub.github githubAuth (GitHub.repositoryR ghOwner ghRepo) +> \case
+  GitHub.github ghAuth (GitHub.repositoryR ghOwner ghRepo) +> \case
     Left err -> throwIO <| toException err
     Right repo -> do
       let GitHub.URL url = GitHub.repoHtmlUrl repo
-      bareRepo <- fetchBareRepo cfg <. GitHub.getUrl <| GitHub.repoHtmlUrl repo
+      bareRepo <- fetchBareRepo depo <. GitHub.getUrl <| GitHub.repoHtmlUrl repo
       analyze keep userId activeAuthors (URL url) bareRepo
   where
+    ghAuth = GitHub.OAuth <| Encoding.encodeUtf8 userGitHubToken
     ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o
     ghRepo = GitHub.mkName (Proxy :: Proxy GitHub.Repo) r
 
+    getTopContributors :: GitHub.Error -> IO (Vector GitHub.SimpleUser)
+    getTopContributors = \case
+      GitHub.ParseError err -> panic err
+      GitHub.JsonError err -> panic err
+      GitHub.UserError err -> panic err
+      GitHub.HTTPError ex -> do
+        Log.warn ["getTopContributors", tshow ex]
+        -- TODO: match 'ex' on specific 403 error?
+        -- TODO: get contributors, return top 10%
+        -- 'False' means don't include anonymous contributors
+        GitHub.contributorsR ghOwner ghRepo False GitHub.FetchAll
+          |> GitHub.github ghAuth
+          /> either (panic <. tshow) identity
+          -- TODO: I can't figure out how to use this
+          -- /> Vector.sortBy
+          --   ( \case
+          --       GitHub.KnownContributor n _ _ _ _ _ -> n
+          --       GitHub.AnonymousContributor n _ -> n
+          --   )
+          /> Vector.take 10
+          /> Vector.mapMaybe GitHub.contributorToSimpleUser
+
+test_analyzeGitHub :: IO (Config, Application, Acid.AcidState Keep) -> Test.Tree
+test_analyzeGitHub load =
+  Test.group
+    "analyzeGitHub"
+    [ Test.unit "can analyze a public repo (octocat/hello-world)" <| do
+        (c, _, k) <- load
+        -- get a token with 'repo' scope from GitHub and set in .envrc.local
+        -- https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token
+        tok <-
+          Env.lookupEnv "GITHUB_USER_TOKEN"
+            /> maybe (panic "need GITHUB_USER_TOKEN") Text.pack
+        let user =
+              User
+                { userEmail = UserEmail "user@example.com",
+                  userGitHubId = GitHubId 0,
+                  userGitHubToken = tok,
+                  userSubscription = Free,
+                  userId = mempty
+                }
+        Analysis {..} <- analyzeGitHub k user (depo c) "octocat" "hello-world"
+        url @?= URL "https://github.com/octocat/Hello-World"
+        bareRepo @?= depo c <> "/github.com/octocat/Hello-World.git"
+        length activeAuthors @?= 2
+        activeAuthors @?= ["hire@spacegho.st", "octocat@github.com"]
+        blackholes @?= ["README"]
+        liabilities @?= ["README"]
+        fst </ headMay stale @?= Just "README"
+        score @?= 20
+        totalFiles @?= 1
+        commit @?= Sha "7fd1a60b01f91b314f59955a4e4d4e80d8edf11d"
+    ]
+
 -- | Clone the repo to @<Config.depo>/<url>@. If repo already exists, just do a
 -- @git fetch@. pures the full path to the local repo.
-fetchBareRepo :: Config -> Text -> IO FilePath
-fetchBareRepo Config {depo} url =
+fetchBareRepo :: FilePath -> Text -> IO FilePath
+fetchBareRepo depo url =
   Directory.doesPathExist worktree
     +> fetchOrClone
     >> pure worktree