{-# LANGUAGE DerivingStrategies #-}

module Security.Advisories.Sync
  ( Repository (..),
    defaultRepository,
    SyncStatus (..),
    sync,
    RepositoryStatus (..),
    status,
  )
where

import Data.Time (zonedTimeToUTC)
import Security.Advisories.Sync.Atom
import Security.Advisories.Sync.Git

data SyncStatus
  = Created
  | Updated
  | AlreadyUpToDate
  deriving stock (SyncStatus -> SyncStatus -> Bool
(SyncStatus -> SyncStatus -> Bool)
-> (SyncStatus -> SyncStatus -> Bool) -> Eq SyncStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyncStatus -> SyncStatus -> Bool
== :: SyncStatus -> SyncStatus -> Bool
$c/= :: SyncStatus -> SyncStatus -> Bool
/= :: SyncStatus -> SyncStatus -> Bool
Eq, Int -> SyncStatus -> ShowS
[SyncStatus] -> ShowS
SyncStatus -> String
(Int -> SyncStatus -> ShowS)
-> (SyncStatus -> String)
-> ([SyncStatus] -> ShowS)
-> Show SyncStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SyncStatus -> ShowS
showsPrec :: Int -> SyncStatus -> ShowS
$cshow :: SyncStatus -> String
show :: SyncStatus -> String
$cshowList :: [SyncStatus] -> ShowS
showList :: [SyncStatus] -> ShowS
Show)

sync :: Repository -> IO (Either String SyncStatus)
sync :: Repository -> IO (Either String SyncStatus)
sync Repository
repo = do
  GitRepositoryStatus
gitStatus <- Repository -> IO GitRepositoryStatus
gitRepositoryStatus Repository
repo
  Either GitError GitRepositoryEnsuredStatus
ensured <- Repository
-> GitRepositoryStatus
-> IO (Either GitError GitRepositoryEnsuredStatus)
ensureGitRepositoryWithRemote Repository
repo GitRepositoryStatus
gitStatus
  let mkGitError :: GitError -> Either String b
mkGitError = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b)
-> (GitError -> String) -> GitError -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GitError -> String
explainGitError
  case Either GitError GitRepositoryEnsuredStatus
ensured of
    Left GitError
e -> Either String SyncStatus -> IO (Either String SyncStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SyncStatus -> IO (Either String SyncStatus))
-> Either String SyncStatus -> IO (Either String SyncStatus)
forall a b. (a -> b) -> a -> b
$ GitError -> Either String SyncStatus
forall {b}. GitError -> Either String b
mkGitError GitError
e
    Right GitRepositoryEnsuredStatus
s ->
      case GitRepositoryEnsuredStatus
s of
        GitRepositoryEnsuredStatus
GitRepositoryCreated ->
          Either String SyncStatus -> IO (Either String SyncStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SyncStatus -> IO (Either String SyncStatus))
-> Either String SyncStatus -> IO (Either String SyncStatus)
forall a b. (a -> b) -> a -> b
$ SyncStatus -> Either String SyncStatus
forall a b. b -> Either a b
Right SyncStatus
Created
        GitRepositoryEnsuredStatus
GitRepositoryExisting -> do
          RepositoryStatus
repoStatus <- Repository -> GitRepositoryStatus -> IO RepositoryStatus
status' Repository
repo GitRepositoryStatus
gitStatus
          if RepositoryStatus
repoStatus RepositoryStatus -> RepositoryStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RepositoryStatus
DirectoryOutDated
            then (GitError -> Either String SyncStatus)
