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

Fix/failure (#142)

Browse Source 
* log

* fix empty case

* cleanup

* force ssl
This commit is contained in:
Lucy
2024-04-30 18:28:06 -04:00
committed by GitHub
parent bb63e1ea82
commit 4b7034a9c6
2 changed files with 18 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/Application.hs
View File

@@ -214,6 +214,7 @@ import System.Directory (createDirectoryIfMissing)
import System.Posix.Process (exitImmediately) import System.Posix.Process (exitImmediately)
import System.Time.Extra (sleep) import System.Time.Extra (sleep)
import Yesod (YesodPersist (runDB)) import Yesod (YesodPersist (runDB))
import Network.Wai.Middleware.ForceSSL (forceSSL)
-- This line actually creates our YesodDispatch instance. It is the second half -- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -288,6 +289,7 @@ makeApplication foundation = do
. autohead . autohead
. methodOverride . methodOverride
. gzip gzipSettings . gzip gzipSettings
. forceSSL
$ appPlain $ appPlain

28
src/Handler/Package/V1/Index.hs
View File

@@ -78,6 +78,7 @@ import Startlude (
(<$>), (<$>),
(<&>), (<&>),
(=<<), (=<<),
(>)
) )
import UnliftIO (Concurrently (..), mapConcurrently) import UnliftIO (Concurrently (..), mapConcurrently)
import Yesod ( import Yesod (
@@ -95,6 +96,7 @@ import Yesod (YesodRequest(reqGetParams))
import Yesod (getRequest) import Yesod (getRequest)
import Data.List (last) import Data.List (last)
import Data.Text (isPrefixOf) import Data.Text (isPrefixOf)
import Startlude (length)
data PackageReq = PackageReq data PackageReq = PackageReq
{ packageReqId :: !PkgId { packageReqId :: !PkgId
@@ -217,8 +219,7 @@ getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, p
pkgDepInfo' <- getPkgDependencyData pkg pkgVersion pkgDepInfo' <- getPkgDependencyData pkg pkgVersion
let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo' let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo'
pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo) pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo)
let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions let depMetadata = zipWith (selectDependencyBestVersion osPredicate) pkgDepInfo pkgDepInfoWithVersions
let depMetadata = zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo
lift $ lift $
fmap HM.fromList $ fmap HM.fromList $
for depMetadata $ \(depId, title, v, isLocal) -> do for depMetadata $ \(depId, title, v, isLocal) -> do
@@ -275,17 +276,20 @@ selectLatestVersionFromSpec pkgRanges vs =
-- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package) -- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package)
selectDependencyBestVersion :: (PkgDependency, PkgRecord) -> [VersionRecord] -> (PkgId, Text, Version, Bool) selectDependencyBestVersion :: (Version -> Bool) -> (PkgDependency, PkgRecord) -> [VersionRecord] -> (PkgId, Text, Version, Bool)
selectDependencyBestVersion pkgDepInfo depVersions = do selectDependencyBestVersion osPredicate pkgDepInfo depVersions = do
let pkgDepRecord = fst pkgDepInfo let pkgDepRecord = fst pkgDepInfo
let isLocal = pkgRecordHidden $ snd pkgDepInfo let isLocal = pkgRecordHidden $ snd pkgDepInfo
let depId = pkgDependencyDepId pkgDepRecord let depId = pkgDependencyDepId pkgDepRecord
let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord
let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions
let pkgId = unPkgRecordKey depId let pkgId = unPkgRecordKey depId
case maximumOn versionRecordNumber satisfactory of let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord
Just bestVersion -> (pkgId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal) let latestDepVersion = head $ sortOn (Down . versionRecordNumber) depVersions
-- use latest version of dep for metadata info let compatiblePkgDepInfo = (filter (osPredicate . versionRecordOsVersion)) depVersions
Nothing -> do if (length compatiblePkgDepInfo > 0)
let latestDepVersion = head $ sortOn (Down . versionRecordNumber) depVersions then do
(pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal) let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) compatiblePkgDepInfo
case maximumOn versionRecordNumber satisfactory of
Just bestVersion -> (pkgId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal)
-- use latest version of dep for metadata info
Nothing -> (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)
else (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)