account for icon types

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"
+    where ext = Extension (toS appId) :: Extension "s9pk"