From 72bc7e01ae8728ca55eb500081287f8fc9e72e4c Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Mon, 6 Sep 2021 14:02:59 -0600 Subject: [PATCH] account for icon types --- src/Application.hs | 1 + src/Database/Marketplace.hs | 2 ++ src/Handler/Icons.hs | 39 +++++++++++++++++++++++++++++++++++-- src/Lib/Types/AppIndex.hs | 4 +++- 4 files changed, 43 insertions(+), 3 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 8415a3d..5370c83 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -118,6 +118,7 @@ makeApplication foundation = do dynamicCorsResourcePolicy :: Request -> Maybe CorsResourcePolicy dynamicCorsResourcePolicy req = Just . policy . lookup hOrigin $ requestHeaders req + $logInfo $ show $ requestHeaders req where policy o = simpleCorsResourcePolicy { corsOrigins = (\o' -> ([o'], True)) <$> o diff --git a/src/Database/Marketplace.hs b/src/Database/Marketplace.hs index b2484f9..452cdd7 100644 --- a/src/Database/Marketplace.hs +++ b/src/Database/Marketplace.hs @@ -32,6 +32,8 @@ searchServices category pageItems offset' query = select $ do `innerJoin` table @ServiceCategory `on` (\(s :& sc) -> sc ^. ServiceCategoryServiceId ==. s ^. SAppId) + -- if there is a cateogry, only search in category + -- weight title, short, long (bitcoin should equal Bitcoin Core) where_ $ sc ^. ServiceCategoryCategoryName ==. val category &&. ((service ^. SAppDescShort `ilike` (%) ++. val query ++. (%)) ||. (service ^. SAppDescLong `ilike` (%) ++. val query ++. (%)) diff --git a/src/Handler/Icons.hs b/src/Handler/Icons.hs index 765addf..5c41c1d 100644 --- a/src/Handler/Icons.hs +++ b/src/Handler/Icons.hs @@ -2,6 +2,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} module Handler.Icons where @@ -24,6 +26,18 @@ import Conduit import qualified Data.ByteString.Lazy as BS import Network.HTTP.Types import Lib.Types.AppIndex +import Data.Aeson +import System.FilePath.Posix + +data IconType = PNG | JPG | JPEG | SVG + deriving (Eq, Show, Generic, Read) +instance ToJSON IconType +instance FromJSON IconType + +-- >>> readMaybe $ ixt :: Maybe IconType +-- Just PNG +ixt :: Text +ixt = toS $ toUpper <$> drop 1 ".png" getIconsR :: AppIdentifier -> Handler TypedContent getIconsR appId = do @@ -39,7 +53,28 @@ getIconsR appId = do -- (_, 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)) + manifest' <- handleS9ErrT $ getManifest appMgrDir appsDir ext + manifest <- case eitherDecode $ BS.fromStrict 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 + respondSource mimeType (sendChunkBS =<< handleS9ErrT (getIcon appMgrDir p ext)) where ext = Extension (toS appId) :: Extension "s9pk" getLicenseR :: AppIdentifier -> Handler TypedContent @@ -68,4 +103,4 @@ getInstructionsR appId = do Nothing -> notFound Just p -> do respondSource typePlain (sendChunkBS =<< handleS9ErrT (getInstructions appMgrDir p ext)) - where ext = Extension (toS appId) :: Extension "s9pk" \ No newline at end of file + where ext = Extension (toS appId) :: Extension "s9pk" diff --git a/src/Lib/Types/AppIndex.hs b/src/Lib/Types/AppIndex.hs index 2e7e126..22a20fc 100644 --- a/src/Lib/Types/AppIndex.hs +++ b/src/Lib/Types/AppIndex.hs @@ -167,6 +167,7 @@ data ServiceManifest = ServiceManifest , serviceManifestDescriptionLong :: Text , serviceManifestDescriptionShort :: Text , serviceManifestReleaseNotes :: Text + , serviceManifestIcon :: Maybe Text , serviceManifestAlerts :: HM.HashMap ServiceAlert (Maybe Text) , serviceManifestDependencies :: HM.HashMap AppIdentifier ServiceDependencyInfo } deriving (Show) @@ -177,6 +178,7 @@ instance FromJSON ServiceManifest where serviceManifestVersion <- o .: "version" serviceManifestDescriptionLong <- o .: "description" >>= (.: "long") serviceManifestDescriptionShort <- o .: "description" >>= (.: "short") + serviceManifestIcon <- o .: "assets" >>= (.: "icon") serviceManifestReleaseNotes <- o .: "release-notes" alerts <- o .: "alerts" a <- for (HM.toList alerts) $ \(key, value) -> do @@ -200,7 +202,7 @@ instance ToJSON ServiceManifest where ] -- >>> 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})]}) +-- 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", serviceManifestIcon = Just "icon.png", 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",