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

add asset retrievers

Browse Source
This commit is contained in:
Keagan McClelland
2021-09-28 10:00:09 -06:00
parent c7e2ffbc57
commit d5803dbf77
1 changed files with 55 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
src/Lib/PkgRepository.hs
View File

@@ -9,9 +9,12 @@
module Lib.PkgRepository where module Lib.PkgRepository where
import Conduit ( (.|) import Conduit ( (.|)
, ConduitT
, MonadResource
, runConduit , runConduit
, runResourceT , runResourceT
, sinkFileCautious , sinkFileCautious
, sourceFile
) )
import Control.Monad.Logger ( MonadLogger import Control.Monad.Logger ( MonadLogger
, MonadLoggerIO , MonadLoggerIO
@@ -28,9 +31,9 @@ import qualified Data.Attoparsec.Text as Atto
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
( i ) ( i )
import qualified Data.Text as T import qualified Data.Text as T
import Lib.Error ( S9Error(NotFoundE) )
import qualified Lib.External.AppMgr as AppMgr import qualified Lib.External.AppMgr as AppMgr
import Lib.Registry ( Extension(Extension) ) import Lib.Types.AppIndex ( PkgId(..)
import Lib.Types.AppIndex ( PkgId(PkgId)
, ServiceManifest(serviceManifestIcon) , ServiceManifest(serviceManifestIcon)
) )
import Lib.Types.Emver ( Version import Lib.Types.Emver ( Version
@@ -40,17 +43,20 @@ import Startlude ( ($)
, (&&) , (&&)
, (.) , (.)
, (<$>) , (<$>)
, (<>)
, Bool(..) , Bool(..)
, ByteString
, Either(Left, Right) , Either(Left, Right)
, Eq((==)) , Eq((==))
, Exception , Exception
, FilePath , FilePath
, IO , IO
, Maybe(Just, Nothing)
, MonadIO(liftIO) , MonadIO(liftIO)
, MonadReader , MonadReader
, Show , Show
, String
, filter , filter
, find
, for_ , for_
, fromMaybe , fromMaybe
, not , not
@@ -69,7 +75,6 @@ import System.FilePath ( (<.>)
, takeBaseName , takeBaseName
, takeDirectory , takeDirectory
, takeExtension , takeExtension
, takeFileName
) )
import UnliftIO ( MonadUnliftIO import UnliftIO ( MonadUnliftIO
, askRunInIO , askRunInIO
@@ -86,6 +91,13 @@ import UnliftIO.Directory ( listDirectory
, removeFile , removeFile
, renameFile , renameFile
) )
import Yesod.Core.Content ( typeGif
, typeJpeg
, typePlain
, typePng
, typeSvg
)
import Yesod.Core.Types ( ContentType )
data ManifestParseException = ManifestParseException FilePath data ManifestParseException = ManifestParseException FilePath
deriving Show deriving Show
@@ -145,6 +157,7 @@ watchPkgRepoRoot = do
_ <- forkIO $ liftIO $ withManager $ \watchManager -> do _ <- forkIO $ liftIO $ withManager $ \watchManager -> do
stop <- watchTree watchManager root onlyAdded $ \evt -> do stop <- watchTree watchManager root onlyAdded $ \evt -> do
let pkg = eventPath evt let pkg = eventPath evt
-- TODO: validate that package path is an actual s9pk and is in a correctly conforming path.
runInIO (extractPkg pkg) runInIO (extractPkg pkg)
takeMVar box takeMVar box
stop stop
@@ -153,3 +166,41 @@ watchPkgRepoRoot = do
onlyAdded = \case onlyAdded = \case
Added path _ isDir -> not isDir && takeExtension path == ".s9pk" Added path _ isDir -> not isDir && takeExtension path == ".s9pk"
_ -> False _ -> False
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> ConduitT () ByteString m ()
getManifest pkg version = do
root <- asks pkgRepoFileRoot
let manifestPath = root </> show pkg </> show version </> "manifest.json"
sourceFile manifestPath
getInstructions :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> ConduitT () ByteString m ()
getInstructions pkg version = do
root <- asks pkgRepoFileRoot
let instructionsPath = root </> show pkg </> show version </> "instructions.md"
sourceFile instructionsPath
getLicense :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> ConduitT () ByteString m ()
getLicense pkg version = do
root <- asks pkgRepoFileRoot
let licensePath = root </> show pkg </> show version </> "license.md"
sourceFile licensePath
getIcon :: (MonadResource m, MonadReader r m, Has PkgRepo r)
=> PkgId
-> Version
-> m (ContentType, ConduitT () ByteString m ())
getIcon pkg version = do
root <- asks pkgRepoFileRoot
let pkgRoot = root </> show pkg </> show version
mIconFile <- find ((== "icon") . takeBaseName) <$> listDirectory pkgRoot
case mIconFile of
Nothing -> throwIO $ NotFoundE $ show pkg <> ": Icon"
Just x -> do
let ct = case takeExtension x of
".png" -> typePng
".jpg" -> typeJpeg
".jpeg" -> typeJpeg
".svg" -> typeSvg
".gif" -> typeGif
_ -> typePlain
pure $ (ct, sourceFile (pkgRoot </> x))