mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
Merge pull request #25 from Start9Labs/feature/app-endpoints
endpoint and config fixes
This commit is contained in:
@@ -1,8 +1,8 @@
|
||||
|
||||
|
||||
/apps AppsManifestR GET -- get current apps listing
|
||||
/apps/#S9PK/#Text/manifest AppManifestR GET -- get app manifest from appmgr
|
||||
/apps/#S9PK/#Text/config AppConfigR GET -- get app config from appmgr
|
||||
/apps/manifest/#AppIdentifier AppManifestR GET -- get app manifest from appmgr -- ?spec={semver-spec}
|
||||
/apps/config/#AppIdentifier AppConfigR GET -- get app config from appmgr -- ?spec={semver-spec}
|
||||
|
||||
/version VersionR GET
|
||||
|
||||
|
||||
@@ -17,6 +17,7 @@ import qualified Yesod.Core.Unsafe as Unsafe
|
||||
|
||||
import Settings
|
||||
import Yesod.Persist.Core
|
||||
import Lib.Types.AppIndex
|
||||
|
||||
-- | The foundation datatype for your application. This can be a good place to
|
||||
-- keep settings and values requiring initialization before your application
|
||||
|
||||
@@ -44,6 +44,8 @@ import Lib.External.AppMgr
|
||||
import Settings
|
||||
import Database.Queries
|
||||
import Network.Wai ( Request(requestHeaderUserAgent) )
|
||||
import Util.Shared
|
||||
|
||||
|
||||
pureLog :: Show a => a -> Handler a
|
||||
pureLog = liftA2 (*>) ($logInfo . show) pure
|
||||
@@ -86,19 +88,33 @@ getSysR e = do
|
||||
sysResourceDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod
|
||||
getApp sysResourceDir e
|
||||
|
||||
getAppManifestR :: Extension "s9pk" -> Text -> Handler TypedContent
|
||||
getAppManifestR e@(Extension appId) v = do
|
||||
appMgrDir <- (<> "/") . staticBinDir . appSettings <$> getYesod
|
||||
appDir <- (<> "/") . (</> toS v) . (</> appId) . (</> "apps") . resourcesDir . appSettings <$> getYesod
|
||||
manifest <- handleS9ErrT $ getManifest appMgrDir appDir e
|
||||
getAppManifestR :: AppIdentifier -> Handler TypedContent
|
||||
getAppManifestR appId = do
|
||||
appSettings <- appSettings <$> getYesod
|
||||
let appsDir = (</> "apps") . resourcesDir $ appSettings
|
||||
let appMgrDir = staticBinDir $ appSettings
|
||||
av <- getVersionFromQuery appsDir appExt >>= \case
|
||||
Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir
|
||||
manifest <- handleS9ErrT $ getManifest appMgrDir appDir appExt
|
||||
pure $ TypedContent "application/json" (toContent manifest)
|
||||
where
|
||||
appExt = Extension (toS appId) :: Extension "s9pk"
|
||||
|
||||
getAppConfigR :: Extension "s9pk" -> Text -> Handler TypedContent
|
||||
getAppConfigR e@(Extension appId) v = do
|
||||
appMgrDir <- (<> "/") . staticBinDir . appSettings <$> getYesod
|
||||
appDir <- (<> "/") . (</> toS v) . (</> appId) . (</> "apps") . resourcesDir . appSettings <$> getYesod
|
||||
config <- handleS9ErrT $ getConfig appMgrDir appDir e
|
||||
getAppConfigR :: AppIdentifier -> Handler TypedContent
|
||||
getAppConfigR appId = do
|
||||
appSettings <- appSettings <$> getYesod
|
||||
let appsDir = (</> "apps") . resourcesDir $ appSettings
|
||||
let appMgrDir = staticBinDir $ appSettings
|
||||
av <- getVersionFromQuery appsDir appExt >>= \case
|
||||
Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
|
||||
Just v -> pure v
|
||||
let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir
|
||||
config <- handleS9ErrT $ getConfig appMgrDir appDir appExt
|
||||
pure $ TypedContent "application/json" (toContent config)
|
||||
where
|
||||
appExt = Extension (toS appId) :: Extension "s9pk"
|
||||
|
||||
getAppR :: Extension "s9pk" -> Handler TypedContent
|
||||
getAppR e = do
|
||||
|
||||
@@ -9,18 +9,15 @@ module Handler.Version where
|
||||
import Startlude
|
||||
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Data.Char
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Types
|
||||
import Yesod.Core
|
||||
|
||||
import Foundation
|
||||
import Handler.Types.Status
|
||||
import Lib.Registry
|
||||
import Lib.Semver
|
||||
import Lib.Types.Semver
|
||||
import Settings
|
||||
import System.FilePath ( (</>) )
|
||||
import Util.Shared
|
||||
|
||||
getVersionR :: Handler AppVersionRes
|
||||
getVersionR = do
|
||||
@@ -42,10 +39,5 @@ getVersionSysR sysAppId = runMaybeT $ do
|
||||
|
||||
getVersionWSpec :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe AppVersionRes)
|
||||
getVersionWSpec rootDir ext = do
|
||||
specString <- T.filter (not . isSpace) . fromMaybe "*" <$> lookupGetParam "spec"
|
||||
spec <- case readMaybe specString of
|
||||
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
|
||||
Just t -> pure t
|
||||
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
|
||||
let av = version <$> getSpecifiedAppVersion spec appVersions
|
||||
av <- getVersionFromQuery rootDir ext
|
||||
pure $ liftA2 AppVersionRes av (pure Nothing)
|
||||
4
src/Lib/External/AppMgr.hs
vendored
4
src/Lib/External/AppMgr.hs
vendored
@@ -44,14 +44,14 @@ readProcessInheritStderr a b c = liftIO $ do
|
||||
|
||||
getConfig :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m Text
|
||||
getConfig appmgrPath appPath e@(Extension appId) = fmap decodeUtf8 $ do
|
||||
(ec, out) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> show e, "-C", "--json"] ""
|
||||
(ec, out) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> (show e), "-C", "--json"] ""
|
||||
case ec of
|
||||
ExitSuccess -> pure out
|
||||
ExitFailure n -> throwE $ AppMgrE [i|info #{appId} -C \--json|] n
|
||||
|
||||
getManifest :: (MonadIO m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> S9ErrT m ByteString
|
||||
getManifest appmgrPath appPath e@(Extension appId) = do
|
||||
(ec, bs) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> show e, "-M", "--json"] ""
|
||||
(ec, bs) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> (show e), "-M", "--json"] ""
|
||||
case ec of
|
||||
ExitSuccess -> pure bs
|
||||
ExitFailure n -> throwE $ AppMgrE [i|info -M #{appId} \--json|] n
|
||||
22
src/Util/Shared.hs
Normal file
22
src/Util/Shared.hs
Normal file
@@ -0,0 +1,22 @@
|
||||
module Util.Shared where
|
||||
|
||||
import Startlude
|
||||
|
||||
import Data.Char
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Types
|
||||
import Yesod.Core
|
||||
|
||||
import Foundation
|
||||
import Lib.Registry
|
||||
import Lib.Semver
|
||||
import Lib.Types.Semver
|
||||
|
||||
getVersionFromQuery :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe AppVersion)
|
||||
getVersionFromQuery rootDir ext = do
|
||||
specString <- T.filter (not . isSpace) . fromMaybe "*" <$> lookupGetParam "spec"
|
||||
spec <- case readMaybe specString of
|
||||
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
|
||||
Just t -> pure t
|
||||
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
|
||||
pure $ version <$> getSpecifiedAppVersion spec appVersions
|
||||
Reference in New Issue
Block a user