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

redefine appmgr calls, holes at call sites

Browse Source
This commit is contained in:
Keagan McClelland
2021-09-27 20:26:03 -06:00
parent 3b857c2896
commit 1fc3c2b678
5 changed files with 128 additions and 126 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
src/Lib/External/AppMgr.hs vendored
View File

@@ -56,31 +56,31 @@ readProcessInheritStderr a b c sink = do
$ System.Process.Typed.proc a b
withProcessTerm_ pc $ \p -> sink (getStdout p)
sourceManifest :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r
sourceManifest appmgrPath appPath e@(Extension appId) sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "manifest", appPath </> show e] ""
appmgr sink `catch` \ece -> throwIO (AppMgrE [i|embassy-sdk inspect manifest #{appId}|] (eceExitCode ece))
sourceManifest :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceManifest appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath </> "embassy-sdk") ["inspect", "manifest", pkgFile] ""
appmgr sink `catch` \ece -> throwIO (AppMgrE [i|embassy-sdk inspect manifest #{pkgFile}|] (eceExitCode ece))
sourceIcon :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r
sourceIcon appmgrPath appPath (Extension icon) sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath] ""
appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect icon #{icon}|] (eceExitCode ece)
sourceIcon :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceIcon appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", pkgFile] ""
appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect icon #{pkgFile}|] (eceExitCode ece)
getPackageHash :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> m ByteString
getPackageHash appmgrPath appPath e@(Extension appId) = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "hash", appPath <> show e] ""
getPackageHash :: (MonadUnliftIO m) => FilePath -> FilePath -> m ByteString
getPackageHash appmgrPath pkgFile = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "hash", pkgFile] ""
appmgr (\bsSource -> runConduit $ bsSource .| CL.foldMap id)
`catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect hash #{appId}|] (eceExitCode ece)
`catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect hash #{pkgFile}|] (eceExitCode ece)
sourceInstructions :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r
sourceInstructions appmgrPath appPath (Extension appId) sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath] ""
appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect instructions #{appId}|] (eceExitCode ece)
sourceInstructions :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceInstructions appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", pkgFile] ""
appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect instructions #{pkgFile}|] (eceExitCode ece)
sourceLicense :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r
sourceLicense appmgrPath appPath (Extension appId) sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath] ""
appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect license #{appId}|] (eceExitCode ece)
sourceLicense :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceLicense appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", pkgFile] ""
appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect license #{pkgFile}|] (eceExitCode ece)
sinkMem :: (Monad m, Monoid a) => ConduitT () a m () -> m a
sinkMem c = runConduit $ c .| CL.foldMap id

13
src/Lib/PkgRepository.hs
View File

@@ -108,17 +108,14 @@ extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m)
extractPkg pkg v = (`onException` cleanup) $ do
$logInfo [i|Extracting package: #{pkg}@#{v}|]
PkgRepo { pkgRepoFileRoot = root, pkgRepoAppMgrBin = appmgr } <- ask
let s9pk = Extension @"s9pk" $ show pkg
let pkgRoot = root </> show pkg </> show v
$logInfo [i|#{s9pk}|]
$logInfo [i|#{pkgRoot}|]
manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr pkgRoot s9pk $ sinkIt
let s9pk = pkgRoot </> show pkg <.> "s9pk"
manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr s9pk $ sinkIt
(pkgRoot </> "manifest.json")
instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr pkgRoot s9pk $ sinkIt
instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr s9pk $ sinkIt
(pkgRoot </> "instructions.md")
licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr pkgRoot s9pk $ sinkIt
(pkgRoot </> "license.md")
iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr pkgRoot s9pk $ sinkIt (pkgRoot </> "icon.tmp")
licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr s9pk $ sinkIt (pkgRoot </> "license.md")
iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr s9pk $ sinkIt (pkgRoot </> "icon.tmp")
wait manifestTask
eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot </> "manifest.json"))
case eManifest of