add routes for getting app config and manifest

This commit is contained in:
Lucy Cifferello
2020-10-07 15:25:23 -06:00
parent f54c55564a
commit a56e3e66b6
7 changed files with 115 additions and 10 deletions

View File

@@ -40,6 +40,7 @@ import Lib.Types.AppIndex
import Lib.Types.Semver
import Lib.Types.FileSystem
import Lib.Error
import Lib.External.AppMgr
import Settings
import Database.Queries
import Network.Wai ( Request(requestHeaderUserAgent) )
@@ -85,6 +86,26 @@ getSysR e = do
sysResourceDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod
getApp sysResourceDir e
getAppManifestR :: Extension "s9pk" -> Text -> Handler TypedContent
getAppManifestR e@(Extension appId) v = do
appmgrVersion <- lookupGetParam "appmgr" >>= \case
Nothing -> sendResponseStatus status400 ("Appmgr version required" :: Text)
Just a -> pure $ toS a
appMgrDir <- (<> "/") . (</> appmgrVersion) . (</> "appmgr") . (</> "sys") . resourcesDir . appSettings <$> getYesod
appDir <- (<> "/") . (</> toS v) . (</> appId) . (</> "apps") . resourcesDir . appSettings <$> getYesod
manifest <- handleS9ErrT $ getManifest appMgrDir appDir e
pure $ TypedContent "application/json" (toContent manifest)
getAppConfigR :: Extension "s9pk" -> Text -> Handler TypedContent
getAppConfigR e@(Extension appId) v = do
appmgrVersion <- lookupGetParam "appmgr" >>= \case
Nothing -> sendResponseStatus status400 ("Appmgr version required" :: Text)
Just a -> pure $ toS a
appMgrDir <- (<> "/") . (</> appmgrVersion) . (</> "appmgr") . (</> "sys") . resourcesDir . appSettings <$> getYesod
appDir <- (<> "/") . (</> toS v) . (</> appId) . (</> "apps") . resourcesDir . appSettings <$> getYesod
config <- handleS9ErrT $ getConfig appMgrDir appDir e
pure $ TypedContent "application/json" (toContent config)
getAppR :: Extension "s9pk" -> Handler TypedContent
getAppR e = do
appResourceDir <- (</> "apps") . resourcesDir . appSettings <$> getYesod