Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 10:21:51 +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 59fbdd4aa2
commit 8180e8feb9
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
, RegistryCtx(appSettings)
)
import Lib.Error ( S9Error(..) )
import Lib.Error ( S9Error(..)
, toStatus
)
import Lib.PkgRepository ( getManifest )
import Lib.Types.AppIndex ( PkgId(PkgId)
, ServiceDependencyInfo(serviceDependencyInfoVersion)
@@ -138,7 +140,6 @@ import Yesod.Core ( MonadResource
, addHeader
, getRequest
, getsYesod
, logWarn
, lookupGetParam
, respondSource
, sendChunkBS
@@ -151,6 +152,7 @@ import Data.Tuple.Extra hiding ( second
, first
, (&&&)
)
import Control.Monad.Logger
type URL = Text
newtype CategoryRes = CategoryRes {
@@ -393,8 +395,11 @@ getPackageListR = do
let packageMetadata = HM.intersectionWith (,) vers (categoryName <<$>> cats)
serviceDetailResult <- mapConcurrently (getServiceDetails packageMetadata)
(unPkgRecordKey . entityKey . fst3 <$> filteredServices)
let services = snd $ partitionEithers serviceDetailResult
pure $ ServiceAvailableRes services
let res = partitionEithers serviceDetailResult
case fst res of
-- just throw first error?
x : _ -> sendResponseStatus (toStatus x) x
[] -> pure $ ServiceAvailableRes $ snd res
where
mergeDupes :: ([Version], VersionRange) -> ([Version], VersionRange) -> ([Version], VersionRange)
@@ -453,7 +458,7 @@ getPackageListR = do
sendResponseStatus status400 e
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]))
-> PkgId
-> m (Either S9Error ServiceRes)
@@ -478,30 +483,35 @@ getServiceDetails metadata pkg = runExceptT $ do
case eitherDecode manifest of
Left _ -> liftEither . Left $ AssetParseE [i|#{pkg}:manifest|] (decodeUtf8 $ BS.toStrict manifest)
Right m -> do
let d = parMap rpar (mapDependencyMetadata domain metadata) (HM.toList $ serviceManifestDependencies m)
pure $ ServiceRes { serviceResIcon = [i|https://#{domain}/package/icon/#{pkg}|]
let deps = partitionEithers $ parMap rpar
(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
, serviceResManifest = unsafeFromJust . decode $ manifest
, serviceResCategories = snd packageMetadata
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|]
, serviceResLicense = [i|https://#{domain}/package/license/#{pkg}|]
, serviceResVersions = fst . fst $ packageMetadata
, serviceResDependencyInfo = HM.fromList $ snd $ partitionEithers d
}
, serviceResManifest = unsafeFromJust . decode $ manifest
, serviceResCategories = snd packageMetadata
, serviceResInstructions = [i|https://#{domain}/package/instructions/#{pkg}|]
, serviceResLicense = [i|https://#{domain}/package/license/#{pkg}|]
, serviceResVersions = fst . fst $ packageMetadata
, serviceResDependencyInfo = HM.fromList $ snd deps
}
mapDependencyMetadata :: Text
-> HM.HashMap PkgId (([Version], VersionRange), [CategoryTitle])
-> (PkgId, ServiceDependencyInfo)
-> Either S9Error (PkgId, DependencyInfo)
-> Either Text (PkgId, DependencyInfo)
mapDependencyMetadata domain metadata (appId, depInfo) = do
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
-- get best version from VersionRange of dependency
let satisfactory = filter (<|| serviceDependencyInfoVersion depInfo) (fst . fst $ depMetadata)
let best = getMax <$> foldMap (Just . Max) satisfactory
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
pure
( appId

6
src/Lib/Error.hs
View File

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