Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 10:21:51 +00:00
Code Issues Packages Projects Releases Wiki Activity

autohash eos

Browse Source
This commit is contained in:
Keagan McClelland
2022-03-01 12:44:10 -07:00
parent 4cab448846
commit 75663b65e4
5 changed files with 90 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
src/Lib/PkgRepository.hs
View File

@@ -6,6 +6,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# LANGUAGE GADTs #-}
module Lib.PkgRepository where
@@ -27,8 +28,14 @@ import Control.Monad.Reader.Has ( Has
, ask
, asks
)
import Crypto.Hash ( SHA256 )
import Crypto.Hash.Conduit ( hashFile )
import Data.Aeson ( eitherDecodeFileStrict' )
import qualified Data.Attoparsec.Text as Atto
import Data.Attoparsec.Text ( parseOnly )
import Data.ByteArray.Encoding ( Base(Base16)
, convertToBase
)
import Data.ByteString ( readFile
, writeFile
)
@@ -42,6 +49,8 @@ import Database.Esqueleto.Experimental
, insertUnique
, runSqlPool
)
import Database.Persist ( (=.) )
import Database.Persist.Class ( upsert )
import Lib.Error ( S9Error(NotFoundE) )
import qualified Lib.External.AppMgr as AppMgr
import Lib.Types.AppIndex ( PackageManifest(..)
@@ -74,9 +83,11 @@ import Startlude ( ($)
, Ord(compare)
, Show
, SomeException(..)
, decodeUtf8
, filter
, find
, first
, flip
, for_
, fst
, headMay
@@ -101,6 +112,7 @@ import System.FilePath ( (<.>)
, takeBaseName
, takeDirectory
, takeExtension
, takeFileName
)
import UnliftIO ( MonadUnliftIO
, askRunInIO
@@ -137,6 +149,10 @@ data PkgRepo = PkgRepo
, pkgRepoAppMgrBin :: FilePath
}
data EosRepo = EosRepo
{ eosRepoFileRoot :: FilePath
}
getVersionsFor :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> m [Version]
getVersionsFor pkg = do
root <- asks pkgRepoFileRoot
@@ -222,7 +238,7 @@ extractPkg pool fp = handle @_ @SomeException cleanup $ do
watchPkgRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => ConnectionPool -> m (IO Bool)
watchPkgRepoRoot pool = do
$logInfo "Starting FSNotify Watch Manager"
$logInfo "Starting FSNotify Watch Manager: PKG"
root <- asks pkgRepoFileRoot
runInIO <- askRunInIO
box <- newEmptyMVar @_ @()
@@ -241,6 +257,36 @@ watchPkgRepoRoot pool = do
onlyAdded (Modified path _ isDir) = not isDir && takeExtension path == ".s9pk"
onlyAdded _ = False
watchEosRepoRoot :: (MonadUnliftIO m, MonadReader r m, Has EosRepo r, MonadLoggerIO m) => ConnectionPool -> m (IO Bool)
watchEosRepoRoot pool = do
$logInfo "Starting FSNotify Watch Manager: EOS"
root <- asks eosRepoFileRoot
runInIO <- askRunInIO
box <- newEmptyMVar @_ @()
_ <- forkIO $ liftIO $ withManager $ \watchManager -> do
stop <- watchTree watchManager root shouldIndex $ \evt -> do
let os = eventPath evt
void . forkIO $ runInIO $ do
indexOs pool os
takeMVar box
stop
pure $ tryPutMVar box ()
where
shouldIndex :: ActionPredicate
shouldIndex (Added path _ isDir) = not isDir && takeExtension path == ".img"
shouldIndex (Modified path _ isDir) = not isDir && takeExtension path == ".img"
shouldIndex _ = False
indexOs :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionPool -> FilePath -> m ()
indexOs pool path = do
hash <- hashFile @_ @SHA256 path
let hashText = decodeUtf8 $ convertToBase Base16 hash
let vText = takeFileName (takeDirectory path)
let eVersion = parseOnly parseVersion . T.pack $ vText
case eVersion of
Left e -> $logError [i|Invalid Version Number (#{vText}): #{e}|]
Right version ->
void $ flip runSqlPool pool $ upsert (EosHash version hashText) [EosHashHash =. hashText]
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r)
=> PkgId
-> Version