Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

removes compatibility dependency, filters apps/versions based off of user agent header

Browse Source
This commit is contained in:
Keagan McClelland
2020-09-21 17:45:23 -06:00
parent 4a8a0588b0
commit a192bce08c
15 changed files with 293 additions and 242 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
src/Handler/Version.hs
View File

@@ -10,9 +10,7 @@ import Startlude
import Control.Monad.Trans.Maybe
import Data.Char
import qualified Data.HashMap.Strict as HM
import Data.String.Interpolate.IsString
import qualified Data.Text as T
import qualified Data.Text as T
import Network.HTTP.Types
import Yesod.Core
@@ -22,7 +20,7 @@ import Lib.Registry
import Lib.Semver
import Lib.Types.Semver
import Settings
import System.FilePath ((</>))
import System.FilePath ( (</>) )
getVersionR :: Handler AppVersionRes
getVersionR = do
@@ -33,34 +31,21 @@ getVersionAppR :: Text -> Handler (Maybe AppVersionRes)
getVersionAppR appId = do
appsDir <- (</> "apps") . resourcesDir . appSettings <$> getYesod
getVersionWSpec appsDir appExt
where
appExt = Extension (toS appId) :: Extension "s9pk"
where appExt = Extension (toS appId) :: Extension "s9pk"
getVersionSysR :: Text -> Handler (Maybe AppVersionRes)
getVersionSysR sysAppId = runMaybeT $ do
sysDir <- (</> "sys") . resourcesDir . appSettings <$> getYesod
avr <- MaybeT $ getVersionWSpec sysDir sysExt
minComp <- lift $ case sysAppId of
"agent" -> Just <$> meshCompanionCompatibility (appVersionVersion avr)
_ -> pure Nothing
pure $ avr { appVersionMinCompanion = minComp }
where
sysExt = Extension (toS sysAppId) :: Extension ""
avr <- MaybeT $ getVersionWSpec sysDir sysExt
pure $ avr { appVersionMinCompanion = Just $ AppVersion (1, 1, 0, 0) }
where sysExt = Extension (toS sysAppId) :: Extension ""
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
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)
meshCompanionCompatibility :: AppVersion -> Handler AppVersion
meshCompanionCompatibility av = getsYesod appCompatibilityMap >>= \hm ->
case HM.lookup av hm of
Nothing -> do
$logError [i|MESH DEPLOYMENT "#{av}" HAS NO COMPATIBILITY ENTRY! FIX IMMEDIATELY|]
sendResponseStatus status500 ("Internal Server Error" :: Text)
Just x -> pure x