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/agent VersionAgentR GET --get most recent agent version
/sys/version/appmgr VersionAppMgrR GET --get most recent appmgr 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/agent 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} /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} !/#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: -- explanation of the syntax, please see:
-- http://www.yesodweb.com/book/routing-and-handlers -- http://www.yesodweb.com/book/routing-and-handlers
-- --
-- Note that this is really half the story; in Application.hs, mkYesodDispatch -- Note that this is really half the story; in Application.hs, mkYesodDispatch
-- generates the rest of the code. Please see the following documentation -- generates the rest of the code. Please see the following documentation
-- for an explanation for this split: -- for an explanation for this split:

View File

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

View File

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