alter endpoints to support dynamic versions

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
 

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"

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

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

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)

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

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