agent: removes exinst from appmanifest types

This commit is contained in:
Aaron Greenspan
2021-01-12 11:41:03 -07:00
committed by Aiden McClelland
parent 2d10220e52
commit b4d1db7e11
3 changed files with 36 additions and 43 deletions

View File

@@ -253,7 +253,7 @@ getInstalledAppsLogic = do
, appInstalledPreviewStatus = s , appInstalledPreviewStatus = s
, appInstalledPreviewVersionInstalled = v , appInstalledPreviewVersionInstalled = v
, appInstalledPreviewTorAddress = infoResTorAddress , appInstalledPreviewTorAddress = infoResTorAddress
, appInstalledPreviewUi = withSome1 infoResManifest AppManifest.hasUi , appInstalledPreviewUi = AppManifest.hasUi infoResManifest
} }
pure $ HML.elems $ HML.union installingPreviews installedPreviews pure $ HML.elems $ HML.union installingPreviews installedPreviews

View File

@@ -25,7 +25,6 @@ import qualified Data.HashMap.Strict as HM
import Data.Singletons.Prelude hiding ( Error ) import Data.Singletons.Prelude hiding ( Error )
import Data.Singletons.Prelude.Either import Data.Singletons.Prelude.Either
import qualified Data.String as String import qualified Data.String as String
import Exinst
import Lib.Algebra.Domain.AppMgr.Types import Lib.Algebra.Domain.AppMgr.Types
import Lib.Algebra.Domain.AppMgr.TH import Lib.Algebra.Domain.AppMgr.TH
@@ -67,7 +66,7 @@ data InfoRes a = InfoRes
(Either_ (DefaultEqSym1 'OnlyDependencies) (ElemSym1 'IncludeDependencies) a) (Either_ (DefaultEqSym1 'OnlyDependencies) (ElemSym1 'IncludeDependencies) a)
(HM.HashMap AppId DependencyInfo) (HM.HashMap AppId DependencyInfo)
, infoResManifest , infoResManifest
:: Include (Either_ (DefaultEqSym1 'OnlyManifest) (ElemSym1 'IncludeManifest) a) (Some1 AppManifest) :: Include (Either_ (DefaultEqSym1 'OnlyManifest) (ElemSym1 'IncludeManifest) a) AppManifest
, infoResStatus :: Include (Either_ (DefaultEqSym1 'OnlyStatus) (ElemSym1 'IncludeStatus) a) AppContainerStatus , infoResStatus :: Include (Either_ (DefaultEqSym1 'OnlyStatus) (ElemSym1 'IncludeStatus) a) AppContainerStatus
} }
instance SingI (a :: Either OnlyInfoFlag [IncludeInfoFlag]) => FromJSON (InfoRes a) where instance SingI (a :: Either OnlyInfoFlag [IncludeInfoFlag]) => FromJSON (InfoRes a) where

View File

