fix icon endpoint

config/settings.yml

@@ -18,7 +18,7 @@ ip-from-header: "_env:YESOD_IP_FROM_HEADER:false"
 # Optional values with the following production defaults.
 # In development, they default to the inverse.
 #
-detailed-logging: false
+detailed-logging: true
 # should-log-all: false
 # reload-templates: false
 # mutable-static: false

src/Handler/Icons.hs

@@ -36,45 +36,40 @@ ixt = toS $ toUpper <$> drop 1 ".png"
 getIconsR :: AppIdentifier -> Handler TypedContent
 getIconsR 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
+    let appDir = (<> "/") . (</> show spec) . (</> toS appId) $ appsDir
-    case servicePath of
+    manifest' <- handleS9ErrT $ getManifest appMgrDir appDir ext
-        Nothing -> notFound
+    manifest  <- case eitherDecode $ BS.fromStrict manifest' of
-        Just p  -> do
+        Left e -> do
-            -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe })
+            $logError "could not parse service manifest!"
-            -- respondSource typePlain (runConduit $ yieldMany () [iconBs])
+            $logError (show e)
-            -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS
+            sendResponseStatus status500 ("Internal Server Error" :: Text)
-            manifest' <- handleS9ErrT $ getManifest appMgrDir appsDir ext
+        Right a -> pure a
-            manifest  <- case eitherDecode $ BS.fromStrict manifest' of
+    mimeType <- case serviceManifestIcon manifest of
-                Left e -> do
+        Nothing -> pure typePng
-                    $logError "could not parse service manifest!"
+        Just a  -> do
-                    $logError (show e)
+            let (_, iconExt) = splitExtension $ toS a
-                    sendResponseStatus status500 ("Internal Server Error" :: Text)
+            let x            = toUpper <$> drop 1 iconExt
-                Right a -> pure a
+            case readMaybe $ toS x of
-            mimeType <- case serviceManifestIcon manifest of
+                Nothing -> do
-                Nothing -> pure typePng
+                    $logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain."
-                Just a  -> do
+                    pure typePlain
-                    let (_, iconExt) = splitExtension $ toS a
+                Just iconType -> case iconType of
-                    let x            = toUpper <$> drop 1 iconExt
+                        PNG  -> pure typePng
-                    case readMaybe $ toS x of
+                        SVG  -> pure typeSvg
-                        Nothing -> do
+                        JPG  -> pure typeJpeg
-                            $logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain."
+                        JPEG -> pure typeJpeg
-                            pure typePlain
+    respondSource mimeType (sendChunkBS =<< handleS9ErrT (getIcon appMgrDir (appDir </> show ext) ext))
-                        Just iconType -> case iconType of
+    -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe })
-                            PNG  -> pure typePng
+    -- respondSource typePlain (runConduit $ yieldMany () [iconBs])
-                            SVG  -> pure typeSvg
+    -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS
-                            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
 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
@@ -88,7 +83,6 @@ getLicenseR appId = do
 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

src/Util/Shared.hs

@@ -29,7 +29,6 @@ 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 ()