fix urls for static files

2026-03-26 02:11:53 +00:00 · 2021-08-24 09:04:05 -06:00
parent aa88306ee1
commit 723602e6f7
7 changed files with 69 additions and 67 deletions
--- a/config/routes
+++ b/config/routes
@@ -2,11 +2,13 @@
 !/package/#S9PK                         AppR               GET -- get most recent appId at appversion spec, defaults to >=0.0.0 -- ?spec={semver-spec}
 /package/data                           CategoriesR        GET -- get all marketplace categories
 /package/index                          PackageListR       GET -- filter marketplace services by various query params
-/eos/latest                             EosR        GET -- get eos information
-/latest-version             VersionLatestR     GET -- get latest version of apps in query param id
+/eos/latest                             EosR               GET -- get eos information
+/latest-version                         VersionLatestR     GET -- get latest version of apps in query param id
 /package/manifest/#AppIdentifier        AppManifestR       GET -- get app manifest from appmgr -- ?version={semver-spec}
 /marketplace/package/release-notes      ReleaseNotesR      GET -- get release notes for package - expects query param of id=<pacakge-id>
-/icons/#PNG                             IconsR             GET -- get icons - expects ?version=<emver>
+/package/icon/#AppIdentifier            IconsR             GET -- get icons - can specify version with ?spec=<emver>
+/package/license/#AppIdentifier         LicenseR           GET -- get icons - can specify version with ?spec=<emver>
+/package/instructions/#AppIdentifier    InstructionsR      GET -- get icons - can specify version with ?spec=<emver>

 -- TODO confirm needed
 /package/config/#AppIdentifier          AppConfigR         GET -- get app config from appmgr -- ?spec={semver-spec}
--- a/src/Handler/Apps.hs
+++ b/src/Handler/Apps.hs
@@ -75,7 +75,7 @@ getAppManifestR :: AppIdentifier -> Handler TypedContent
 getAppManifestR appId = do
    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
    av <- getVersionFromQuery appsDir appExt >>= \case
-        Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
+        Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
        Just v  -> pure v
    let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir
    manifest <- handleS9ErrT $ getManifest appMgrDir appDir appExt
@@ -89,7 +89,7 @@ getAppConfigR appId = do
    let appsDir   = (</> "apps") . resourcesDir $ appSettings
    let appMgrDir = staticBinDir appSettings
    av <- getVersionFromQuery appsDir appExt >>= \case
-        Nothing -> sendResponseStatus status400 ("Specified App Version Not Found" :: Text)
+        Nothing -> sendResponseStatus status404 ("Specified App Version Not Found" :: Text)
        Just v  -> pure v
    let appDir = (<> "/") . (</> show av) . (</> toS appId) $ appsDir
    config <- handleS9ErrT $ getConfig appMgrDir appDir appExt
--- a/src/Handler/Icons.hs
+++ b/src/Handler/Icons.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE TemplateHaskell  #-}

 module Handler.Icons where

@@ -18,44 +19,53 @@ import           System.FilePath ((</>))
 import Util.Shared
 import Lib.External.AppMgr
 import Lib.Error
+import Data.Conduit.Process
+import Conduit
 import qualified Data.ByteString.Lazy as BS
+import Network.HTTP.Types
+import Lib.Types.AppIndex

-getIconsR :: Extension "png" -> Handler TypedContent
-getIconsR ext = do
+getIconsR :: AppIdentifier -> Handler TypedContent
+getIconsR appId = do
    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
+    $logInfo $ show ext
    spec <- getVersionFromQuery appsDir ext >>= \case
-        Nothing -> notFound 
-        Just v -> pure v
-    servicePath <- liftIO $ getVersionedFileFromDir (appsDir </> show spec) ext spec
+        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 -> do
-            icon <- handleS9ErrT $ getIcon appMgrDir p ext
-            respondSource typePlain $ CB.sourceLazy (BS.fromStrict icon) .| awaitForever sendChunkBS
+            -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe })
+            -- respondSource typePlain (runConduit $ yieldMany () [iconBs])
+            -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS
+            respondSource typePlain (sendChunkBS =<< handleS9ErrT (getIcon appMgrDir p ext))
+    where ext = Extension (toS appId) :: Extension "s9pk"

-- getLicenseR :: Extension "" -> Handler TypedContent
-- getLicenseR ext = do
--     AppSettings{..} <- appSettings <$> getYesod
--     mPng <- liftIO $ getUnversionedFileFromDir (resourcesDir </> "icons") ext
--     case mPng of
--         Nothing -> notFound
--         Just pngPath -> do
--             putStrLn @Text $ show pngPath
--             exists <- liftIO $ doesFileExist pngPath
--             if exists
--                 then respondSource typePlain $ CB.sourceFile pngPath .| awaitForever sendChunkBS
--                 else notFound
+getLicenseR :: AppIdentifier -> Handler TypedContent
+getLicenseR appId = do
+    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
+    $logInfo $ show ext
+    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 -> do
+            respondSource typePlain (sendChunkBS =<< handleS9ErrT (getLicense appMgrDir p ext))
+    where ext = Extension (toS appId) :: Extension "s9pk"

