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

handle errors in either cases

Browse Source
This commit is contained in:
Lucy Cifferello
2021-11-21 17:18:20 -07:00
committed by Keagan McClelland
parent 1ae32a5a8e
commit c0279fcae8
2 changed files with 33 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
src/Handler/Marketplace.hs
View File

@@ -92,7 +92,9 @@ import Database.Persist ( PersistUniqueRead(getBy)
import Foundation ( Handler import Foundation ( Handler
, RegistryCtx(appSettings) , RegistryCtx(appSettings)
) )
import Lib.Error ( S9Error(..) ) import Lib.Error ( S9Error(..)
, toStatus
)
import Lib.PkgRepository ( getManifest ) import Lib.PkgRepository ( getManifest )
import Lib.Types.AppIndex ( PkgId(PkgId) import Lib.Types.AppIndex ( PkgId(PkgId)
, ServiceDependencyInfo(serviceDependencyInfoVersion) , ServiceDependencyInfo(serviceDependencyInfoVersion)
@@ -138,7 +140,6 @@ import Yesod.Core ( MonadResource
, addHeader , addHeader
, getRequest , getRequest
, getsYesod , getsYesod
, logWarn
, lookupGetParam , lookupGetParam
, respondSource , respondSource
, sendChunkBS , sendChunkBS
@@ -151,6 +152,7 @@ import Data.Tuple.Extra hiding ( second
, first , first
, (&&&) , (&&&)
) )
import Control.Monad.Logger
type URL = Text type URL = Text
newtype CategoryRes = CategoryRes { newtype CategoryRes = CategoryRes {
@@ -393,8 +395,11 @@ getPackageListR = do
let packageMetadata = HM.intersectionWith (,) vers (categoryName <<$>> cats) let packageMetadata = HM.intersectionWith (,) vers (categoryName <<$>> cats)
serviceDetailResult <- mapConcurrently (getServiceDetails packageMetadata) serviceDetailResult <- mapConcurrently (getServiceDetails packageMetadata)
(unPkgRecordKey . entityKey . fst3 <$> filteredServices) (unPkgRecordKey . entityKey . fst3 <$> filteredServices)
let services = snd $ partitionEithers serviceDetailResult let res = partitionEithers serviceDetailResult
pure $ ServiceAvailableRes services case fst res of
-- just throw first error?
x : _ -> sendResponseStatus (toStatus x) x
[] -> pure $ ServiceAvailableRes $ snd res
where where
mergeDupes :: ([Version], VersionRange) -> ([Version], VersionRange) -> ([Version], VersionRange) mergeDupes :: ([Version], VersionRange) -> ([Version], VersionRange) -> ([Version], VersionRange)
@@ -453,7 +458,7 @@ getPackageListR = do
sendResponseStatus status400 e sendResponseStatus status400 e
Right v -> pure $ Just v Right v -> pure $ Just v
getServiceDetails :: (MonadIO m, MonadResource m, MonadReader r m, Has AppSettings r) getServiceDetails :: (MonadIO m, MonadResource m, MonadReader r m, MonadLogger m, Has AppSettings r)
=> (HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])) => (HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle]))
-> PkgId -> PkgId
-> m (Either S9Error ServiceRes) -> m (Either S9Error ServiceRes)
@@ -478,30 +483,35 @@ getServiceDetails metadata pkg = runExceptT $ do
case eitherDecode manifest of case eitherDecode manifest of
Left _ -> liftEither . Left $ AssetParseE [i|#{pkg}:manifest|] (decodeUtf8 $ BS.toStrict manifest) Left _ -> liftEither . Left $ AssetParseE [i|#{pkg}:manifest|] (decodeUtf8 $ BS.toStrict manifest)
Right m -> do Right m -> do
let d = parMap rpar (mapDependencyMetadata domain metadata) (HM.toList $ serviceManifestDependencies m) let deps = partitionEithers $ parMap rpar
pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{pkg}|] (mapDependencyMetadata domain metadata)
(HM.toList $ serviceManifestDependencies m)
case fst deps of
_ : xs -> do
liftEither . Left $ DepMetadataE xs
[] -> pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{pkg}|]
-- pass through raw JSON Value, we have checked its correct parsing above -- pass through raw JSON Value, we have checked its correct parsing above
, serviceResManifest = unsafeFromJust . decode $ manifest , serviceResManifest = unsafeFromJust . decode $ manifest
, serviceResCategories = snd packageMetadata , serviceResCategories = snd packageMetadata
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|] , serviceResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|]
, serviceResLicense = [i|https://#{domain}/package/license/#{pkg}|] , serviceResLicense = [i|https://#{domain}/package/license/#{pkg}|]
, serviceResVersions = fst . fst $ packageMetadata , serviceResVersions = fst . fst $ packageMetadata
, serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d , serviceResDependencyInfo = HM.fromList $ snd deps
} }
mapDependencyMetadata :: Text mapDependencyMetadata :: Text
-> HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle]) -> HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])
-> (PkgId, ServiceDependencyInfo) -> (PkgId, ServiceDependencyInfo)
-> Either S9Error (PkgId, DependencyInfo) -> Either Text (PkgId, DependencyInfo)
mapDependencyMetadata domain metadata (appId, depInfo) = do mapDependencyMetadata domain metadata (appId, depInfo) = do
depMetadata <- case HM.lookup appId metadata of depMetadata <- case HM.lookup appId metadata of
Nothing -> Left $ NotFoundE [i|dependency metadata for #{appId} not found.|] Nothing -> Left [i|dependency metadata for #{appId} not found.|]
Just m -> pure m Just m -> pure m
-- get best version from VersionRange of dependency -- get best version from VersionRange of dependency
let satisfactory = filter (<|| serviceDependencyInfoVersion depInfo) (fst . fst $ depMetadata) let satisfactory = filter (<|| serviceDependencyInfoVersion depInfo) (fst . fst $ depMetadata)
let best = getMax <$> foldMap (Just . Max) satisfactory let best = getMax <$> foldMap (Just . Max) satisfactory
version <- case best of version <- case best of
Nothing -> Left $ NotFoundE $ [i|No satisfactory version for dependent package #{appId}|] Nothing -> Left [i|No satisfactory version for dependent package #{appId}|]
Just v -> pure v Just v -> pure v
pure pure
( appId ( appId

6
src/Lib/Error.hs
View File

@@ -8,6 +8,7 @@ import Startlude
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
import Network.HTTP.Types import Network.HTTP.Types
import Yesod.Core import Yesod.Core
import qualified Data.Text as T
type S9ErrT m = ExceptT S9Error m type S9ErrT m = ExceptT S9Error m
@@ -17,6 +18,7 @@ data S9Error =
| NotFoundE Text | NotFoundE Text
| InvalidParamsE Text Text | InvalidParamsE Text Text
| AssetParseE Text Text | AssetParseE Text Text
| DepMetadataE [Text]
deriving (Show, Eq) deriving (Show, Eq)
instance Exception S9Error instance Exception S9Error
@@ -29,6 +31,9 @@ toError = \case
NotFoundE e -> Error NOT_FOUND [i|#{e}|] NotFoundE e -> Error NOT_FOUND [i|#{e}|]
InvalidParamsE e m -> Error INVALID_PARAMS [i|Could not parse request parameters #{e}: #{m}|] InvalidParamsE e m -> Error INVALID_PARAMS [i|Could not parse request parameters #{e}: #{m}|]
AssetParseE asset found -> Error PARSE_ERROR [i|Could not parse #{asset}: #{found}|] AssetParseE asset found -> Error PARSE_ERROR [i|Could not parse #{asset}: #{found}|]
DepMetadataE errs -> do
let errorText = T.concat errs
Error NOT_FOUND [i|#{errorText}|]
data ErrorCode = data ErrorCode =
DATABASE_ERROR DATABASE_ERROR
@@ -64,3 +69,4 @@ toStatus = \case
NotFoundE _ -> status404 NotFoundE _ -> status404
InvalidParamsE _ _ -> status400 InvalidParamsE _ _ -> status400
AssetParseE _ _ -> status500 AssetParseE _ _ -> status500
DepMetadataE _ -> status404