From e4d3e9a7131f3b207b3ff1ec3edb2c5e2e584fe6 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello Date: Sat, 10 Oct 2020 19:08:43 -0600 Subject: [PATCH] alter endpoints to support dynamic versions --- config/routes | 4 ++-- config/settings.yml | 2 +- src/Foundation.hs | 1 - src/Handler/Apps.hs | 36 ++++++++++++++++++++++++++---------- src/Handler/Version.hs | 14 +++----------- src/Lib/External/AppMgr.hs | 14 +++++++------- src/Util/Shared.hs | 22 ++++++++++++++++++++++ 7 files changed, 61 insertions(+), 32 deletions(-) create mode 100644 src/Util/Shared.hs diff --git a/config/routes b/config/routes index 9f3d082..50d46b9 100644 --- a/config/routes +++ b/config/routes @@ -1,8 +1,8 @@ /apps AppsManifestR GET -- get current apps listing -/apps/#AppIdentifier/#Text/manifest AppManifestR GET -- get app manifest from appmgr -/apps/#AppIdentifier/#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 diff --git a/config/settings.yml b/config/settings.yml index 677319d..f2222e1 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -32,7 +32,7 @@ resources-path: "_env:RESOURCES_PATH:/var/www/html/resources" ssl-path: "_env:SSL_PATH:/var/ssl" registry-hostname: "_env:REGISTRY_HOSTNAME:registry.start9labs.com" tor-port: "_env:TOR_PORT:447" -static-bin-dir: "_env:STATIC_BIN:/usr/local/bin" +static-bin-dir: "_env:STATIC_BIN:/usr/local/bin/" database: database: "_env:PG_DATABASE:start9_registry" diff --git a/src/Foundation.hs b/src/Foundation.hs index 8866771..134c6ee 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -18,7 +18,6 @@ import qualified Yesod.Core.Unsafe as Unsafe import Settings import Yesod.Persist.Core import Lib.Types.AppIndex -import Lib.Types.Semver -- | The foundation datatype for your application. This can be a good place to -- keep settings and values requiring initialization before your application diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 888e67f..610d87d 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -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 :: AppIdentifier -> Text -> Handler TypedContent -getAppManifestR appId v = do - appMgrDir <- (<> "/") . staticBinDir . appSettings <$> getYesod - appDir <- (<> "/") . ( toS v) . ( toS appId) . ( "apps") . resourcesDir . appSettings <$> getYesod - manifest <- handleS9ErrT $ getManifest appMgrDir appDir appId +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 :: AppIdentifier -> Text -> Handler TypedContent -getAppConfigR appId v = do - appMgrDir <- (<> "/") . staticBinDir . appSettings <$> getYesod - appDir <- (<> "/") . ( toS v) . ( toS appId) . ( "apps") . resourcesDir . appSettings <$> getYesod - config <- handleS9ErrT $ getConfig appMgrDir appDir appId +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 diff --git a/src/Handler/Version.hs b/src/Handler/Version.hs index 39018fe..fe1f65e 100644 --- a/src/Handler/Version.hs +++ b/src/Handler/Version.hs @@ -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 - pure $ liftA2 AppVersionRes av (pure Nothing) + av <- getVersionFromQuery rootDir ext + pure $ liftA2 AppVersionRes av (pure Nothing) \ No newline at end of file diff --git a/src/Lib/External/AppMgr.hs b/src/Lib/External/AppMgr.hs index 4f51659..e3b4a43 100644 --- a/src/Lib/External/AppMgr.hs +++ b/src/Lib/External/AppMgr.hs @@ -16,7 +16,7 @@ import Data.String.Interpolate.IsString import System.Process.Typed hiding ( createPipe ) import Lib.Error -import Lib.Types.AppIndex +import Lib.Registry readProcessWithExitCode' :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString, ByteString) readProcessWithExitCode' a b c = liftIO $ do @@ -42,16 +42,16 @@ readProcessInheritStderr a b c = liftIO $ do withProcessWait pc $ \process -> atomically $ liftA2 (,) (waitExitCodeSTM process) (fmap LBS.toStrict $ getStdout process) -getConfig :: MonadIO m => FilePath -> FilePath -> AppIdentifier -> S9ErrT m Text -getConfig appmgrPath appPath appId = fmap decodeUtf8 $ do - (ec, out) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> (toS $ appId <> ".s9pk"), "-C", "--json"] "" +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"] "" case ec of ExitSuccess -> pure out ExitFailure n -> throwE $ AppMgrE [i|info #{appId} -C \--json|] n -getManifest :: MonadIO m => FilePath -> FilePath -> AppIdentifier -> S9ErrT m ByteString -getManifest appmgrPath appPath appId = do - (ec, bs) <- readProcessInheritStderr (appmgrPath <> "appmgr") ["inspect", "info", appPath <> (toS $ appId <> ".s9pk"), "-M", "--json"] "" +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"] "" case ec of ExitSuccess -> pure bs ExitFailure n -> throwE $ AppMgrE [i|info -M #{appId} \--json|] n \ No newline at end of file diff --git a/src/Util/Shared.hs b/src/Util/Shared.hs new file mode 100644 index 0000000..dc3c590 --- /dev/null +++ b/src/Util/Shared.hs @@ -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 \ No newline at end of file