From f0b13fc0b603078913d9f9a27d4927f4627095e4 Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Mon, 5 Jul 2021 15:47:50 -0400 Subject: [PATCH] proper manifest parsing --- src/Handler/Marketplace.hs | 3 +- src/Lib/Types/AppIndex.hs | 172 +++++++++++++++++++++++++++++++++++-- 2 files changed, 164 insertions(+), 11 deletions(-) diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index 1750f1f..d711b66 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -179,7 +179,7 @@ getServiceR = do Nothing -> sendResponseStatus status404 ("id param should exist" :: Text) Just appId' -> do case lookup "version" getParameters of - -- default to latest - need to determine best available based on OS version? + -- default to latest - @TODO need to determine best available based on OS version? Nothing -> runDB $ fetchLatestApp appId' >>= errOnNothing status404 "service not found" Just v -> do case readMaybe v of @@ -191,7 +191,6 @@ getServiceR = do let appId = sAppAppId $ entityVal service let appDir = (<> "/") . ( show (sVersionNumber $ entityVal version)) . ( toS appId) $ appsDir let appExt = Extension (toS appId) :: Extension "s9pk" - $logInfo $ "*******************" <> show appDir manifest' <- handleS9ErrT $ getManifest appMgrDir appDir appExt manifest <- case eitherDecode $ BS.fromStrict manifest' of Left e -> do diff --git a/src/Lib/Types/AppIndex.hs b/src/Lib/Types/AppIndex.hs index 4092031..422b4f0 100644 --- a/src/Lib/Types/AppIndex.hs +++ b/src/Lib/Types/AppIndex.hs @@ -3,6 +3,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE QuasiQuotes #-} + module Lib.Types.AppIndex where import Startlude hiding ( Any ) @@ -18,6 +20,10 @@ import System.Directory import Lib.Registry import Model import qualified Data.Text as T +import Data.String.Interpolate.IsString +import qualified Data.ByteString.Lazy as BS +import Data.Tuple.Extra +import qualified Data.Attoparsec.Text as Atto type AppIdentifier = Text @@ -124,27 +130,26 @@ addFileTimestamp appDir ext service v = do data ServiceDependencyInfo = ServiceDependencyInfo { serviceDependencyInfoOptional :: Maybe Text - , serviceDependencyInfoRecommended :: Bool - , serviceDependencyInfoVersion :: Version + , serviceDependencyInfoVersion :: VersionRange , serviceDependencyInfoDescription :: Maybe Text + , serviceDependencyInfoCritical :: Bool } deriving (Show) instance FromJSON ServiceDependencyInfo where parseJSON = withObject "service dependency info" $ \o -> do serviceDependencyInfoOptional <- o .:? "optional" - serviceDependencyInfoRecommended <- o .: "recommended" serviceDependencyInfoVersion <- o .: "version" serviceDependencyInfoDescription <- o .:? "description" + serviceDependencyInfoCritical <- o .: "critical" pure ServiceDependencyInfo { .. } - instance ToJSON ServiceDependencyInfo where toJSON ServiceDependencyInfo {..} = object [ "description" .= serviceDependencyInfoDescription , "version" .= serviceDependencyInfoVersion - , "recommended" .= serviceDependencyInfoRecommended , "optional" .= serviceDependencyInfoOptional + , "critical" .= serviceDependencyInfoCritical ] data ServiceAlert = INSTALL | UNINSTALL | RESTORE | START | STOP - deriving (Show, Eq, Generic, Hashable) + deriving (Show, Eq, Generic, Hashable, Read) instance FromJSONKey ServiceAlert instance ToJSONKey ServiceAlert instance ToJSON ServiceAlert where @@ -157,7 +162,7 @@ instance FromJSON ServiceAlert where "start" -> pure START "stop" -> pure STOP _ -> fail "unknown service alert type" -data ServiceManifest = ServiceManifest +data ServiceManifest = ServiceManifest { serviceManifestId :: AppIdentifier , serviceManifestTitle :: Text , serviceManifestVersion :: Version @@ -175,7 +180,14 @@ instance FromJSON ServiceManifest where serviceManifestDescriptionLong <- o .: "description" >>= (.: "long") serviceManifestDescriptionShort <- o .: "description" >>= (.: "short") serviceManifestReleaseNotes <- o .: "release-notes" - serviceManifestAlerts <- o .: "alerts" + alerts <- o .: "alerts" + a <- for (HM.toList alerts) $ \(key, value) -> do + alertType <- case readMaybe $ T.toUpper key of + Nothing -> fail "could not parse alert key as ServiceAlert" + Just t -> pure t + alertDesc <- parseJSON value + pure (alertType, alertDesc) + let serviceManifestAlerts = HM.fromList a serviceManifestDependencies <- o .: "dependencies" pure ServiceManifest { .. } instance ToJSON ServiceManifest where @@ -187,4 +199,146 @@ instance ToJSON ServiceManifest where , "release-notes" .= serviceManifestReleaseNotes , "alerts" .= serviceManifestAlerts , "dependencies" .= serviceManifestDependencies - ] \ No newline at end of file + ] + +-- >>> eitherDecode testManifest :: Either String ServiceManifest +-- Right (ServiceManifest {serviceManifestId = "embassy-pages", serviceManifestTitle = "Embassy Pages", serviceManifestVersion = 0.1.3, serviceManifestDescriptionLong = "Embassy Pages is a simple web server that uses directories inside File Browser to serve Tor websites.", serviceManifestDescriptionShort = "Create Tor websites, hosted on your Embassy.", serviceManifestReleaseNotes = "Upgrade to EmbassyOS v0.3.0", serviceManifestAlerts = fromList [(INSTALL,Nothing),(UNINSTALL,Nothing),(STOP,Nothing),(RESTORE,Nothing),(START,Nothing)], serviceManifestDependencies = fromList [("filebrowser",ServiceDependencyInfo {serviceDependencyInfoOptional = Nothing, serviceDependencyInfoVersion = >=2.14.1.1 <3.0.0, serviceDependencyInfoDescription = Just "Used to upload files to serve.", serviceDependencyInfoCritical = False})]}) +testManifest :: BS.ByteString +testManifest = [i|{ + "id": "embassy-pages", + "title": "Embassy Pages", + "version": "0.1.3", + "description": { + "short": "Create Tor websites, hosted on your Embassy.", + "long": "Embassy Pages is a simple web server that uses directories inside File Browser to serve Tor websites." + }, + "assets": { + "license": "LICENSE", + "icon": "icon.png", + "docker-images": "image.tar", + "instructions": "instructions.md" + }, + "build": [ + "make" + ], + "release-notes": "Upgrade to EmbassyOS v0.3.0", + "license": "nginx", + "wrapper-repo": "https://github.com/Start9Labs/embassy-pages-wrapper", + "upstream-repo": "http://hg.nginx.org/nginx/", + "support-site": null, + "marketing-site": null, + "alerts": { + "install": null, + "uninstall": null, + "restore": null, + "start": null, + "stop": null + }, + "main": { + "type": "docker", + "image": "main", + "system": false, + "entrypoint": "/usr/local/bin/docker_entrypoint.sh", + "args": [], + "mounts": { + "filebrowser": "/mnt/filebrowser" + }, + "io-format": "yaml", + "inject": false, + "shm-size-mb": null + }, + "health-checks": {}, + "config": { + "get": { + "type": "docker", + "image": "compat", + "system": true, + "entrypoint": "config", + "args": [ + "get", + "/root" + ], + "mounts": {}, + "io-format": "yaml", + "inject": false, + "shm-size-mb": null + }, + "set": { + "type": "docker", + "image": "compat", + "system": true, + "entrypoint": "config", + "args": [ + "set", + "/root" + ], + "mounts": {}, + "io-format": "yaml", + "inject": false, + "shm-size-mb": null + } + }, + "volumes": { + "filebrowser": { + "type": "pointer", + "package-id": "filebrowser", + "volume-id": "main", + "path": "/", + "readonly": true + } + }, + "min-os-version": "0.3.0", + "interfaces": { + "main": { + "tor-config": { + "port-mapping": { + "80": "80" + } + }, + "lan-config": null, + "ui": true, + "protocols": [ + "tcp", + "http" + ] + } + }, + "backup": { + "create": { + "type": "docker", + "image": "compat", + "system": true, + "entrypoint": "true", + "args": [], + "mounts": {}, + "io-format": null, + "inject": false, + "shm-size-mb": null + }, + "restore": { + "type": "docker", + "image": "compat", + "system": true, + "entrypoint": "true", + "args": [], + "mounts": {}, + "io-format": null, + "inject": false, + "shm-size-mb": null + } + }, + "migrations": { + "from": {}, + "to": {} + }, + "actions": {}, + "dependencies": { + "filebrowser": { + "version": ">=2.14.1.1 <3.0.0", + "optional": null, + "description": "Used to upload files to serve.", + "critical": false, + "config": null + } + } +}|]