all working

This commit is contained in:
Aaron Greenspan
2019-12-24 14:48:01 -07:00
parent 029fb6d404
commit 57f86ac052
7 changed files with 39 additions and 12 deletions

View File

@@ -6,6 +6,8 @@
/sys/version/agent VersionAgentR GET --get most recent agent version
/sys/version/appmgr VersionAppMgrR GET --get most recent appmgr version
/sys/agent.s9pk AgentR GET --get most recent agent at appversion -- ?spec={semver-spec}
/sys/appmgr.s9pk AppMgrR GET --get most recent appmgr at appversion -- ?spec={semver-spec}
!/#S9PK AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec}
/sys/agent AgentR GET --get most recent agent at appversion -- ?spec={semver-spec}
/sys/appmgr AppMgrR GET --get most recent appmgr at appversion -- ?spec={semver-spec}
!/#S9PK AppR GET --get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec}
/sys.tar.gz ImageR GET --get most recent iso image, ?spec={semver-spec}

View File

@@ -0,0 +1 @@
appmgr downloaded

View File

@@ -1 +0,0 @@
some appmgr code

View File

@@ -0,0 +1 @@
image downloaded

View File

@@ -38,6 +38,7 @@ setWebProcessThreadId tid a = writeIORef (appWebServerThreadId a) . Just $ tid
-- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/routing-and-handlers
--
-- Note that this is really half the story; in Application.hs, mkYesodDispatch
-- generates the rest of the code. Please see the following documentation
-- for an explanation for this split:

View File

@@ -12,6 +12,7 @@ import Data.Aeson
import qualified Data.ByteString.Lazy as BS
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import qualified GHC.Show (Show (..))
import System.Directory
import Yesod.Core
@@ -20,6 +21,7 @@ import Handler.Types.Status
import Lib.Registry
import Lib.Semver
import Lib.Types.Semver
import System.FilePath ((<.>))
pureLog :: Show a => a -> Handler a
pureLog = liftA2 (*>) ($logInfo . show) pure
@@ -27,20 +29,28 @@ pureLog = liftA2 (*>) ($logInfo . show) pure
logRet :: ToJSON a => Handler a -> Handler a
logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . BS.toStrict . encode) pure)
data FileExtension = FileExtension FilePath (Maybe String)
instance Show FileExtension where
show (FileExtension f Nothing) = f
show (FileExtension f (Just e)) = f <.> e
getImageR :: Handler TypedContent
getImageR = getApp sysResourceDir "image"
getAppsManifestR :: Handler TypedContent
getAppsManifestR = respondSource typePlain $ CB.sourceFile appManifestPath .| awaitForever sendChunkBS
getAgentR :: Handler TypedContent
getAgentR = getApp sysResourceDir $ S9PK "agent"
getAgentR = getApp sysResourceDir "agent"
getAppMgrR :: Handler TypedContent
getAppMgrR = getApp sysResourceDir $ S9PK "appmgr"
getAppMgrR = getApp sysResourceDir "appmgr"
getAppR :: S9PK -> Handler TypedContent
getAppR = getApp appResourceDir
getAppR (S9PK appId) = getApp appResourceDir appId
getApp :: FilePath -> S9PK -> Handler TypedContent
getApp rootDir (S9PK appId) = do
getApp :: FilePath -> FilePath -> Handler TypedContent
getApp rootDir appId = do
spec <- querySpecD mostRecentVersion <$> lookupGetParam "spec"
appVersions <- registeredAppVersions appId <$> loadRegistry rootDir
case getSpecifiedAppVersion spec appVersions of

View File

@@ -13,6 +13,7 @@ import Data.Text (isSuffixOf)
import Lib.Semver
import Lib.Types.Semver
import Util.Function
newtype S9PK = S9PK String deriving (Eq)
instance Show S9PK where
@@ -63,15 +64,27 @@ loadRegistry rootDirectory = liftIO $ do
( \registry appId -> do
subdirs <- getSubDirectories (rootDirectory </> appId)
let validVersions = mapMaybe readMaybe subdirs
let versionedApps = fromList . fmap (id &&& fullS9pk rootDirectory appId) $ validVersions
pure $ insert appId versionedApps registry
versionApps <- for validVersions $ \v ->
getAppFileFromDir rootDirectory appId v
>>= \case
Nothing -> pure Nothing
Just appFile -> pure . Just $ (v, rootDirectory </> appId </> show v </> appFile)
pure $ insert appId (fromList . catMaybes $ versionApps) registry
) empty appDirectories
where
getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist)
fullS9pk root appId' appVersion = root </> appId' </> show appVersion </> s9pkExt appId'
getAppFileFromDir :: String -> String -> AppVersion -> IO (Maybe FilePath)
getAppFileFromDir rootDirectory appId v = do
dirContents <- listDirectory (rootDirectory </> appId </> show v)
pure $ find (isPrefixOf appId) dirContents
getAppFile :: String -> Registry -> AppVersion -> Maybe FilePath
getAppFile appId r av = lookup av <=< lookup appId $ r
registeredAppVersions :: String -> Registry -> [RegisteredAppVersion]
registeredAppVersions appId r = maybe [] (fmap RegisteredAppVersion . toList) (lookup appId r)
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM = fmap headMay .* filterM