Feature/encode icons (#91)

* base64 encode icon in package response

* adds icons to dependencies

* swap arguments for loadIcon

* remove redundant constraint

Co-authored-by: Keagan McClelland <keagan.mcclelland@gmail.com>

package.yaml

@@ -14,6 +14,7 @@ default-extensions:
 
 dependencies:
   - base >=4.12 && <5
+  - base64
   - aeson
   - ansi-terminal
   - attoparsec

src/Handler/Marketplace.hs

@@ -25,7 +25,9 @@ import           Conduit                        ( (.|)
                                                 , sourceFile
                                                 , takeC
                                                 )
-import           Control.Monad.Logger           ( MonadLogger, logWarn )
+import           Control.Monad.Logger           ( MonadLogger
+                                                , logWarn
+                                                )
 import           Control.Monad.Reader.Has       ( Has
                                                 , ask
                                                 )
@@ -36,10 +38,12 @@ import           Data.Aeson                     ( decode
                                                 , eitherDecodeStrict
                                                 )
 import qualified Data.Attoparsec.Text          as Atto
-import           Data.ByteArray.Encoding        ( Base(Base16)
+
+import           Data.ByteArray.Encoding        ( Base(..)
                                                 , convertToBase
                                                 )
-import qualified Data.ByteString.Lazy          as BS
+import           Data.ByteString.Base64
+import qualified Data.ByteString.Lazy          as LBS
 import qualified Data.Conduit.List             as CL
 import qualified Data.HashMap.Strict           as HM
 import           Data.List                      ( head
@@ -61,31 +65,36 @@ import           Database.Esqueleto.Experimental
                                                 , select
                                                 , table
                                                 )
-import           Database.Marketplace           ( getPkgData
+import           Database.Marketplace           ( fetchAllAppVersions
-                                                , searchServices
-                                                , zipVersions
-                                                , fetchAllAppVersions
                                                 , fetchLatestApp
-                                                , getPkgDependencyData, zipDependencyVersions, zipCategories
+                                                , getPkgData
+                                                , getPkgDependencyData
+                                                , searchServices
+                                                , zipCategories
+                                                , zipDependencyVersions
+                                                , zipVersions
                                                 )
 import           Database.Persist               ( PersistUniqueRead(getBy)
                                                 , insertUnique
                                                 )
 import           Foundation                     ( Handler
-                                                , RegistryCtx(appSettings, appConnPool), Route (IconsR, InstructionsR, LicenseR)
+                                                , RegistryCtx(appConnPool, appSettings)
+                                                , Route(InstructionsR, LicenseR)
                                                 )
 import           Handler.Types.Marketplace
-import           Lib.Error                      ( S9Error(..)
+import           Lib.Error                      ( S9Error(..) )
-                                                )
+import           Lib.PkgRepository              ( PkgRepo
-import           Lib.PkgRepository              ( getManifest )
+                                                , getIcon
-import           Lib.Types.AppIndex             ( PkgId(PkgId)
+                                                , getManifest
                                                 )
+import           Lib.Types.AppIndex             ( PkgId(PkgId) )
 import           Lib.Types.AppIndex             ( )
 import           Lib.Types.Category             ( CategoryTitle(..) )
 import           Lib.Types.Emver                ( Version
+                                                , VersionRange
                                                 , parseRange
                                                 , parseVersion
-                                                , satisfies, VersionRange
+                                                , satisfies
                                                 )
 import           Model                          ( Category(..)
                                                 , EntityField(..)
@@ -107,24 +116,25 @@ import           UnliftIO.Async                 ( concurrently
                                                 , mapConcurrently
                                                 )
 import           UnliftIO.Directory             ( listDirectory )
-import           Util.Shared                    ( getVersionSpecFromQuery
+import           Util.Shared                    ( filterDependencyBestVersion
+                                                , filterDependencyOsCompatible
                                                 , filterLatestVersionFromSpec
                                                 , filterPkgOsCompatible
-                                                , filterDependencyOsCompatible
+                                                , getVersionSpecFromQuery
-                                                , filterDependencyBestVersion
                                                 )
 import           Yesod.Core                     ( MonadResource
+                                                , RenderRoute(renderRoute)
                                                 , TypedContent
                                                 , YesodRequest(..)
                                                 , addHeader
                                                 , getRequest
+                                                , getYesod
                                                 , getsYesod
                                                 , lookupGetParam
                                                 , respondSource
                                                 , sendChunkBS
                                                 , sendResponseStatus
                                                 , typeOctet
-                                                , getYesod, RenderRoute (renderRoute)
                                                 )
 import           Yesod.Persist                  ( YesodDB )
 import           Yesod.Persist.Core             ( YesodPersist(runDB) )
@@ -205,7 +215,7 @@ getVersionLatestR = do
     getParameters <- reqGetParams <$> getRequest
     case lookup "ids" getParameters of
         Nothing       -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>")
-        Just packages -> case eitherDecode $ BS.fromStrict $ encodeUtf8 packages of
+        Just packages -> case eitherDecode $ LBS.fromStrict $ encodeUtf8 packages of
             Left  _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages)
             Right p -> do
                 let packageList = (, Nothing) <$> p
@@ -315,8 +325,20 @@ getPackageListR = do
                     $logWarn (show e)
                     sendResponseStatus status400 e
                 Right v -> pure $ Just v
-        getPackageDependencies :: (MonadIO m, MonadLogger m) => (Version -> Bool) -> PackageMetadata -> ReaderT SqlBackend m (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)])
+        getPackageDependencies :: (MonadIO m, MonadLogger m)
-        getPackageDependencies osPredicate PackageMetadata { packageMetadataPkgRecord = pkg, packageMetadataPkgVersionRecords = pkgVersions, packageMetadataPkgCategories = pkgCategories, packageMetadataPkgVersion = pkgVersion} = do
+                               => (Version -> Bool)
+                               -> PackageMetadata
+                               -> ReaderT
+                                      SqlBackend
+                                      m
+                                      ( Key PkgRecord
+                                      , [Category]
+                                      , [Version]
+                                      , Version
+                                      , [(Key PkgRecord, Text, Version)]
+                                      )
+        getPackageDependencies osPredicate PackageMetadata { packageMetadataPkgRecord = pkg, packageMetadataPkgVersionRecords = pkgVersions, packageMetadataPkgCategories = pkgCategories, packageMetadataPkgVersion = pkgVersion }
+            = do
                 let pkgId          = entityKey pkg
                 let pkgVersions' = versionRecordNumber . entityVal <$> pkgVersions
                 let pkgCategories' = entityVal <$> pkgCategories
@@ -325,32 +347,44 @@ getPackageListR = do
                 let compatiblePkgDepInfo = fmap (filterDependencyOsCompatible osPredicate) pkgDepInfoWithVersions
                 res <- catMaybes <$> traverse filterDependencyBestVersion compatiblePkgDepInfo
                 pure $ (pkgId, pkgCategories', pkgVersions', pkgVersion, res)
-        constructPackageListApiRes :: (MonadResource m, MonadReader r m, Has AppSettings r) => (Key PkgRecord, [Category], [Version], Version, [(Key PkgRecord, Text, Version)]) -> m PackageRes
+        constructPackageListApiRes :: (MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r)
+                                   => ( Key PkgRecord
+                                      , [Category]
+                                      , [Version]
+                                      , Version
+                                      , [(Key PkgRecord, Text, Version)]
+                                      )
+                                   -> m PackageRes
         constructPackageListApiRes (pkgKey, pkgCategories, pkgVersions, pkgVersion, dependencies) = do
             settings <- ask @_ @_ @AppSettings
             let pkgId = unPkgRecordKey pkgKey
             manifest <- flip runReaderT settings $ (snd <$> getManifest pkgId pkgVersion) >>= \bs ->
-                runConduit $ bs .| CL.foldMap BS.fromStrict
+                runConduit $ bs .| CL.foldMap LBS.fromStrict
-            pure $ PackageRes
+            icon <- loadIcon pkgId pkgVersion
-                        { packageResIcon         = basicRender $ IconsR pkgId
+            deps <- constructDependenciesApiRes dependencies
+            pure $ PackageRes { packageResIcon         = encodeBase64 icon
                         -- pass through raw JSON Value, we have checked its correct parsing above
                               , packageResManifest     = unsafeFromJust . decode $ manifest
                               , packageResCategories   = categoryName <$> pkgCategories
                               , packageResInstructions = basicRender $ InstructionsR pkgId
                               , packageResLicense      = basicRender $ LicenseR pkgId
                               , packageResVersions     = pkgVersions
-                        , packageResDependencies = HM.fromList $ constructDependenciesApiRes dependencies
+                              , packageResDependencies = HM.fromList deps
                               }
-        constructDependenciesApiRes :: [(Key PkgRecord, Text, Version)]
+        constructDependenciesApiRes :: (MonadResource m, MonadReader r m, Has PkgRepo r)
-                            -> [(PkgId, DependencyRes)]
+                                    => [(Key PkgRecord, Text, Version)]
-        constructDependenciesApiRes deps = fmap (\(depKey, depTitle, depVersion) -> do
+                                    -> m [(PkgId, DependencyRes)]
+        constructDependenciesApiRes deps = traverse
+            (\(depKey, depTitle, depVersion) -> do
                 let depId = unPkgRecordKey depKey
-                (depId, DependencyRes { dependencyResTitle = depTitle, dependencyResIcon  = (basicRender $ IconsR depId) <> [i|?spec==#{depVersion}|]})) deps
+                icon <- loadIcon depId depVersion
+                pure (depId, DependencyRes { dependencyResTitle = depTitle, dependencyResIcon = encodeBase64 icon })
+            )
+            deps
+        loadIcon :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m ByteString
+        loadIcon pkg version = do
+            (_, _, src) <- getIcon pkg version
+            runConduit $ src .| CL.foldMap id
 
 basicRender :: RenderRoute a => Route a -> Text
-basicRender = TL.toStrict
+basicRender = TL.toStrict . TB.toLazyText . fold . fmap (mappend (TB.singleton '/') . TB.fromText) . fst . renderRoute
-    . TB.toLazyText
-    . fold
-    . fmap (mappend (TB.singleton '/') . TB.fromText)
-    . fst
-    . renderRoute

src/Handler/Types/Marketplace.hs

@@ -69,7 +69,7 @@ instance FromJSON PackageRes where
         pure PackageRes { .. }
 data DependencyRes = DependencyRes
     { dependencyResTitle :: Text -- TODO switch to `Text` to display actual title in Marketplace. Confirm with FE that this will not break loading. Perhaps return title and id?
-    , dependencyResIcon  :: URL
+    , dependencyResIcon  :: Text
     }
     deriving (Eq, Show)
 instance ToJSON DependencyRes where