From 1fc3c2b678edf343ac916be1f5c26e507c2f396e Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Mon, 27 Sep 2021 20:26:03 -0600 Subject: [PATCH] redefine appmgr calls, holes at call sites --- src/Handler/Apps.hs | 23 ++++---- src/Handler/Icons.hs | 109 +++++++++++++++++++------------------ src/Handler/Marketplace.hs | 69 +++++++++++------------ src/Lib/External/AppMgr.hs | 40 +++++++------- src/Lib/PkgRepository.hs | 13 ++--- 5 files changed, 128 insertions(+), 126 deletions(-) diff --git a/src/Handler/Apps.hs b/src/Handler/Apps.hs index 531cace..b2c401a 100644 --- a/src/Handler/Apps.hs +++ b/src/Handler/Apps.hs @@ -72,17 +72,18 @@ getSysR e = do getAppManifestR :: PkgId -> Handler TypedContent getAppManifestR appId = do - (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings - av <- getVersionFromQuery appsDir appExt >>= \case - Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) - Just v -> pure v - let appDir = (<> "/") . ( show av) . ( show appId) $ appsDir - addPackageHeader appMgrDir appDir appExt - sourceManifest appMgrDir - appDir - appExt - (\bsSource -> respondSource "application/json" (bsSource .| awaitForever sendChunkBS)) - where appExt = Extension (show appId) :: Extension "s9pk" + -- (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings + -- av <- getVersionFromQuery appsDir appExt >>= \case + -- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) + -- Just v -> pure v + -- let appDir = (<> "/") . ( show av) . ( show appId) $ appsDir + -- addPackageHeader appMgrDir appDir appExt + -- sourceManifest appMgrDir + -- appDir + -- appExt + -- (\bsSource -> respondSource "application/json" (bsSource .| awaitForever sendChunkBS)) + -- where appExt = Extension (show appId) :: Extension "s9pk" + _ getAppR :: Extension "s9pk" -> Handler TypedContent getAppR e = do diff --git a/src/Handler/Icons.hs b/src/Handler/Icons.hs index 5fed13b..6ba81cf 100644 --- a/src/Handler/Icons.hs +++ b/src/Handler/Icons.hs @@ -39,62 +39,65 @@ ixt = toS $ toUpper <$> drop 1 ".png" getIconsR :: PkgId -> Handler TypedContent getIconsR appId = do - (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings - spec <- getVersionFromQuery appsDir ext >>= \case - Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) - Just v -> pure v - let appDir = (<> "/") . ( show spec) . ( show appId) $ appsDir - manifest' <- sourceManifest appMgrDir appDir ext (\bsSource -> runConduit $ bsSource .| CL.foldMap BS.fromStrict) - manifest <- case eitherDecode manifest' of - Left e -> do - $logError "could not parse service manifest!" - $logError (show e) - sendResponseStatus status500 ("Internal Server Error" :: Text) - Right a -> pure a - mimeType <- case serviceManifestIcon manifest of - Nothing -> pure typePng - Just a -> do - let (_, iconExt) = splitExtension $ toS a - let x = toUpper <$> drop 1 iconExt - case readMaybe $ toS x of - Nothing -> do - $logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain." - pure typePlain - Just iconType -> case iconType of - PNG -> pure typePng - SVG -> pure typeSvg - JPG -> pure typeJpeg - JPEG -> pure typeJpeg - sourceIcon appMgrDir - (appDir show ext) - ext - (\bsSource -> respondSource mimeType (bsSource .| awaitForever sendChunkBS)) - where ext = Extension (show appId) :: Extension "s9pk" + -- (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings + -- spec <- getVersionFromQuery appsDir ext >>= \case + -- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) + -- Just v -> pure v + -- let appDir = (<> "/") . ( show spec) . ( show appId) $ appsDir + -- manifest' <- sourceManifest appMgrDir appDir ext (\bsSource -> runConduit $ bsSource .| CL.foldMap BS.fromStrict) + -- manifest <- case eitherDecode manifest' of + -- Left e -> do + -- $logError "could not parse service manifest!" + -- $logError (show e) + -- sendResponseStatus status500 ("Internal Server Error" :: Text) + -- Right a -> pure a + -- mimeType <- case serviceManifestIcon manifest of + -- Nothing -> pure typePng + -- Just a -> do + -- let (_, iconExt) = splitExtension $ toS a + -- let x = toUpper <$> drop 1 iconExt + -- case readMaybe $ toS x of + -- Nothing -> do + -- $logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain." + -- pure typePlain + -- Just iconType -> case iconType of + -- PNG -> pure typePng + -- SVG -> pure typeSvg + -- JPG -> pure typeJpeg + -- JPEG -> pure typeJpeg + -- sourceIcon appMgrDir + -- (appDir show ext) + -- ext + -- (\bsSource -> respondSource mimeType (bsSource .| awaitForever sendChunkBS)) + -- where ext = Extension (show appId) :: Extension "s9pk" + _ getLicenseR :: PkgId -> Handler TypedContent getLicenseR appId = do - (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings - spec <- getVersionFromQuery appsDir ext >>= \case - Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) - Just v -> pure v - servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec - case servicePath of - Nothing -> notFound - Just p -> - sourceLicense appMgrDir p ext (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS)) - where ext = Extension (show appId) :: Extension "s9pk" + -- (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings + -- spec <- getVersionFromQuery appsDir ext >>= \case + -- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) + -- Just v -> pure v + -- servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec + -- case servicePath of + -- Nothing -> notFound + -- Just p -> + -- sourceLicense appMgrDir p ext (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS)) + -- where ext = Extension (show appId) :: Extension "s9pk" + _ getInstructionsR :: PkgId -> Handler TypedContent getInstructionsR appId = do - (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings - spec <- getVersionFromQuery appsDir ext >>= \case - Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) - Just v -> pure v - servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec - case servicePath of - Nothing -> notFound - Just p -> sourceInstructions appMgrDir - p - ext - (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS)) - where ext = Extension (show appId) :: Extension "s9pk" + -- (appsDir, appMgrDir) <- getsYesod $ (( "apps") . resourcesDir &&& staticBinDir) . appSettings + -- spec <- getVersionFromQuery appsDir ext >>= \case + -- Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text) + -- Just v -> pure v + -- servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec + -- case servicePath of + -- Nothing -> notFound + -- Just p -> sourceInstructions appMgrDir + -- p + -- ext + -- (\bsSource -> respondSource typePlain (bsSource .| awaitForever sendChunkBS)) + -- where ext = Extension (show appId) :: Extension "s9pk" + _ diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index a7a0c35..7c04156 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -329,34 +329,35 @@ getServiceDetails :: (MonadUnliftIO m, Monad m, MonadError IOException m) -> PkgId -> m (Either Text ServiceRes) getServiceDetails settings metadata maybeVersion appId = do - packageMetadata <- case HM.lookup appId metadata of - Nothing -> throwIO $ NotFoundE [i|#{appId} not found.|] - Just m -> pure m - let (appsDir, appMgrDir) = (( "apps") . resourcesDir &&& staticBinDir) settings - let domain = registryHostname settings - version <- case maybeVersion of - Nothing -> do - -- grab first value, which will be the latest version - case fst packageMetadata of - [] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId - x : _ -> pure x - Just v -> pure v - let appDir = (<> "/") . ( show version) . ( show appId) $ appsDir - let appExt = Extension (show appId) :: Extension "s9pk" - manifest' <- sourceManifest appMgrDir appDir appExt (\bs -> sinkMem (bs .| mapC BS.fromStrict)) - case eitherDecode $ manifest' of - Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e - Right m -> do - d <- liftIO - $ mapConcurrently (mapDependencyMetadata domain metadata) (HM.toList $ serviceManifestDependencies m) - pure $ Right $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|] - , serviceResManifest = decode $ manifest' -- pass through raw JSON Value - , serviceResCategories = snd packageMetadata - , serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|] - , serviceResLicense = [i|https://#{domain}/package/license/#{appId}|] - , serviceResVersions = sortOn Down $ fst packageMetadata - , serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d - } + -- packageMetadata <- case HM.lookup appId metadata of + -- Nothing -> throwIO $ NotFoundE [i|#{appId} not found.|] + -- Just m -> pure m + -- let (appsDir, appMgrDir) = (( "apps") . resourcesDir &&& staticBinDir) settings + -- let domain = registryHostname settings + -- version <- case maybeVersion of + -- Nothing -> do + -- -- grab first value, which will be the latest version + -- case fst packageMetadata of + -- [] -> throwIO $ NotFoundE $ "no latest version found for " <> show appId + -- x : _ -> pure x + -- Just v -> pure v + -- let appDir = (<> "/") . ( show version) . ( show appId) $ appsDir + -- let appExt = Extension (show appId) :: Extension "s9pk" + -- manifest' <- sourceManifest appMgrDir appDir appExt (\bs -> sinkMem (bs .| mapC BS.fromStrict)) + -- case eitherDecode $ manifest' of + -- Left e -> pure $ Left $ "Could not parse service manifest for " <> show appId <> ": " <> show e + -- Right m -> do + -- d <- liftIO $ mapConcurrently (mapDependencyMetadata domain metadata) + -- (HM.toList $ serviceManifestDependencies m) + -- pure $ Right $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|] + -- , serviceResManifest = decode $ manifest' -- pass through raw JSON Value + -- , serviceResCategories = snd packageMetadata + -- , serviceResInstructions = [i|https://#{domain}/package/instructions/#{appId}|] + -- , serviceResLicense = [i|https://#{domain}/package/license/#{appId}|] + -- , serviceResVersions = fst packageMetadata + -- , serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d + -- } + _ mapDependencyMetadata :: (MonadIO m) => Text @@ -380,13 +381,13 @@ mapDependencyMetadata domain metadata (appId, depInfo) = do } ) -decodeInstructions :: (MonadUnliftIO m, MonadHandler m, MonadThrow m) => FilePath -> FilePath -> S9PK -> m Text -decodeInstructions appmgrPath depPath package = do - sourceInstructions appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8)) +-- decodeInstructions :: (MonadUnliftIO m, MonadHandler m, MonadThrow m) => FilePath -> FilePath -> S9PK -> m Text +-- decodeInstructions appmgrPath depPath package = do +-- sourceInstructions appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8)) -decodeLicense :: (MonadUnliftIO m, MonadThrow m, MonadHandler m) => FilePath -> FilePath -> S9PK -> m Text -decodeLicense appmgrPath depPath package = - sourceLicense appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8)) +-- decodeLicense :: (MonadUnliftIO m, MonadThrow m, MonadHandler m) => FilePath -> FilePath -> S9PK -> m Text +-- decodeLicense appmgrPath depPath package = +-- sourceLicense appmgrPath depPath package (\bs -> sinkMem (bs .| CT.decode CT.utf8)) fetchAllAppVersions :: Key SApp -> HandlerFor RegistryCtx ([VersionInfo], ReleaseNotes) fetchAllAppVersions appId = do diff --git a/src/Lib/External/AppMgr.hs b/src/Lib/External/AppMgr.hs index 2479a82..70a6ab0 100644 --- a/src/Lib/External/AppMgr.hs +++ b/src/Lib/External/AppMgr.hs @@ -56,31 +56,31 @@ readProcessInheritStderr a b c sink = do $ System.Process.Typed.proc a b withProcessTerm_ pc $ \p -> sink (getStdout p) -sourceManifest :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r -sourceManifest appmgrPath appPath e@(Extension appId) sink = do - let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "manifest", appPath show e] "" - appmgr sink `catch` \ece -> throwIO (AppMgrE [i|embassy-sdk inspect manifest #{appId}|] (eceExitCode ece)) +sourceManifest :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r +sourceManifest appmgrPath pkgFile sink = do + let appmgr = readProcessInheritStderr (appmgrPath "embassy-sdk") ["inspect", "manifest", pkgFile] "" + appmgr sink `catch` \ece -> throwIO (AppMgrE [i|embassy-sdk inspect manifest #{pkgFile}|] (eceExitCode ece)) -sourceIcon :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r -sourceIcon appmgrPath appPath (Extension icon) sink = do - let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath] "" - appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect icon #{icon}|] (eceExitCode ece) +sourceIcon :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r +sourceIcon appmgrPath pkgFile sink = do + let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", pkgFile] "" + appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect icon #{pkgFile}|] (eceExitCode ece) -getPackageHash :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> m ByteString -getPackageHash appmgrPath appPath e@(Extension appId) = do - let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "hash", appPath <> show e] "" +getPackageHash :: (MonadUnliftIO m) => FilePath -> FilePath -> m ByteString +getPackageHash appmgrPath pkgFile = do + let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "hash", pkgFile] "" appmgr (\bsSource -> runConduit $ bsSource .| CL.foldMap id) - `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect hash #{appId}|] (eceExitCode ece) + `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect hash #{pkgFile}|] (eceExitCode ece) -sourceInstructions :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r -sourceInstructions appmgrPath appPath (Extension appId) sink = do - let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath] "" - appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect instructions #{appId}|] (eceExitCode ece) +sourceInstructions :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r +sourceInstructions appmgrPath pkgFile sink = do + let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", pkgFile] "" + appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect instructions #{pkgFile}|] (eceExitCode ece) -sourceLicense :: (MonadUnliftIO m) => FilePath -> FilePath -> S9PK -> (ConduitT () ByteString m () -> m r) -> m r -sourceLicense appmgrPath appPath (Extension appId) sink = do - let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath] "" - appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect license #{appId}|] (eceExitCode ece) +sourceLicense :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r +sourceLicense appmgrPath pkgFile sink = do + let appmgr = readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", pkgFile] "" + appmgr sink `catch` \ece -> throwIO $ AppMgrE [i|embassy-sdk inspect license #{pkgFile}|] (eceExitCode ece) sinkMem :: (Monad m, Monoid a) => ConduitT () a m () -> m a sinkMem c = runConduit $ c .| CL.foldMap id diff --git a/src/Lib/PkgRepository.hs b/src/Lib/PkgRepository.hs index fc56e91..7ec9b0d 100644 --- a/src/Lib/PkgRepository.hs +++ b/src/Lib/PkgRepository.hs @@ -108,17 +108,14 @@ extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) extractPkg pkg v = (`onException` cleanup) $ do $logInfo [i|Extracting package: #{pkg}@#{v}|] PkgRepo { pkgRepoFileRoot = root, pkgRepoAppMgrBin = appmgr } <- ask - let s9pk = Extension @"s9pk" $ show pkg let pkgRoot = root show pkg show v - $logInfo [i|#{s9pk}|] - $logInfo [i|#{pkgRoot}|] - manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr pkgRoot s9pk $ sinkIt + let s9pk = pkgRoot show pkg <.> "s9pk" + manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr s9pk $ sinkIt (pkgRoot "manifest.json") - instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr pkgRoot s9pk $ sinkIt + instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr s9pk $ sinkIt (pkgRoot "instructions.md") - licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr pkgRoot s9pk $ sinkIt - (pkgRoot "license.md") - iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr pkgRoot s9pk $ sinkIt (pkgRoot "icon.tmp") + licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr s9pk $ sinkIt (pkgRoot "license.md") + iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr s9pk $ sinkIt (pkgRoot "icon.tmp") wait manifestTask eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot "manifest.json")) case eManifest of