Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

Cleanup/warnings (#53)

Browse Source 
* implements error log reporting

* removes redundant imports
This commit is contained in:
Keagan McClelland
2021-09-16 18:04:22 -06:00
parent f2364e742e
commit eda753551a
3 changed files with 32 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/Application.hs
View File

@@ -40,7 +40,7 @@ import Network.Wai.Middleware.AcceptOverride
import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.Autohead
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy) import Network.Wai.Middleware.Cors (CorsResourcePolicy (..), cors, simpleCorsResourcePolicy)
import Network.Wai.Middleware.MethodOverride 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) destination, mkRequestLogger, outputFormat)
import System.IO (hSetBuffering, BufferMode (..)) import System.IO (hSetBuffering, BufferMode (..))
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr) import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, toLogStr)

3
src/Handler/ErrorLogs.hs
View File

@@ -5,7 +5,6 @@ module Handler.ErrorLogs where
import Control.Monad ( MonadFail(fail) ) import Control.Monad ( MonadFail(fail) )
import Data.Aeson ( (.:) import Data.Aeson ( (.:)
, FromJSON(parseJSON) , FromJSON(parseJSON)
, eitherDecode
, withObject , withObject
, withText , withText
) )
@@ -25,8 +24,6 @@ data ErrorLog = ErrorLog
} }
deriving (Eq, Show) 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 instance FromJSON ErrorLog where
parseJSON = withObject "Error Log" $ \o -> do parseJSON = withObject "Error Log" $ \o -> do
errorLogEpoch <- o .: "log-epoch" >>= withText errorLogEpoch <- o .: "log-epoch" >>= withText

68
src/Handler/Icons.hs
View File

@@ -7,27 +7,21 @@
module Handler.Icons where 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 Yesod.Core
import Data.Aeson
import qualified Data.ByteString.Lazy as BS
import Foundation import Foundation
import Lib.Error
import Lib.External.AppMgr
import Lib.Registry import Lib.Registry
import Lib.Types.AppIndex
import Network.HTTP.Types
import Settings import Settings
import System.FilePath ((</>)) import System.FilePath.Posix
import Util.Shared 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
data IconType = PNG | JPG | JPEG | SVG data IconType = PNG | JPG | JPEG | SVG
deriving (Eq, Show, Generic, Read) deriving (Eq, Show, Generic, Read)
@@ -49,31 +43,31 @@ getIconsR appId = do
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
case servicePath of case servicePath of
Nothing -> notFound Nothing -> notFound
Just p -> do Just p -> do
-- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe }) -- (_, Just hout, _, _) <- liftIO (createProcess $ iconBs { std_out = CreatePipe })
-- respondSource typePlain (runConduit $ yieldMany () [iconBs]) -- respondSource typePlain (runConduit $ yieldMany () [iconBs])
-- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS -- respondSource typePlain $ sourceHandle hout .| awaitForever sendChunkBS
manifest' <- handleS9ErrT $ getManifest appMgrDir appsDir ext manifest' <- handleS9ErrT $ getManifest appMgrDir appsDir ext
manifest <- case eitherDecode $ BS.fromStrict manifest' of manifest <- case eitherDecode $ BS.fromStrict manifest' of
Left e -> do Left e -> do
$logError "could not parse service manifest!" $logError "could not parse service manifest!"
$logError (show e) $logError (show e)
sendResponseStatus status500 ("Internal Server Error" :: Text) sendResponseStatus status500 ("Internal Server Error" :: Text)
Right a -> pure a Right a -> pure a
mimeType <- case serviceManifestIcon manifest of mimeType <- case serviceManifestIcon manifest of
Nothing -> pure typePng Nothing -> pure typePng
Just a -> do Just a -> do
let (_, iconExt) = splitExtension $ toS a let (_, iconExt) = splitExtension $ toS a
let x = toUpper <$> drop 1 iconExt let x = toUpper <$> drop 1 iconExt
case readMaybe $ toS x of case readMaybe $ toS x of
Nothing -> do Nothing -> do
$logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain." $logInfo $ "unknown icon extension type: " <> show x <> ". Sending back typePlain."
pure typePlain pure typePlain
Just iconType -> case iconType of Just iconType -> case iconType of
PNG -> pure typePng PNG -> pure typePng
SVG -> pure typeSvg SVG -> pure typeSvg
JPG -> pure typeJpeg JPG -> pure typeJpeg
JPEG -> pure typeJpeg JPEG -> pure typeJpeg
respondSource mimeType (sendChunkBS =<< handleS9ErrT (getIcon appMgrDir p ext)) respondSource mimeType (sendChunkBS =<< handleS9ErrT (getIcon appMgrDir p ext))
where ext = Extension (toS appId) :: Extension "s9pk" where ext = Extension (toS appId) :: Extension "s9pk"
@@ -87,7 +81,7 @@ getLicenseR appId = do
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
case servicePath of case servicePath of
Nothing -> notFound Nothing -> notFound
Just p -> do Just p -> do
respondSource typePlain (sendChunkBS =<< handleS9ErrT (getLicense appMgrDir p ext)) respondSource typePlain (sendChunkBS =<< handleS9ErrT (getLicense appMgrDir p ext))
where ext = Extension (toS appId) :: Extension "s9pk" where ext = Extension (toS appId) :: Extension "s9pk"
@@ -101,6 +95,6 @@ getInstructionsR appId = do
servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec servicePath <- liftIO $ getVersionedFileFromDir appsDir ext spec
case servicePath of case servicePath of
Nothing -> notFound Nothing -> notFound
Just p -> do Just p -> do
respondSource typePlain (sendChunkBS =<< handleS9ErrT (getInstructions appMgrDir p ext)) respondSource typePlain (sendChunkBS =<< handleS9ErrT (getInstructions appMgrDir p ext))
where ext = Extension (toS appId) :: Extension "s9pk" where ext = Extension (toS appId) :: Extension "s9pk"