@@ -6,10 +6,8 @@ import Startlude hiding ( ask )
import Control.Effect.Reader.Labelled import Control.Effect.Reader.Labelled
import Data.Aeson import Data.Aeson
import Data.Singletons.TypeLits
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import qualified Data.Yaml as Yaml import qualified Data.Yaml as Yaml
import Exinst
import Lib.Error import Lib.Error
import Lib.SystemPaths import Lib.SystemPaths
@@ -49,53 +47,49 @@ instance FromJSON AssetMapping where
assetMappingOverwrite <- o .: "overwrite" assetMappingOverwrite <- o .: "overwrite"
pure $ AssetMapping { .. } pure $ AssetMapping { .. }
data AppManifest (n :: Nat) where data AppManifest where
AppManifestV0 ::{ appManifestV0Id :: AppId AppManifest :: { appManifestId :: AppId
, appManifestV0Version :: Version , appManifestVersion :: Version
, appManifestV0Title :: Text , appManifestTitle :: Text
, appManifestV0DescShort :: Text , appManifestDescShort :: Text
, appManifestV0DescLong :: Text , appManifestDescLong :: Text
, appManifestV0ReleaseNotes :: Text , appManifestReleaseNotes :: Text
, appManifestV0PortMapping :: HM.HashMap Word16 Word16 , appManifestPortMapping :: HM.HashMap Word16 Word16
, appManifestV0ImageType :: ImageType , appManifestImageType :: ImageType
, appManifestV0Mount :: FilePath , appManifestMount :: FilePath
, appManifestV0Assets :: [AssetMapping] , appManifestAssets :: [AssetMapping]
, appManifestV0OnionVersion :: OnionVersion , appManifestOnionVersion :: OnionVersion
, appManifestV0Dependencies :: HM.HashMap AppId VersionRange , appManifestDependencies :: HM.HashMap AppId VersionRange
} -> AppManifest 0 } -> AppManifest
hasUi :: forall n. AppManifest n -> Bool hasUi :: AppManifest -> Bool
hasUi AppManifestV0 {..} = isJust $ HM.lookup 80 appManifestV0PortMapping hasUi AppManifest {..} = isJust $ HM.lookup 80 appManifestPortMapping
instance FromJSON (Some1 AppManifest) where instance FromJSON AppManifest where
parseJSON = withObject "App Manifest" $ \o -> Some1 (SNat @0) <$> parseJSON (Object o) parseJSON = withObject "App Manifest " $ \o -> do
appManifestId <- o .: "id"
appManifestVersion <- o .: "version"
instance FromJSON (AppManifest 0) where appManifestTitle <- o .: "title"
parseJSON = withObject "App Manifest V0" $ \o -> do appManifestDescShort <- o .: "description" >>= (.: "short")
appManifestV0Id <- o .: "id" appManifestDescLong <- o .: "description" >>= (.: "long")
appManifestV0Version <- o .: "version" appManifestReleaseNotes <- o .: "release-notes"
appManifestV0Title <- o .: "title" appManifestPortMapping <- o .: "ports" >>= fmap HM.fromList . traverse parsePortMapping
appManifestV0DescShort <- o .: "description" >>= (.: "short") appManifestImageType <- o .: "image" >>= (.: "type")
appManifestV0DescLong <- o .: "description" >>= (.: "long") appManifestMount <- o .: "mount"
appManifestV0ReleaseNotes <- o .: "release-notes" appManifestAssets <- o .: "assets" >>= traverse parseJSON
appManifestV0PortMapping <- o .: "ports" >>= fmap HM.fromList . traverse parsePortMapping appManifestOnionVersion <- o .: "hidden-service-version"
appManifestV0ImageType <- o .: "image" >>= (.: "type") appManifestDependencies <- o .:? "dependencies" .!= HM.empty >>= traverse parseDepInfo
appManifestV0Mount <- o .: "mount" pure $ AppManifest { .. }
appManifestV0Assets <- o .: "assets" >>= traverse parseJSON
appManifestV0OnionVersion <- o .: "hidden-service-version"
appManifestV0Dependencies <- o .:? "dependencies" .!= HM.empty >>= traverse parseDepInfo
pure $ AppManifestV0 { .. }
where where
parsePortMapping = withObject "Port Mapping" $ \o -> liftA2 (,) (o .: "tor") (o .: "internal") parsePortMapping = withObject "Port Mapping" $ \o -> liftA2 (,) (o .: "tor") (o .: "internal")
parseDepInfo = withObject "Dep Info" $ (.: "version") parseDepInfo = withObject "Dep Info" $ (.: "version")
getAppManifest :: (MonadIO m, HasFilesystemBase sig m) => AppId -> S9ErrT m (Maybe (Some1 AppManifest)) getAppManifest :: (MonadIO m, HasFilesystemBase sig m) => AppId -> S9ErrT m (Maybe AppManifest)
getAppManifest appId = do getAppManifest appId = do
base <- ask @"filesystemBase" base <- ask @"filesystemBase"
ExceptT $ first (ManifestParseE appId) <$> liftIO ExceptT $ first (ManifestParseE appId) <$> liftIO
(Yaml.decodeFileEither . toS $ (appMgrAppPath appId <> "manifest.yaml") `relativeTo` base) (Yaml.decodeFileEither . toS $ (appMgrAppPath appId <> "manifest.yaml") `relativeTo` base)
uiAvailable :: AppManifest n -> Bool uiAvailable :: AppManifest -> Bool
uiAvailable = \case uiAvailable = \case
AppManifestV0 { appManifestV0PortMapping } -> elem 80 (HM.keys appManifestV0PortMapping) AppManifest { appManifestPortMapping } -> elem 80 (HM.keys appManifestPortMapping)