compatibility matrix

This commit is contained in:
Keagan McClelland
2020-02-18 11:11:32 -07:00
parent 1d21b5785a
commit 1e5e31942f
2 changed files with 27 additions and 5 deletions

View File

@@ -9,9 +9,12 @@ import Yesod.Core.Content
import Lib.Types.Semver
newtype AppVersionRes = AppVersionRes { unAppVersionRes ::AppVersion } deriving (Eq, Show)
data AppVersionRes = AppVersionRes
{ appVersionVersion :: AppVersion
, appVersionMinCompanion :: Maybe AppVersion
} deriving (Eq, Show)
instance ToJSON AppVersionRes where
toJSON AppVersionRes{ unAppVersionRes } = object ["version" .= unAppVersionRes]
toJSON AppVersionRes{ appVersionVersion } = object ["version" .= appVersionVersion]
instance ToContent AppVersionRes where
toContent = toContent . toJSON

View File

@@ -1,9 +1,14 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Handler.Version where
import Startlude
import Control.Monad.Trans.Maybe
import Data.String.Interpolate.IsString
import Network.HTTP.Types
import Yesod.Core
import Constants
@@ -14,7 +19,7 @@ import Lib.Semver
import Lib.Types.Semver
getVersionR :: Handler AppVersionRes
getVersionR = pure . AppVersionRes $ registryVersion
getVersionR = pure . AppVersionRes registryVersion $ Nothing
getVersionAppR :: Text -> Handler (Maybe AppVersionRes)
getVersionAppR appId = getVersionWSpec appResourceDir appExt
@@ -22,7 +27,12 @@ getVersionAppR appId = getVersionWSpec appResourceDir appExt
appExt = Extension (toS appId) :: Extension "s9pk"
getVersionSysR :: Text -> Handler (Maybe AppVersionRes)
getVersionSysR sysAppId = getVersionWSpec sysResourceDir sysExt
getVersionSysR sysAppId = runMaybeT $ do
avr <- MaybeT $ getVersionWSpec sysResourceDir sysExt
minComp <- lift $ case sysAppId of
"agent" -> Just <$> meshCompanionCompatibility (appVersionVersion avr)
_ -> pure Nothing
pure $ avr { appVersionMinCompanion = minComp }
where
sysExt = Extension (toS sysAppId) :: Extension ""
@@ -30,4 +40,13 @@ getVersionWSpec :: KnownSymbol a => FilePath -> Extension a -> Handler (Maybe Ap
getVersionWSpec rootDir ext = do
spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
appVersions <- liftIO $ getAvailableAppVersions rootDir ext
pure . fmap (AppVersionRes . version) $ getSpecifiedAppVersion spec appVersions
let av = version <$> getSpecifiedAppVersion spec appVersions
pure $ liftA2 AppVersionRes av (pure Nothing)
meshCompanionCompatibility :: AppVersion -> Handler AppVersion
meshCompanionCompatibility (AppVersion (0,1,0,_)) = pure $ AppVersion (1,0,0,0)
meshCompanionCompatibility (AppVersion (0,1,1,_)) = pure $ AppVersion (1,0,0,0)
meshCompanionCompatibility (AppVersion (0,1,2,_)) = pure $ AppVersion (1,1,0,0)
meshCompanionCompatibility other = do
$logError [i|MESH DEPLOYMENT "#{other}" HAS NO COMPATIBILITY ENTRY! FIX IMMEDIATELY|]
sendResponseStatus status500 ("Internal Server Error" :: Text)