-- getMarkdownR :: Extension "md" -> Handler TypedContent
-- getMarkdownR ext = do
--     -- @TODO switch to getting from service directory
--     AppSettings{..} <- appSettings <$> getYesod
--     mPng <- liftIO $ getUnversionedFileFromDir (resourcesDir </> "icons") ext
--     case mPng of
--         Nothing -> notFound
--         Just pngPath -> do
--             putStrLn @Text $ show pngPath
--             exists <- liftIO $ doesFileExist pngPath
--             if exists
--                 then respondSource typePlain $ CB.sourceFile pngPath .| awaitForever sendChunkBS
--                 else notFound
+getInstructionsR :: AppIdentifier -> Handler TypedContent
+getInstructionsR appId = do
+    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
+    $logInfo $ show ext
+    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 -> do
+            respondSource typePlain (sendChunkBS =<< handleS9ErrT (getInstructions appMgrDir p ext))
+    where ext = Extension (toS appId) :: Extension "s9pk"
--- a/src/Handler/Marketplace.hs
+++ b/src/Handler/Marketplace.hs
@@ -46,11 +46,11 @@ instance ToContent CategoryRes where
 instance ToTypedContent CategoryRes where
    toTypedContent = toTypedContent . toJSON
 data ServiceRes =  ServiceRes
