mirror of
https://github.com/Start9Labs/registry.git
synced 2026-04-01 20:44:15 +00:00
builds
This commit is contained in:
Keagan McClelland
@@ -15,6 +15,7 @@ data S9Error =
|
||||
PersistentE Text
|
||||
| AppMgrE Text ExitCode
|
||||
| NotFoundE Text
|
||||
| InvalidParamsE Text Text
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Exception S9Error
|
||||
@@ -22,14 +23,16 @@ instance Exception S9Error
|
||||
-- | Redact any sensitive data in this function
|
||||
toError :: S9Error -> Error
|
||||
toError = \case
|
||||
PersistentE t -> Error DATABASE_ERROR t
|
||||
AppMgrE cmd code -> Error APPMGR_ERROR [i|"appmgr #{cmd}" exited with #{code}|]
|
||||
NotFoundE e -> Error NOT_FOUND [i|#{e}|]
|
||||
PersistentE t -> Error DATABASE_ERROR t
|
||||
AppMgrE cmd code -> Error APPMGR_ERROR [i|"appmgr #{cmd}" exited with #{code}|]
|
||||
NotFoundE e -> Error NOT_FOUND [i|#{e}|]
|
||||
InvalidParamsE e m -> Error INVALID_PARAMS [i|Could not parse request parameters #{e}: #{m}|]
|
||||
|
||||
data ErrorCode =
|
||||
DATABASE_ERROR
|
||||
| APPMGR_ERROR
|
||||
| NOT_FOUND
|
||||
| INVALID_PARAMS
|
||||
|
||||
deriving (Eq, Show)
|
||||
instance ToJSON ErrorCode where
|
||||
@@ -54,9 +57,10 @@ instance ToContent S9Error where
|
||||
|
||||
toStatus :: S9Error -> Status
|
||||
toStatus = \case
|
||||
PersistentE _ -> status500
|
||||
AppMgrE _ _ -> status500
|
||||
NotFoundE _ -> status404
|
||||
PersistentE _ -> status500
|
||||
AppMgrE _ _ -> status500
|
||||
NotFoundE _ -> status404
|
||||
InvalidParamsE _ _ -> status400
|
||||
|
||||
|
||||
handleS9ErrT :: MonadHandler m => S9ErrT m a -> m a
|
||||
|
||||
1
src/Lib/External/AppMgr.hs
vendored
1
src/Lib/External/AppMgr.hs
vendored
@@ -23,7 +23,6 @@ import Conduit ( (.|)
|
||||
import qualified Data.Conduit.List as CL
|
||||
import Data.Conduit.Process.Typed
|
||||
import Lib.Error
|
||||
import Lib.Registry
|
||||
import System.FilePath ( (</>) )
|
||||
import UnliftIO ( MonadUnliftIO
|
||||
, catch
|
||||
|
||||
@@ -28,6 +28,9 @@ import Control.Monad.Reader.Has ( Has
|
||||
)
|
||||
import Data.Aeson ( eitherDecodeFileStrict' )
|
||||
import qualified Data.Attoparsec.Text as Atto
|
||||
import Data.ByteString ( readFile
|
||||
, writeFile
|
||||
)
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import qualified Data.Text as T
|
||||
@@ -37,7 +40,9 @@ import Lib.Types.AppIndex ( PkgId(..)
|
||||
, ServiceManifest(serviceManifestIcon)
|
||||
)
|
||||
import Lib.Types.Emver ( Version
|
||||
, VersionRange
|
||||
, parseVersion
|
||||
, satisfies
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, (&&)
|
||||
@@ -46,11 +51,13 @@ import Startlude ( ($)
|
||||
, (<>)
|
||||
, Bool(..)
|
||||
, ByteString
|
||||
, Down(Down)
|
||||
, Either(Left, Right)
|
||||
, Eq((==))
|
||||
, Exception
|
||||
, FilePath
|
||||
, IO
|
||||
, Integer
|
||||
, Maybe(Just, Nothing)
|
||||
, MonadIO(liftIO)
|
||||
, MonadReader
|
||||
@@ -59,10 +66,12 @@ import Startlude ( ($)
|
||||
, find
|
||||
, for_
|
||||
, fromMaybe
|
||||
, headMay
|
||||
, not
|
||||
, partitionEithers
|
||||
, pure
|
||||
, show
|
||||
, sortOn
|
||||
, throwIO
|
||||
)
|
||||
import System.FSNotify ( Event(Added)
|
||||
@@ -87,7 +96,8 @@ import UnliftIO ( MonadUnliftIO
|
||||
)
|
||||
import UnliftIO ( tryPutMVar )
|
||||
import UnliftIO.Concurrent ( forkIO )
|
||||
import UnliftIO.Directory ( listDirectory
|
||||
import UnliftIO.Directory ( getFileSize
|
||||
, listDirectory
|
||||
, removeFile
|
||||
, renameFile
|
||||
)
|
||||
@@ -116,6 +126,15 @@ getVersionsFor pkg = do
|
||||
for_ failures $ \f -> $logWarn [i|Emver Parse Failure for #{pkg}: #{f}|]
|
||||
pure successes
|
||||
|
||||
getViableVersions :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> VersionRange -> m [Version]
|
||||
getViableVersions pkg spec = filter (`satisfies` spec) <$> getVersionsFor pkg
|
||||
|
||||
getBestVersion :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m)
|
||||
=> PkgId
|
||||
-> VersionRange
|
||||
-> m (Maybe Version)
|
||||
getBestVersion pkg spec = headMay . sortOn Down <$> getViableVersions pkg spec
|
||||
|
||||
-- extract all package assets into their own respective files
|
||||
extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => FilePath -> m ()
|
||||
extractPkg fp = (`onException` cleanup) $ do
|
||||
@@ -125,6 +144,7 @@ extractPkg fp = (`onException` cleanup) $ do
|
||||
-- let s9pk = pkgRoot </> show pkg <.> "s9pk"
|
||||
manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr fp $ sinkIt
|
||||
(pkgRoot </> "manifest.json")
|
||||
pkgHashTask <- async $ AppMgr.getPackageHash appmgr fp
|
||||
instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr fp $ sinkIt
|
||||
(pkgRoot </> "instructions.md")
|
||||
licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr fp $ sinkIt (pkgRoot </> "license.md")
|
||||
@@ -139,6 +159,8 @@ extractPkg fp = (`onException` cleanup) $ do
|
||||
wait iconTask
|
||||
let iconDest = "icon" <.> T.unpack (fromMaybe "png" (serviceManifestIcon manifest))
|
||||
liftIO $ renameFile (pkgRoot </> "icon.tmp") (pkgRoot </> iconDest)
|
||||
hash <- wait pkgHashTask
|
||||
liftIO $ writeFile (pkgRoot </> "hash.bin") hash
|
||||
wait instructionsTask
|
||||
wait licenseTask
|
||||
where
|
||||
@@ -167,28 +189,40 @@ watchPkgRepoRoot = do
|
||||
Added path _ isDir -> not isDir && takeExtension path == ".s9pk"
|
||||
_ -> False
|
||||
|
||||
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> ConduitT () ByteString m ()
|
||||
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
getManifest pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let manifestPath = root </> show pkg </> show version </> "manifest.json"
|
||||
sourceFile manifestPath
|
||||
n <- getFileSize manifestPath
|
||||
pure $ (n, sourceFile manifestPath)
|
||||
|
||||
getInstructions :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> ConduitT () ByteString m ()
|
||||
getInstructions :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
getInstructions pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let instructionsPath = root </> show pkg </> show version </> "instructions.md"
|
||||
sourceFile instructionsPath
|
||||
n <- getFileSize instructionsPath
|
||||
pure $ (n, sourceFile instructionsPath)
|
||||
|
||||
getLicense :: (MonadResource m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> ConduitT () ByteString m ()
|
||||
getLicense :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
getLicense pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let licensePath = root </> show pkg </> show version </> "license.md"
|
||||
sourceFile licensePath
|
||||
n <- getFileSize licensePath
|
||||
pure $ (n, sourceFile licensePath)
|
||||
|
||||
getIcon :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (ContentType, ConduitT () ByteString m ())
|
||||
-> m (ContentType, Integer, ConduitT () ByteString m ())
|
||||
getIcon pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let pkgRoot = root </> show pkg </> show version
|
||||
@@ -203,4 +237,21 @@ getIcon pkg version = do
|
||||
".svg" -> typeSvg
|
||||
".gif" -> typeGif
|
||||
_ -> typePlain
|
||||
pure $ (ct, sourceFile (pkgRoot </> x))
|
||||
n <- getFileSize (pkgRoot </> x)
|
||||
pure $ (ct, n, sourceFile (pkgRoot </> x))
|
||||
|
||||
getHash :: (MonadIO m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m ByteString
|
||||
getHash pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let hashPath = root </> show pkg </> show version </> "hash.bin"
|
||||
liftIO $ readFile hashPath
|
||||
|
||||
getPackage :: (MonadResource m, MonadReader r m, Has PkgRepo r)
|
||||
=> PkgId
|
||||
-> Version
|
||||
-> m (Integer, ConduitT () ByteString m ())
|
||||
getPackage pkg version = do
|
||||
root <- asks pkgRepoFileRoot
|
||||
let pkgPath = root </> show pkg </> show version </> show pkg <.> "s9pk"
|
||||
n <- getFileSize pkgPath
|
||||
pure (n, sourceFile pkgPath)
|
||||
|
||||
@@ -34,21 +34,20 @@ module Lib.Types.Emver
|
||||
, exactly
|
||||
, parseVersion
|
||||
, parseRange
|
||||
)
|
||||
where
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Control.Applicative ( Alternative((<|>))
|
||||
, liftA2
|
||||
)
|
||||
import Data.Aeson
|
||||
import qualified Data.Attoparsec.Text as Atto
|
||||
import Data.Function
|
||||
import Data.Functor ( (<&>)
|
||||
, ($>)
|
||||
)
|
||||
import Control.Applicative ( liftA2
|
||||
, Alternative((<|>))
|
||||
import Data.Functor ( ($>)
|
||||
, (<&>)
|
||||
)
|
||||
import Data.String ( IsString(..) )
|
||||
import qualified Data.Text as T
|
||||
import Data.Aeson
|
||||
import Prelude
|
||||
import Startlude ( Hashable )
|
||||
|
||||
-- | AppVersion is the core representation of the SemverQuad type.
|
||||
|
||||
Reference in New Issue
Block a user