From eda753551acf7bf086fc46495048593cbd22df9b Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Thu, 16 Sep 2021 18:04:22 -0600 Subject: [PATCH] Cleanup/warnings (#53) * implements error log reporting * removes redundant imports --- src/Application.hs | 2 +- src/Handler/ErrorLogs.hs | 3 -- src/Handler/Icons.hs | 68 ++++++++++++++++++---------------------- 3 files changed, 32 insertions(+), 41 deletions(-) diff --git a/src/Application.hs b/src/Application.hs index 7950184..5a19bbd 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -40,7 +40,7 @@ import Network.Wai.Middleware.AcceptOverride import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy) import Network.Wai.Middleware.MethodOverride -import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), +import Network.Wai.Middleware.RequestLogger (Destination (Logger), OutputFormat (..), destination, mkRequestLogger, outputFormat) import System.IO (hSetBuffering, BufferMode (..)) import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) diff --git a/src/Handler/ErrorLogs.hs b/src/Handler/ErrorLogs.hs index 76946ec..aa244a6 100644 --- a/src/Handler/ErrorLogs.hs +++ b/src/Handler/ErrorLogs.hs @@ -5,7 +5,6 @@ module Handler.ErrorLogs where import Control.Monad ( MonadFail(fail) ) import Data.Aeson ( (.:) , FromJSON(parseJSON) - , eitherDecode , withObject , withText ) @@ -25,8 +24,6 @@ data ErrorLog = ErrorLog } deriving (Eq, Show) --- >>> eitherDecode "{ \"log-epoch\": \"1234\", \"log-message\": \"This is the famous budweiser beer\" }" :: Either String ErrorLog --- Variable not in scope: eitherDecode :: t0 -> Either String ErrorLog instance FromJSON ErrorLog where parseJSON = withObject "Error Log" $ \o -> do errorLogEpoch <- o .: "log-epoch" >>= withText diff --git a/src/Handler/Icons.hs b/src/Handler/Icons.hs index 5c41c1d..734e458 100644 --- a/src/Handler/Icons.hs +++ b/src/Handler/Icons.hs @@ -7,27 +7,21 @@ module Handler.Icons where -import Startlude hiding (Handler) +import Startlude hiding ( Handler ) -import Data.Conduit -import qualified Data.Conduit.Combinators as CB -import System.Directory import Yesod.Core +import Data.Aeson +import qualified Data.ByteString.Lazy as BS import Foundation +import Lib.Error +import Lib.External.AppMgr import Lib.Registry +import Lib.Types.AppIndex +import Network.HTTP.Types import Settings -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 -import Data.Aeson -import System.FilePath.Posix +import System.FilePath.Posix +import Util.Shared data IconType = PNG | JPG | JPEG | SVG deriving (Eq, Show, Generic, Read) @@ -49,31 +43,31 @@ getIconsR appId = do servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec case servicePath of Nothing -> notFound - Just p -> do + Just p -> do -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe }) -- respondSource typePlain (runConduit $ yieldMany () [iconBs]) -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS 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 + 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 + 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" @@ -87,7 +81,7 @@ getLicenseR appId = do servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec case servicePath of Nothing -> notFound - Just p -> do + Just p -> do respondSource typePlain (sendChunkBS =<< handleS9ErrT (getLicense appMgrDir p ext)) where ext = Extension (toS appId) :: Extension "s9pk" @@ -101,6 +95,6 @@ getInstructionsR appId = do servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec case servicePath of Nothing -> notFound - Just p -> do + Just p -> do respondSource typePlain (sendChunkBS =<< handleS9ErrT (getInstructions appMgrDir p ext)) where ext = Extension (toS appId) :: Extension "s9pk"