-    { serviceResIcon :: Text
+    { serviceResIcon :: URL
    , serviceResManifest :: Maybe Data.Aeson.Value -- ServiceManifest
    , serviceResCategories :: [CategoryTitle]
-    , serviceResInstructions :: Text
-    , serviceResLicense :: Text
+    , serviceResInstructions :: URL
+    , serviceResLicense :: URL
    , serviceResVersions :: [Version]
    , serviceResDependencyInfo :: HM.HashMap AppIdentifier DependencyInfo
    } deriving (Generic)
@@ -296,7 +296,7 @@ getServiceR = do

 getServiceDetails :: Maybe (Entity SVersion) -> Entity SApp -> HandlerFor RegistryCtx ServiceRes
 getServiceDetails maybeVersion service = do
-    (versions, mappedVersions) <- fetchAllAppVersions (entityKey service)
+    (versions, _) <- fetchAllAppVersions (entityKey service)
    categories <- runDB $ fetchAppCategories (entityKey service)
    (appsDir, appMgrDir) <- getsYesod $ ((</> "apps") . resourcesDir &&& staticBinDir) . appSettings
    domain <- getsYesod $ registryHostname . appSettings
@@ -315,37 +315,28 @@ getServiceDetails maybeVersion service = do
                $logError (show e)
                sendResponseStatus status500 ("Internal Server Error" :: Text)
            Right a -> pure a
-    d <- traverse (mapDependencyMetadata appsDir appMgrDir domain) (HM.toList $ serviceManifestDependencies manifest)
-    -- @TODO uncomment when sdk icon working
-    -- icon <- decodeIcon appMgrDir appDir appExt
-    let icon = [i|https://#{domain}/icons/#{appId}.png|]
-    instructions <- decodeInstructions appMgrDir appDir appExt
-    license <- decodeLicense appMgrDir appDir appExt
+    d <- traverse (mapDependencyMetadata appsDir domain) (HM.toList $ serviceManifestDependencies manifest)
    pure $ ServiceRes
-        { serviceResIcon = icon
+        { serviceResIcon = [i|https://#{domain}/package/icon/#{appId}|]
        , serviceResManifest = decode $ BS.fromStrict manifest' -- pass through raw JSON Value
        , serviceResCategories = serviceCategoryCategoryName . entityVal <$> categories
-        , serviceResInstructions = instructions
-        , serviceResLicense = license
+        , serviceResInstructions = [i|https://#{domain}/package/license/#{appId}|]
+        , serviceResLicense = [i|https://#{domain}/package/instructions/#{appId}|]
        , serviceResVersions = versionInfoVersion <$> versions
        , serviceResDependencyInfo = HM.fromList d
        }

 type URL = Text
-mapDependencyMetadata :: (MonadIO m, MonadHandler m) => FilePath -> FilePath -> Text -> (AppIdentifier, ServiceDependencyInfo) -> m (AppIdentifier, DependencyInfo)
-mapDependencyMetadata appsDir appmgrPath domain (appId, depInfo) = do
+mapDependencyMetadata :: (MonadIO m, MonadHandler m) => FilePath -> Text -> (AppIdentifier, ServiceDependencyInfo) -> m (AppIdentifier, DependencyInfo)
+mapDependencyMetadata appsDir domain (appId, depInfo) = do
    let ext = (Extension (toS appId) :: Extension "s9pk")
    -- get best version from VersionRange of dependency
    version <- getBestVersion appsDir ext (serviceDependencyInfoVersion depInfo) >>= \case
        Nothing -> sendResponseStatus status404 ("best version not found for dependent package " <> appId :: Text)
        Just v -> pure v
-    let depPath = appsDir </> toS appId </> show version
-    -- @TODO uncomment when sdk icon working
-    -- icon <- decodeIcon appmgrPath depPath ext
-    let icon = [i|https://#{domain}/icons/#{appId}.png|]
    pure (appId, DependencyInfo
            { dependencyInfoTitle = appId
-            , dependencyInfoIcon = icon
+            , dependencyInfoIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{version}|]
            })

 decodeIcon :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m URL
@@ -430,12 +421,9 @@ mapEntityToStoreApp serviceEntity = do
        , storeAppTimestamp = Just (sAppCreatedAt service) -- case on if updatedAt? or always use updated time? was file timestamp
        }

-mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m) => FilePath -> FilePath -> Text -> Entity SApp ->  ReaderT SqlBackend m ServiceAvailable
-mapEntityToServiceAvailable appMgrDir appsDir domain service = do
-        -- @TODO uncomment and replace icon when portable embassy-sdk live
-        -- icon <- decodeIcon appMgrDir appsDir (Extension "png")
+mapEntityToServiceAvailable :: (MonadIO m, MonadHandler m) => Text -> Entity SApp ->  ReaderT SqlBackend m ServiceAvailable
+mapEntityToServiceAvailable domain service = do
        let appId = sAppAppId $ entityVal service
-        let icon = [i|https://#{domain}/icons/#{appId}.png|]
        (_, v) <- fetchLatestApp appId >>= errOnNothing status404 "service not found"
        let appVersion = sVersionNumber (entityVal v)
        pure $ ServiceAvailable
@@ -443,7 +431,7 @@ mapEntityToServiceAvailable appMgrDir appsDir domain service = do
            , serviceAvailableTitle = sAppTitle $ entityVal service
            , serviceAvailableDescShort = sAppDescShort $ entityVal service
            , serviceAvailableVersion = appVersion
-            , serviceAvailableIcon = icon
+            , serviceAvailableIcon = [i|https://#{domain}/package/icon/#{appId}?spec==#{appVersion}|]
            }

 -- >>> encode hm
--- a/src/Lib/External/AppMgr.hs
+++ b/src/Lib/External/AppMgr.hs
@@ -58,7 +58,7 @@ getManifest appmgrPath appPath e@(Extension appId) = do

 getIcon ::  (MonadIO m, KnownSymbol a)  => FilePath -> FilePath ->  Extension a -> S9ErrT m ByteString
 getIcon appmgrPath appPath e@(Extension icon) = do
-    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath <> show e] ""
+    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "icon", appPath] ""
    case ec of
        ExitSuccess -> pure bs
        ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect icon #{icon}|] n
@@ -72,14 +72,14 @@ getPackageHash appmgrPath appPath e@(Extension appId) = do

 getInstructions ::  (MonadIO m, KnownSymbol a)  => FilePath -> FilePath ->  Extension a -> S9ErrT m ByteString
 getInstructions appmgrPath appPath e@(Extension appId) = do
-    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath <> show e] ""
+    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "instructions", appPath] ""
    case ec of
        ExitSuccess -> pure bs
        ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect instructions #{appId}|] n

 getLicense ::  (MonadIO m, KnownSymbol a)  => FilePath -> FilePath ->  Extension a -> S9ErrT m ByteString
 getLicense appmgrPath appPath e@(Extension appId) = do
-    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath <> show e] ""
+    (ec, bs) <- readProcessInheritStderr (appmgrPath <> "embassy-sdk") ["inspect", "license", appPath] ""
    case ec of
        ExitSuccess -> pure bs
        ExitFailure n -> throwE $ AppMgrE [i|embassy-sdk inspect license #{appId}|] n
--- a/src/Lib/Registry.hs
+++ b/src/Lib/Registry.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TemplateHaskell    #-}

 module Lib.Registry where

--- a/src/Util/Shared.hs
+++ b/src/Util/Shared.hs
@@ -29,6 +29,7 @@ getBestVersion rootDir ext spec = do
    appVersions <- liftIO $ getAvailableAppVersions rootDir ext
    let satisfactory = filter ((<|| spec) . fst . unRegisteredAppVersion) appVersions
    let best         = getMax <$> foldMap (Just . Max . fst . unRegisteredAppVersion) satisfactory
+    $logInfo $ show best
    pure best

 addPackageHeader :: (MonadHandler m, KnownSymbol a) => FilePath -> FilePath -> Extension a -> m ()