-> (() -> Either String SyncStatus)
-> Either GitError ()
-> Either String SyncStatus
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GitError -> Either String SyncStatus
forall {b}. GitError -> Either String b
mkGitError (Either String SyncStatus -> () -> Either String SyncStatus
forall a b. a -> b -> a
const (Either String SyncStatus -> () -> Either String SyncStatus)
-> Either String SyncStatus -> () -> Either String SyncStatus
forall a b. (a -> b) -> a -> b
$ SyncStatus -> Either String SyncStatus
forall a b. b -> Either a b
Right SyncStatus
Updated) (Either GitError () -> Either String SyncStatus)
-> IO (Either GitError ()) -> IO (Either String SyncStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Repository -> IO (Either GitError ())
updateGitRepository Repository
repo
            else Either String SyncStatus -> IO (Either String SyncStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String SyncStatus -> IO (Either String SyncStatus))
-> Either String SyncStatus -> IO (Either String SyncStatus)
forall a b. (a -> b) -> a -> b
$ SyncStatus -> Either String SyncStatus
forall a b. b -> Either a b
Right SyncStatus
AlreadyUpToDate

data RepositoryStatus
  = DirectoryMissing
  | DirectoryEmpty
  | DirectoryUpToDate
  | DirectoryOutDated
  deriving stock (RepositoryStatus -> RepositoryStatus -> Bool
(RepositoryStatus -> RepositoryStatus -> Bool)
-> (RepositoryStatus -> RepositoryStatus -> Bool)
-> Eq RepositoryStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepositoryStatus -> RepositoryStatus -> Bool
== :: RepositoryStatus -> RepositoryStatus -> Bool
$c/= :: RepositoryStatus -> RepositoryStatus -> Bool
/= :: RepositoryStatus -> RepositoryStatus -> Bool
Eq, Int -> RepositoryStatus -> ShowS
[RepositoryStatus] -> ShowS
RepositoryStatus -> String
(Int -> RepositoryStatus -> ShowS)
-> (RepositoryStatus -> String)
-> ([RepositoryStatus] -> ShowS)
-> Show RepositoryStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepositoryStatus -> ShowS
showsPrec :: Int -> RepositoryStatus -> ShowS
$cshow :: RepositoryStatus -> String
show :: RepositoryStatus -> String
$cshowList :: [RepositoryStatus] -> ShowS
showList :: [RepositoryStatus] -> ShowS
Show)

status :: Repository -> IO RepositoryStatus
status :: Repository -> IO RepositoryStatus
status Repository
repo =
  Repository -> GitRepositoryStatus -> IO RepositoryStatus
status' Repository
repo (GitRepositoryStatus -> IO RepositoryStatus)
-> IO GitRepositoryStatus -> IO RepositoryStatus
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repository -> IO GitRepositoryStatus
gitRepositoryStatus Repository
repo

status' :: Repository -> GitRepositoryStatus -> IO RepositoryStatus
status' :: Repository -> GitRepositoryStatus -> IO RepositoryStatus
status' Repository
repo GitRepositoryStatus
gitStatus = do
  case GitRepositoryStatus
gitStatus of
    GitRepositoryStatus
GitDirectoryMissing ->
      RepositoryStatus -> IO RepositoryStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RepositoryStatus
DirectoryMissing
    GitRepositoryStatus
GitDirectoryEmpty ->
      RepositoryStatus -> IO RepositoryStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RepositoryStatus
DirectoryEmpty
    GitRepositoryStatus
GitDirectoryInitialized -> do
      Either GitError GitDirectoryInfo
gitInfo <- String -> IO (Either GitError GitDirectoryInfo)
getDirectoryGitInfo (String -> IO (Either GitError GitDirectoryInfo))
-> String -> IO (Either GitError GitDirectoryInfo)
forall a b. (a -> b) -> a -> b
$ Repository -> String
repositoryRoot Repository
repo
      case Either GitError GitDirectoryInfo
gitInfo of
        Left GitError
_ ->
          RepositoryStatus -> IO RepositoryStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RepositoryStatus
DirectoryOutDated
        Right GitDirectoryInfo
info -> do
          Either String UTCTime
update <- String -> String -> IO (Either String UTCTime)
latestUpdate (Repository -> String
repositoryUrl Repository
repo) (Repository -> String
repositoryBranch Repository
repo)
          RepositoryStatus -> IO RepositoryStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RepositoryStatus -> IO RepositoryStatus)
-> RepositoryStatus -> IO RepositoryStatus
forall a b. (a -> b) -> a -> b
$
            if Either String UTCTime
update Either String UTCTime -> Either String UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== UTCTime -> Either String UTCTime
forall a b. b -> Either a b
Right (ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> ZonedTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ GitDirectoryInfo -> ZonedTime
lastModificationCommitDate GitDirectoryInfo
info)
              then RepositoryStatus
DirectoryUpToDate
              else RepositoryStatus
DirectoryOutDated

defaultRepository :: Repository
defaultRepository :: Repository
defaultRepository =
  Repository
    { repositoryUrl :: String
repositoryUrl = String
"https://github.com/haskell/security-advisories",
      repositoryRoot :: String
repositoryRoot = String
"security-advisories",
      repositoryBranch :: String
repositoryBranch = String
"main"
    }