mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-31 12:13:40 +00:00
redefine appmgr calls, holes at call sites
This commit is contained in:
Keagan McClelland
@@ -72,17 +72,18 @@ getSysR e = do
|
||||
|
||||
getAppManifestR :: PkgId -> Handler TypedContent
|
||||
getAppManifestR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
av <- getVersionFromQuery appsDir appExt >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show av) . (</> show appId) $ appsDir
|
||||
addPackageHeader appMgrDir appDir appExt
|
||||
sourceManifest appMgrDir
|
||||
appDir
|
||||
appExt
|
||||
(\bsSource -> respondSource "application/json" (bsSource .| awaitForever sendChunkBS))
|
||||
where appExt = Extension (show appId) :: Extension "s9pk"
|
||||
-- (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
-- av <- getVersionFromQuery appsDir appExt >>= \case
|
||||
-- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
-- Just v -> pure v
|
||||
-- let appDir = (<> "/") . (</> show av) . (</> show appId) $ appsDir
|
||||
-- addPackageHeader appMgrDir appDir appExt
|
||||
-- sourceManifest appMgrDir
|
||||
-- appDir
|
||||
-- appExt
|
||||
-- (\bsSource -> respondSource "application/json" (bsSource .| awaitForever sendChunkBS))
|
||||
-- where appExt = Extension (show appId) :: Extension "s9pk"
|
||||
_
|
||||
|
||||
getAppR :: Extension "s9pk" -> Handler TypedContent
|
||||
getAppR e = do
|
||||
|
||||
@@ -39,62 +39,65 @@ ixt = toS $ toUpper <$> drop 1 ".png"
|
||||
|
||||
getIconsR :: PkgId -> Handler TypedContent
|
||||
getIconsR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show spec) . (</> show appId) $ appsDir
|
||||
manifest' <- sourceManifest appMgrDir appDir ext (\bsSource -> runConduit $ bsSource .| CL.foldMap BS.fromStrict)
|
||||
manifest <- case eitherDecode manifest' of
|
||||
Left e -> do
|
||||
$logError "could not parse service manifest!"
|
||||
$logError (show e)
|
||||
sendResponseStatus status500 ("Internal Server Error" :: Text)
|
||||
Right a -> pure a
|
||||
mimeType <- case serviceManifestIcon manifest of
|
||||
Nothing -> pure typePng
|
||||
Just a -> do
|
||||
let (_, iconExt) = splitExtension $ toS a
|
||||
let x = toUpper <$> drop 1 iconExt
|
||||
case readMaybe $ toS x of
|
||||
Nothing -> do
|
||||
$logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain."
|
||||
pure typePlain
|
||||
Just iconType -> case iconType of
|
||||
PNG -> pure typePng
|
||||
SVG -> pure typeSvg
|
||||
JPG -> pure typeJpeg
|
||||
JPEG -> pure typeJpeg
|
||||
sourceIcon appMgrDir
|
||||
(appDir </> show ext)
|
||||
ext
|
||||
(\bsSource -> respondSource mimeType (bsSource .| awaitForever sendChunkBS))
|
||||
where ext = Extension (show appId) :: Extension "s9pk"
|
||||
-- (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
-- spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
-- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
-- Just v -> pure v
|
||||
-- let appDir = (<> "/") . (</> show spec) . (</> show appId) $ appsDir
|
||||
-- manifest' <- sourceManifest appMgrDir appDir ext (\bsSource -> runConduit $ bsSource .| CL.foldMap BS.fromStrict)
|
||||
-- manifest <- case eitherDecode manifest' of
|
||||
-- Left e -> do
|
||||
-- $logError "could not parse service manifest!"
|
||||
-- $logError (show e)
|
||||
-- sendResponseStatus status500 ("Internal Server Error" :: Text)
|
||||
-- Right a -> pure a
|
||||
-- mimeType <- case serviceManifestIcon manifest of
|
||||
-- Nothing -> pure typePng
|
||||
-- Just a -> do
|
||||
-- let (_, iconExt) = splitExtension $ toS a
|
||||
-- let x = toUpper <$> drop 1 iconExt
|
||||
-- case readMaybe $ toS x of
|
||||
-- Nothing -> do
|
||||
-- $logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain."
|
||||
-- pure typePlain
|
||||
-- Just iconType -> case iconType of
|
||||
-- PNG -> pure typePng
|
||||
-- SVG -> pure typeSvg
|
||||
-- JPG -> pure typeJpeg
|
||||
-- JPEG -> pure typeJpeg
|
||||
-- sourceIcon appMgrDir
|
||||
-- (appDir </> show ext)
|
||||
-- ext
|
||||
-- (\bsSource -> respondSource mimeType (bsSource .| awaitForever sendChunkBS))
|
||||
-- where ext = Extension (show appId) :: Extension "s9pk"
|
||||
_
|
||||
|
||||
getLicenseR :: PkgId -> Handler TypedContent
|
||||
getLicenseR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
|
||||
case servicePath of
|
||||
Nothing -> notFound
|
||||
Just p ->
|
||||
sourceLicense appMgrDir p ext (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS))
|
||||
where ext = Extension (show appId) :: Extension "s9pk"
|
||||
-- (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
-- spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
-- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
-- Just v -> pure v
|
||||
-- servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
|
||||
-- case servicePath of
|
||||
-- Nothing -> notFound
|
||||
-- Just p ->
|
||||
-- sourceLicense appMgrDir p ext (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS))
|
||||
-- where ext = Extension (show appId) :: Extension "s9pk"
|
||||
_
|
||||
|
||||
getInstructionsR :: PkgId -> Handler TypedContent
|
||||
getInstructionsR appId = do
|
||||
(appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
|
||||
case servicePath of
|
||||
Nothing -> notFound
|
||||
Just p -> sourceInstructions appMgrDir
|
||||
p
|
||||
ext
|
||||
(\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS))
|
||||
where ext = Extension (show appId) :: Extension "s9pk"
|
||||
-- (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
|
||||
-- spec <- getVersionFromQuery appsDir ext >>= \case
|
||||
-- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
|
||||
-- Just v -> pure v
|
||||
-- servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
|
||||
-- case servicePath of
|
||||
-- Nothing -> notFound
|
||||
-- Just p -> sourceInstructions appMgrDir
|
||||
-- p
|
||||
-- ext
|
||||
-- (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS))
|
||||
-- where ext = Extension (show appId) :: Extension "s9pk"
|
||||
_
|
||||
|
||||
@@ -329,34 +329,35 @@ getServiceDetails :: (MonadUnliftIO m, Monad m, MonadError IOException m)
|
||||
-> PkgId
|
||||
-> m (Either Text ServiceRes)
|
||||
getServiceDetails settings metadata maybeVersion appId = do
|
||||
packageMetadata <- case HM.lookup appId metadata of
|
||||
Nothing -> throwIO $ NotFoundE [i|#{appId} not found.|]
|
||||
Just m -> pure m
|
||||
let (appsDir, appMgrDir) = ((</> "apps") . resourcesDir &&& staticBinDir) settings
|
||||
let domain = registryHostname settings
|
||||
version <- case maybeVersion of
|
||||
Nothing -> do
|
||||
-- grab first value, which will be the latest version
|
||||
case fst packageMetadata of
|
||||
[] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId
|
||||
x : _ -> pure x
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show version) . (</> show appId) $ appsDir
|
||||
let appExt = Extension (show appId) :: Extension "s9pk"
|
||||
manifest' <- sourceManifest appMgrDir appDir appExt (\bs -> sinkMem (bs .| mapC BS.fromStrict))
|
||||
case eitherDecode $ manifest' of
|
||||
Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e
|
||||
Right m -> do
|
||||
d <- liftIO
|
||||
$ mapConcurrently (mapDependencyMetadata domain metadata) (HM.toList $ serviceManifestDependencies m)
|
||||
pure $ Right $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
|
||||
, serviceResManifest = decode $ manifest' -- pass through raw JSON Value
|
||||
, serviceResCategories = snd packageMetadata
|
||||
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
|
||||
, serviceResLicense = [i|https://#{domain}/package/license/#{appId}|]
|
||||
, serviceResVersions = sortOn Down $ fst packageMetadata
|
||||
, serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d
|
||||
}
|
||||
-- packageMetadata <- case HM.lookup appId metadata of
|
||||
-- Nothing -> throwIO $ NotFoundE [i|#{appId} not found.|]
|
||||
-- Just m -> pure m
|
||||
-- let (appsDir, appMgrDir) = ((</> "apps") . resourcesDir &&& staticBinDir) settings
|
||||
-- let domain = registryHostname settings
|
||||
-- version <- case maybeVersion of
|
||||
-- Nothing -> do
|
||||
-- -- grab first value, which will be the latest version
|
||||
-- case fst packageMetadata of
|
||||
-- [] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId
|
||||
-- x : _ -> pure x
|
||||
-- Just v -> pure v
|
||||
-- let appDir = (<> "/") . (</> show version) . (</> show appId) $ appsDir
|
||||
-- let appExt = Extension (show appId) :: Extension "s9pk"
|
||||
-- manifest' <- sourceManifest appMgrDir appDir appExt (\bs -> sinkMem (bs .| mapC BS.fromStrict))
|
||||
-- case eitherDecode $ manifest' of
|
||||
-- Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e
|
||||
-- Right m -> do
|
||||
-- d <- liftIO $ mapConcurrently (mapDependencyMetadata domain metadata)
|
||||
-- (HM.toList $ serviceManifestDependencies m)
|
||||
-- pure $ Right $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
|
||||
-- , serviceResManifest = decode $ manifest' -- pass through raw JSON Value
|
||||
-- , serviceResCategories = snd packageMetadata
|
||||
-- , serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|]
|
||||
-- , serviceResLicense = [i|https://#{domain}/package/license/#{appId}|]
|
||||
-- , serviceResVersions = fst packageMetadata
|
||||
-- , serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d
|
||||
-- }
|
||||
_
|
||||
|
||||
mapDependencyMetadata :: (MonadIO m)
|
||||
=> Text
|
||||
@@ -380,13 +381,13 @@ mapDependencyMetadata domain metadata (appId, depInfo) = do
|
||||
}
|
||||
)
|
||||
|
||||
decodeInstructions :: (MonadUnliftIO m, MonadHandler m, MonadThrow m) => FilePath -> FilePath -> S9PK -> m Text
|
||||
decodeInstructions appmgrPath depPath package = do
|
||||
sourceInstructions appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8))
|
||||
-- decodeInstructions :: (MonadUnliftIO m, MonadHandler m, MonadThrow m) => FilePath -> FilePath -> S9PK -> m Text
|
||||
-- decodeInstructions appmgrPath depPath package = do
|
||||
-- sourceInstructions appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8))
|
||||
|
||||
decodeLicense :: (MonadUnliftIO m, MonadThrow m, MonadHandler m) => FilePath -> FilePath -> S9PK -> m Text
|
||||
decodeLicense appmgrPath depPath package =
|
||||
sourceLicense appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8))
|
||||
-- decodeLicense :: (MonadUnliftIO m, MonadThrow m, MonadHandler m) => FilePath -> FilePath -> S9PK -> m Text
|
||||
-- decodeLicense appmgrPath depPath package =
|
||||
-- sourceLicense appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8))
|
||||
|
||||
fetchAllAppVersions :: Key SApp -> HandlerFor RegistryCtx ([VersionInfo], ReleaseNotes)
|
||||
fetchAllAppVersions appId = do
|
||||
|
||||
Reference in New Issue
Block a user