mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-25 18:10:51 +00:00
mass clean up of warnings, hints, errors
This commit is contained in:
Keagan McClelland
@@ -27,13 +27,53 @@ module Application
|
||||
, db
|
||||
) where
|
||||
|
||||
import Startlude hiding ( Handler )
|
||||
import Startlude ( ($)
|
||||
, (++)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, (<||>)
|
||||
, Applicative(pure)
|
||||
, Async(asyncThreadId)
|
||||
, Bool(False, True)
|
||||
, Either(Left, Right)
|
||||
, Eq((==))
|
||||
, ExitCode(ExitSuccess)
|
||||
, IO
|
||||
, Int
|
||||
, Maybe(Just)
|
||||
, Monad((>>=), return)
|
||||
, MonadIO(..)
|
||||
, Print(putStr, putStrLn)
|
||||
, ReaderT(runReaderT)
|
||||
, Text
|
||||
, ThreadId
|
||||
, async
|
||||
, flip
|
||||
, for_
|
||||
, forever
|
||||
, forkIO
|
||||
, fromIntegral
|
||||
, killThread
|
||||
, newEmptyMVar
|
||||
, newMVar
|
||||
, onException
|
||||
, panic
|
||||
, print
|
||||
, putMVar
|
||||
, show
|
||||
, stdout
|
||||
, swapMVar
|
||||
, takeMVar
|
||||
, void
|
||||
, waitEitherCatchCancel
|
||||
, when
|
||||
)
|
||||
|
||||
import Control.Monad.Logger ( LoggingT
|
||||
, liftLoc
|
||||
, runLoggingT
|
||||
)
|
||||
import Data.Default
|
||||
import Data.Default ( Default(def) )
|
||||
import Database.Persist.Postgresql ( createPostgresqlPool
|
||||
, pgConnStr
|
||||
, pgPoolSize
|
||||
@@ -41,7 +81,11 @@ import Database.Persist.Postgresql ( createPostgresqlPool
|
||||
, runSqlPool
|
||||
)
|
||||
import Language.Haskell.TH.Syntax ( qLocation )
|
||||
import Network.Wai
|
||||
import Network.Wai ( Application
|
||||
, Middleware
|
||||
, Request(requestHeaders)
|
||||
, ResponseReceived
|
||||
)
|
||||
import Network.Wai.Handler.Warp ( Settings
|
||||
, defaultSettings
|
||||
, defaultShouldDisplayException
|
||||
@@ -53,14 +97,19 @@ import Network.Wai.Handler.Warp ( Settings
|
||||
, setPort
|
||||
, setTimeout
|
||||
)
|
||||
import Network.Wai.Handler.WarpTLS
|
||||
import Network.Wai.Handler.WarpTLS ( runTLS
|
||||
, tlsSettings
|
||||
)
|
||||
import Network.Wai.Middleware.AcceptOverride
|
||||
( acceptOverride )
|
||||
import Network.Wai.Middleware.Autohead
|
||||
( autohead )
|
||||
import Network.Wai.Middleware.Cors ( CorsResourcePolicy(..)
|
||||
, cors
|
||||
, simpleCorsResourcePolicy
|
||||
)
|
||||
import Network.Wai.Middleware.MethodOverride
|
||||
( methodOverride )
|
||||
import Network.Wai.Middleware.RequestLogger
|
||||
( Destination(Logger)
|
||||
, OutputFormat(..)
|
||||
@@ -75,28 +124,83 @@ import System.Log.FastLogger ( defaultBufSize
|
||||
, newStdoutLoggerSet
|
||||
, toLogStr
|
||||
)
|
||||
import Yesod.Core
|
||||
import Yesod.Core.Types hiding ( Logger )
|
||||
import Yesod.Default.Config2
|
||||
import Yesod.Core ( HandlerFor
|
||||
, LogLevel(LevelError)
|
||||
, Yesod(messageLoggerSource)
|
||||
, logInfo
|
||||
, mkYesodDispatch
|
||||
, toWaiAppPlain
|
||||
, typeOctet
|
||||
)
|
||||
import Yesod.Core.Types ( Logger(loggerSet) )
|
||||
import Yesod.Default.Config2 ( configSettingsYml
|
||||
, develMainHelper
|
||||
, getDevSettings
|
||||
, loadYamlSettings
|
||||
, loadYamlSettingsArgs
|
||||
, makeYesodLogger
|
||||
, useEnv
|
||||
)
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens ( both )
|
||||
import Data.List ( lookup )
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import qualified Database.Persist.Migration
|
||||
import qualified Database.Persist.Migration.Postgres
|
||||
import Database.Persist.Sql ( SqlBackend )
|
||||
import Foundation
|
||||
import Handler.Admin
|
||||
import Handler.Apps
|
||||
import Handler.ErrorLogs
|
||||
import Handler.Icons
|
||||
import Handler.Marketplace
|
||||
import Handler.Version
|
||||
import Foundation ( Handler
|
||||
, RegistryCtx(..)
|
||||
, Route
|
||||
( AppManifestR
|
||||
, AppR
|
||||
, EosR
|
||||
, EosVersionR
|
||||
, ErrorLogsR
|
||||
, IconsR
|
||||
, InfoR
|
||||
, InstructionsR
|
||||
, LicenseR
|
||||
, PackageListR
|
||||
, PkgDeindexR
|
||||
, PkgIndexR
|
||||
, PkgUploadR
|
||||
, PkgVersionR
|
||||
, ReleaseNotesR
|
||||
, VersionLatestR
|
||||
)
|
||||
, resourcesRegistryCtx
|
||||
, setWebProcessThreadId
|
||||
, unsafeHandler
|
||||
)
|
||||
import Handler.Admin ( getPkgDeindexR
|
||||
, postPkgDeindexR
|
||||
, postPkgIndexR
|
||||
, postPkgUploadR
|
||||
)
|
||||
import Handler.Apps ( getAppManifestR
|
||||
, getAppR
|
||||
)
|
||||
import Handler.ErrorLogs ( postErrorLogsR )
|
||||
import Handler.Icons ( getIconsR
|
||||
, getInstructionsR
|
||||
, getLicenseR
|
||||
)
|
||||
import Handler.Marketplace ( getEosR
|
||||
, getEosVersionR
|
||||
, getInfoR
|
||||
, getPackageListR
|
||||
, getReleaseNotesR
|
||||
, getVersionLatestR
|
||||
)
|
||||
import Handler.Version ( getPkgVersionR )
|
||||
import Lib.PkgRepository ( watchEosRepoRoot )
|
||||
import Lib.Ssl
|
||||
import Lib.Ssl ( doesSslNeedRenew
|
||||
, renewSslCerts
|
||||
, setupSsl
|
||||
)
|
||||
import Migration ( manualMigration )
|
||||
import Model
|
||||
import Model ( migrateAll )
|
||||
import Network.HTTP.Types.Header ( hOrigin )
|
||||
import Network.Wai.Middleware.Gzip ( GzipFiles(GzipCompress)
|
||||
, GzipSettings(gzipCheckMime, gzipFiles)
|
||||
@@ -104,12 +208,15 @@ import Network.Wai.Middleware.Gzip ( GzipFiles(GzipCompress)
|
||||
, gzip
|
||||
)
|
||||
import Network.Wai.Middleware.RequestLogger.JSON
|
||||
import Settings
|
||||
( formatAsJSONWithHeaders )
|
||||
import Settings ( AppPort
|
||||
, AppSettings(..)
|
||||
, configSettingsYmlValue
|
||||
)
|
||||
import System.Directory ( createDirectoryIfMissing )
|
||||
import System.Posix.Process
|
||||
import System.Time.Extra
|
||||
import qualified UnliftIO
|
||||
import Yesod
|
||||
import System.Posix.Process ( exitImmediately )
|
||||
import System.Time.Extra ( sleep )
|
||||
import Yesod ( YesodPersist(runDB) )
|
||||
|
||||
-- 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
|
||||
|
||||
@@ -25,15 +25,12 @@ import Control.Monad.Logger ( LogLevel(..)
|
||||
import Crypto.Hash ( SHA256(SHA256)
|
||||
, hashWith
|
||||
)
|
||||
import Data.Aeson ( FromJSON
|
||||
, eitherDecodeStrict
|
||||
)
|
||||
import Data.Aeson ( eitherDecodeStrict )
|
||||
import Data.ByteArray.Encoding ( Base(..)
|
||||
, convertToBase
|
||||
)
|
||||
import qualified Data.ByteString.Char8 as B8
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Conduit.Process ( system )
|
||||
import Data.Default
|
||||
import Data.Functor.Contravariant ( contramap )
|
||||
import Data.HashMap.Internal.Strict ( HashMap
|
||||
@@ -44,7 +41,14 @@ import Data.HashMap.Internal.Strict ( HashMap
|
||||
, traverseWithKey
|
||||
)
|
||||
import Data.Text ( toLower )
|
||||
import Dhall hiding ( void )
|
||||
import Dhall ( Encoder(embed)
|
||||
, FromDhall(..)
|
||||
, Generic
|
||||
, ToDhall(..)
|
||||
, auto
|
||||
, inject
|
||||
, inputFile
|
||||
)
|
||||
import Dhall.Core ( pretty )
|
||||
import Handler.Admin ( IndexPkgReq(IndexPkgReq)
|
||||
, PackageList(..)
|
||||
@@ -75,8 +79,29 @@ import Network.HTTP.Simple ( getResponseBody
|
||||
import Network.URI ( URI
|
||||
, parseURI
|
||||
)
|
||||
import Options.Applicative hiding ( auto
|
||||
, empty
|
||||
import Options.Applicative ( (<$>)
|
||||
, (<**>)
|
||||
, Alternative((<|>))
|
||||
, Applicative((*>), (<*>), liftA2, pure)
|
||||
, Parser
|
||||
, ParserInfo
|
||||
, command
|
||||
, execParser
|
||||
, fullDesc
|
||||
, help
|
||||
, helper
|
||||
, info
|
||||
, liftA3
|
||||
, long
|
||||
, mappend
|
||||
, metavar
|
||||
, optional
|
||||
, progDesc
|
||||
, short
|
||||
, strArgument
|
||||
, strOption
|
||||
, subparser
|
||||
, switch
|
||||
)
|
||||
import Rainbow ( Chunk
|
||||
, Radiant
|
||||
@@ -111,7 +136,6 @@ import Startlude ( ($)
|
||||
, Show
|
||||
, String
|
||||
, appendFile
|
||||
, asum
|
||||
, const
|
||||
, decodeUtf8
|
||||
, exitWith
|
||||
@@ -125,7 +149,6 @@ import Startlude ( ($)
|
||||
, fst
|
||||
, headMay
|
||||
, panic
|
||||
, putStrLn
|
||||
, show
|
||||
, snd
|
||||
, unlessM
|
||||
@@ -145,7 +168,6 @@ import System.FilePath ( (</>)
|
||||
, takeDirectory
|
||||
, takeExtension
|
||||
)
|
||||
import System.Process ( callCommand )
|
||||
import System.ProgressBar ( Progress(..)
|
||||
, defStyle
|
||||
, newProgressBar
|
||||
@@ -154,7 +176,6 @@ import System.ProgressBar ( Progress(..)
|
||||
import Yesod ( logError
|
||||
, logWarn
|
||||
)
|
||||
import Yesod.Core ( FromJSON(parseJSON) )
|
||||
|
||||
data Upload = Upload
|
||||
{ publishRepoName :: String
|
||||
|
||||
@@ -38,21 +38,54 @@ import Database.Esqueleto.Experimental
|
||||
, (||.)
|
||||
)
|
||||
import qualified Database.Persist as P
|
||||
import Database.Persist.Postgresql
|
||||
hiding ( (==.)
|
||||
, getJust
|
||||
, selectSource
|
||||
, (||.)
|
||||
import Database.Persist.Postgresql ( ConnectionPool
|
||||
, Entity(entityKey, entityVal)
|
||||
, PersistEntity(Key)
|
||||
, SqlBackend
|
||||
, runSqlPool
|
||||
)
|
||||
import Handler.Types.Marketplace ( PackageDependencyMetadata(..) )
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
import Lib.Types.Emver ( Version )
|
||||
import Model
|
||||
import Startlude hiding ( (%)
|
||||
, from
|
||||
, groupBy
|
||||
, on
|
||||
, yield
|
||||
import Model ( Category
|
||||
, EntityField
|
||||
( CategoryId
|
||||
, CategoryName
|
||||
, PkgCategoryCategoryId
|
||||
, PkgCategoryPkgId
|
||||
, PkgDependencyDepId
|
||||
, PkgDependencyPkgId
|
||||
, PkgDependencyPkgVersion
|
||||
, PkgRecordId
|
||||
, VersionRecordDescLong
|
||||
, VersionRecordDescShort
|
||||
, VersionRecordPkgId
|
||||
, VersionRecordTitle
|
||||
, VersionRecordUpdatedAt
|
||||
)
|
||||
, Key(PkgRecordKey, unPkgRecordKey)
|
||||
, PkgCategory
|
||||
, PkgDependency
|
||||
, PkgRecord
|
||||
, VersionRecord(versionRecordNumber, versionRecordPkgId)
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, ($>)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, Applicative(pure)
|
||||
, Down(Down)
|
||||
, Eq((==))
|
||||
, Functor(fmap)
|
||||
, Maybe(..)
|
||||
, Monad
|
||||
, MonadIO
|
||||
, ReaderT
|
||||
, Text
|
||||
, headMay
|
||||
, lift
|
||||
, snd
|
||||
, sortOn
|
||||
)
|
||||
|
||||
type CategoryTitle = Text
|
||||
|
||||
@@ -13,8 +13,36 @@
|
||||
|
||||
module Foundation where
|
||||
|
||||
import Startlude hiding ( Handler
|
||||
, get
|
||||
import Startlude ( ($)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, (<&>)
|
||||
, (<**>)
|
||||
, (=<<)
|
||||
, Applicative(pure)
|
||||
, Bool(False)
|
||||
, Eq((==))
|
||||
, IO
|
||||
, MVar
|
||||
, Maybe(..)
|
||||
, Monad(return)
|
||||
, Monoid(mempty)
|
||||
, Semigroup((<>))
|
||||
, String
|
||||
, Text
|
||||
, ThreadId
|
||||
, Word64
|
||||
, decodeUtf8
|
||||
, drop
|
||||
, encodeUtf8
|
||||
, flip
|
||||
, fst
|
||||
, isJust
|
||||
, otherwise
|
||||
, putMVar
|
||||
, show
|
||||
, when
|
||||
, (||)
|
||||
)
|
||||
|
||||
import Control.Monad.Logger ( Loc
|
||||
@@ -23,9 +51,37 @@ import Control.Monad.Logger ( Loc
|
||||
, ToLogStr(toLogStr)
|
||||
, fromLogStr
|
||||
)
|
||||
import Database.Persist.Sql hiding ( update )
|
||||
import Lib.Registry
|
||||
import Yesod.Core
|
||||
import Database.Persist.Sql ( ConnectionPool
|
||||
, LogFunc
|
||||
, PersistStoreRead(get)
|
||||
, SqlBackend
|
||||
, SqlPersistT
|
||||
, runSqlPool
|
||||
)
|
||||
import Lib.Registry ( S9PK )
|
||||
import Yesod.Core ( AuthResult(Authorized, Unauthorized)
|
||||
, LogLevel(..)
|
||||
, MonadHandler(liftHandler)
|
||||
, RenderMessage(..)
|
||||
, RenderRoute(Route, renderRoute)
|
||||
, RouteAttrs(routeAttrs)
|
||||
, SessionBackend
|
||||
, ToTypedContent
|
||||
, Yesod
|
||||
( isAuthorized
|
||||
, makeLogger
|
||||
, makeSessionBackend
|
||||
, maximumContentLengthIO
|
||||
, messageLoggerSource
|
||||
, shouldLogIO
|
||||
, yesodMiddleware
|
||||
)
|
||||
, defaultYesodMiddleware
|
||||
, getYesod
|
||||
, getsYesod
|
||||
, mkYesodData
|
||||
, parseRoutesFile
|
||||
)
|
||||
import Yesod.Core.Types ( HandlerData(handlerEnv)
|
||||
, Logger(loggerDate)
|
||||
, RunHandlerEnv(rheChild, rheSite)
|
||||
@@ -43,12 +99,14 @@ import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import qualified Data.Text as T
|
||||
import Language.Haskell.TH ( Loc(..) )
|
||||
import Lib.PkgRepository
|
||||
import Lib.Types.AppIndex
|
||||
import Lib.PkgRepository ( EosRepo
|
||||
, PkgRepo
|
||||
)
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
import Model ( Admin(..)
|
||||
, Key(AdminKey)
|
||||
)
|
||||
import Settings
|
||||
import Settings ( AppSettings(appShouldLogAll) )
|
||||
import System.Console.ANSI.Codes ( Color(..)
|
||||
, ColorIntensity(..)
|
||||
, ConsoleLayer(Foreground)
|
||||
@@ -72,7 +130,11 @@ import Yesod.Auth ( AuthEntity
|
||||
import Yesod.Auth.Http.Basic ( defaultAuthSettings
|
||||
, defaultMaybeBasicAuthId
|
||||
)
|
||||
import Yesod.Persist.Core
|
||||
import Yesod.Persist.Core ( DBRunner
|
||||
, YesodPersist(..)
|
||||
, YesodPersistRunner(..)
|
||||
, defaultGetDBRunner
|
||||
)
|
||||
|
||||
-- | The foundation datatype for your application. This can be a good place to
|
||||
-- keep settings and values requiring initialization before your application
|
||||
|
||||
@@ -29,14 +29,15 @@ import Data.List ( (\\)
|
||||
)
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import Database.Persist ( entityKey
|
||||
, entityVal
|
||||
import Database.Persist ( entityVal
|
||||
, insert_
|
||||
, selectList
|
||||
)
|
||||
import Database.Persist.Postgresql ( runSqlPoolNoTransaction )
|
||||
import Database.Queries ( upsertPackageVersion )
|
||||
import Foundation
|
||||
import Foundation ( Handler
|
||||
, RegistryCtx(appConnPool)
|
||||
)
|
||||
import Lib.PkgRepository ( PkgRepo(PkgRepo, pkgRepoFileRoot)
|
||||
, extractPkg
|
||||
, getManifestLocation
|
||||
@@ -71,13 +72,11 @@ import Startlude ( ($)
|
||||
, asum
|
||||
, fmap
|
||||
, getCurrentTime
|
||||
, guard
|
||||
, guarded
|
||||
, hush
|
||||
, isNothing
|
||||
, liftIO
|
||||
, not
|
||||
, panic
|
||||
, replicate
|
||||
, show
|
||||
, throwIO
|
||||
|
||||
@@ -9,7 +9,17 @@
|
||||
|
||||
module Handler.Apps where
|
||||
|
||||
import Startlude hiding ( Handler )
|
||||
import Startlude ( ($)
|
||||
, (.)
|
||||
, Applicative(pure)
|
||||
, FilePath
|
||||
, Maybe(..)
|
||||
, Monad((>>=))
|
||||
, Show
|
||||
, String
|
||||
, show
|
||||
, void
|
||||
)
|
||||
|
||||
import Control.Monad.Logger ( logError )
|
||||
import qualified Data.Text as T
|
||||
@@ -88,16 +98,16 @@ getAppR file = do
|
||||
|
||||
recordMetrics :: PkgId -> Version -> Handler ()
|
||||
recordMetrics pkg appVersion = do
|
||||
sa <- runDB $ fetchApp $ pkg
|
||||
sa <- runDB $ fetchApp pkg
|
||||
case sa of
|
||||
Nothing -> do
|
||||
$logError $ [i|#{pkg} not found in database|]
|
||||
$logError [i|#{pkg} not found in database|]
|
||||
notFound
|
||||
Just _ -> do
|
||||
existingVersion <- runDB $ fetchAppVersion pkg appVersion
|
||||
case existingVersion of
|
||||
Nothing -> do
|
||||
$logError $ [i|#{pkg}@#{appVersion} not found in database|]
|
||||
$logError [i|#{pkg}@#{appVersion} not found in database|]
|
||||
notFound
|
||||
Just _ -> runDB $ createMetric pkg appVersion
|
||||
|
||||
|
||||
@@ -6,11 +6,20 @@ import Data.Aeson ( (.:)
|
||||
, FromJSON(parseJSON)
|
||||
, withObject
|
||||
)
|
||||
import Foundation
|
||||
import Foundation ( Handler )
|
||||
import Model ( EntityField(ErrorLogRecordIncidents)
|
||||
, ErrorLogRecord(ErrorLogRecord)
|
||||
)
|
||||
import Startlude hiding ( Handler )
|
||||
import Startlude ( ($)
|
||||
, Applicative(pure)
|
||||
, Eq
|
||||
, MonadIO(liftIO)
|
||||
, Show
|
||||
, Text
|
||||
, Word32
|
||||
, getCurrentTime
|
||||
, void
|
||||
)
|
||||
import Yesod.Core ( requireCheckJsonBody )
|
||||
import Yesod.Persist ( (+=.)
|
||||
, runDB
|
||||
|
||||
@@ -8,24 +8,41 @@
|
||||
|
||||
module Handler.Icons where
|
||||
|
||||
import Startlude hiding ( Handler )
|
||||
import Startlude ( ($)
|
||||
, Eq
|
||||
, Generic
|
||||
, Read
|
||||
, Show
|
||||
, show
|
||||
)
|
||||
|
||||
import Data.Conduit ( (.|)
|
||||
, awaitForever
|
||||
)
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import Foundation
|
||||
import Foundation ( Handler )
|
||||
import Lib.Error ( S9Error(NotFoundE) )
|
||||
import Lib.PkgRepository ( getBestVersion
|
||||
, getIcon
|
||||
, getInstructions
|
||||
, getLicense
|
||||
)
|
||||
import Lib.Types.AppIndex
|
||||
import Network.HTTP.Types
|
||||
import Util.Shared
|
||||
import Yesod.Core
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
import Network.HTTP.Types ( status400 )
|
||||
import Util.Shared ( getVersionSpecFromQuery
|
||||
, orThrow
|
||||
, versionPriorityFromQueryIsMin
|
||||
)
|
||||
import Yesod.Core ( FromJSON
|
||||
, ToJSON
|
||||
, TypedContent
|
||||
, addHeader
|
||||
, respondSource
|
||||
, sendChunkBS
|
||||
, sendResponseStatus
|
||||
, typePlain
|
||||
)
|
||||
|
||||
data IconType = PNG | JPG | JPEG | SVG
|
||||
deriving (Eq, Show, Generic, Read)
|
||||
|
||||
@@ -10,13 +10,48 @@
|
||||
|
||||
module Handler.Marketplace where
|
||||
|
||||
import Startlude hiding ( Any
|
||||
, Handler
|
||||
, ask
|
||||
, concurrently
|
||||
, from
|
||||
, on
|
||||
, sortOn
|
||||
import Startlude ( ($)
|
||||
, (&&&)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, (<&>)
|
||||
, Applicative((*>), pure)
|
||||
, Bool(True)
|
||||
, ByteString
|
||||
, Down(Down)
|
||||
, Either(Left, Right)
|
||||
, FilePath
|
||||
, Foldable(foldMap)
|
||||
, Functor(fmap)
|
||||
, Int
|
||||
, Maybe(..)
|
||||
, Monad((>>=))
|
||||
, MonadIO
|
||||
, MonadReader
|
||||
, Monoid(mappend)
|
||||
, Num((*), (-))
|
||||
, Ord((<))
|
||||
, ReaderT(runReaderT)
|
||||
, Text
|
||||
, Traversable(traverse)
|
||||
, catMaybes
|
||||
, const
|
||||
, decodeUtf8
|
||||
, encodeUtf8
|
||||
, filter
|
||||
, flip
|
||||
, for_
|
||||
, fromMaybe
|
||||
, fst
|
||||
, head
|
||||
, headMay
|
||||
, id
|
||||
, maybe
|
||||
, partitionEithers
|
||||
, readMaybe
|
||||
, show
|
||||
, snd
|
||||
, void
|
||||
)
|
||||
|
||||
import Conduit ( (.|)
|
||||
@@ -45,7 +80,7 @@ import Data.Attoparsec.Text ( Parser
|
||||
import Data.ByteArray.Encoding ( Base(..)
|
||||
, convertToBase
|
||||
)
|
||||
import Data.ByteString.Base64
|
||||
import Data.ByteString.Base64 ( encodeBase64 )
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Conduit.List as CL
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
@@ -84,7 +119,26 @@ import Foundation ( Handler
|
||||
, RegistryCtx(appConnPool, appSettings)
|
||||
, Route(InstructionsR, LicenseR)
|
||||
)
|
||||
import Handler.Types.Marketplace
|
||||
import Handler.Types.Marketplace ( CategoryTitle
|
||||
, DependencyRes(..)
|
||||
, EosRes(..)
|
||||
, InfoRes(InfoRes)
|
||||
, OrderArrangement(DESC)
|
||||
, PackageListDefaults
|
||||
( PackageListDefaults
|
||||
, packageListCategory
|
||||
, packageListOrder
|
||||
, packageListPageLimit
|
||||
, packageListPageNumber
|
||||
, packageListQuery
|
||||
)
|
||||
, PackageListRes(..)
|
||||
, PackageMetadata(..)
|
||||
, PackageReq(packageReqId, packageReqVersion)
|
||||
, PackageRes(..)
|
||||
, ReleaseNotes(ReleaseNotes)
|
||||
, VersionLatestRes(..)
|
||||
)
|
||||
import Lib.Error ( S9Error(..) )
|
||||
import Lib.PkgRepository ( PkgRepo
|
||||
, getIcon
|
||||
@@ -110,7 +164,7 @@ import Network.HTTP.Types ( status400
|
||||
, status404
|
||||
)
|
||||
import Protolude.Unsafe ( unsafeFromJust )
|
||||
import Settings
|
||||
import Settings ( AppSettings(marketplaceName, resourcesDir) )
|
||||
import System.FilePath ( (</>) )
|
||||
import UnliftIO.Async ( mapConcurrently )
|
||||
import UnliftIO.Directory ( listDirectory )
|
||||
|
||||
@@ -2,7 +2,14 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
||||
module Handler.Types.Marketplace where
|
||||
import Data.Aeson
|
||||
import Data.Aeson ( (.:)
|
||||
, FromJSON(parseJSON)
|
||||
, KeyValue((.=))
|
||||
, ToJSON(toJSON)
|
||||
, Value(String)
|
||||
, object
|
||||
, withObject
|
||||
)
|
||||
import qualified Data.HashMap.Internal.Strict as HM
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
import Lib.Types.Emver ( Version
|
||||
@@ -13,8 +20,21 @@ import Model ( Category
|
||||
, PkgRecord
|
||||
, VersionRecord
|
||||
)
|
||||
import Startlude
|
||||
import Yesod
|
||||
import Startlude ( ($)
|
||||
, (.)
|
||||
, Applicative(pure)
|
||||
, Eq
|
||||
, Generic
|
||||
, Int
|
||||
, Maybe
|
||||
, Read
|
||||
, Show
|
||||
, Text
|
||||
)
|
||||
import Yesod ( Entity
|
||||
, ToContent(..)
|
||||
, ToTypedContent(..)
|
||||
)
|
||||
|
||||
|
||||
type URL = Text
|
||||
|
||||
@@ -1,14 +1,24 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||
{-# HLINT ignore "Use newtype instead of data" #-}
|
||||
module Handler.Types.Status where
|
||||
|
||||
import Startlude hiding ( toLower )
|
||||
import Startlude ( (.)
|
||||
, Eq
|
||||
, Maybe
|
||||
, Show
|
||||
)
|
||||
|
||||
import Data.Aeson
|
||||
import Yesod.Core.Content
|
||||
import Data.Aeson ( KeyValue((.=))
|
||||
, ToJSON(toJSON)
|
||||
, object
|
||||
)
|
||||
import Yesod.Core.Content ( ToContent(..)
|
||||
, ToTypedContent(..)
|
||||
)
|
||||
|
||||
import Lib.Types.Emver
|
||||
import Lib.Types.Emver ( Version )
|
||||
import Orphans.Emver ( )
|
||||
|
||||
data AppVersionRes = AppVersionRes
|
||||
@@ -16,7 +26,7 @@ data AppVersionRes = AppVersionRes
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
instance ToJSON AppVersionRes where
|
||||
toJSON AppVersionRes { appVersionVersion } = object $ ["version" .= appVersionVersion]
|
||||
toJSON AppVersionRes { appVersionVersion } = object ["version" .= appVersionVersion]
|
||||
instance ToContent AppVersionRes where
|
||||
toContent = toContent . toJSON
|
||||
instance ToTypedContent AppVersionRes where
|
||||
|
||||
@@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
@@ -7,14 +6,14 @@
|
||||
|
||||
module Handler.Version where
|
||||
|
||||
import Startlude hiding ( Handler )
|
||||
import Startlude ( (<$>) )
|
||||
|
||||
import Yesod.Core
|
||||
import Yesod.Core ( sendResponseStatus )
|
||||
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import Foundation
|
||||
import Handler.Types.Status
|
||||
import Foundation ( Handler )
|
||||
import Handler.Types.Status ( AppVersionRes(AppVersionRes) )
|
||||
import Lib.Error ( S9Error(NotFoundE) )
|
||||
import Lib.PkgRepository ( getBestVersion )
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
|
||||
@@ -3,11 +3,30 @@
|
||||
|
||||
module Lib.Error where
|
||||
|
||||
import Startlude
|
||||
import Startlude ( (.)
|
||||
, Eq
|
||||
, ExceptT
|
||||
, Exception
|
||||
, ExitCode
|
||||
, Show
|
||||
, Text
|
||||
, show
|
||||
)
|
||||
|
||||
import Data.String.Interpolate.IsString
|
||||
import Network.HTTP.Types
|
||||
import Yesod.Core
|
||||
( i )
|
||||
import Network.HTTP.Types ( Status
|
||||
, status400
|
||||
, status404
|
||||
, status500
|
||||
)
|
||||
import Yesod.Core ( (.=)
|
||||
, ToContent(..)
|
||||
, ToJSON(toJSON)
|
||||
, ToTypedContent(..)
|
||||
, Value(String)
|
||||
, object
|
||||
)
|
||||
|
||||
type S9ErrT m = ExceptT S9Error m
|
||||
|
||||
|
||||
45
src/Lib/External/AppMgr.hs
vendored
45
src/Lib/External/AppMgr.hs
vendored
@@ -11,15 +11,46 @@
|
||||
|
||||
module Lib.External.AppMgr where
|
||||
|
||||
import Startlude hiding ( bracket
|
||||
, catch
|
||||
, finally
|
||||
, handle
|
||||
import Startlude ( ($)
|
||||
, (&&)
|
||||
, (<$>)
|
||||
, Applicative((*>), pure)
|
||||
, ByteString
|
||||
, Eq((==))
|
||||
, ExitCode
|
||||
, FilePath
|
||||
, Monad
|
||||
, MonadIO(..)
|
||||
, Monoid
|
||||
, String
|
||||
, atomically
|
||||
, id
|
||||
, liftA3
|
||||
, stderr
|
||||
, throwIO
|
||||
)
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.String.Interpolate.IsString
|
||||
import System.Process.Typed hiding ( createPipe )
|
||||
( i )
|
||||
import System.Process.Typed ( ExitCodeException(eceExitCode)
|
||||
, Process
|
||||
, ProcessConfig
|
||||
, byteStringInput
|
||||
, byteStringOutput
|
||||
, getStderr
|
||||
, getStdout
|
||||
, proc
|
||||
, setEnvInherit
|
||||
, setStderr
|
||||
, setStdin
|
||||
, setStdout
|
||||
, startProcess
|
||||
, stopProcess
|
||||
, useHandleOpen
|
||||
, waitExitCodeSTM
|
||||
, withProcessWait
|
||||
)
|
||||
|
||||
import Conduit ( (.|)
|
||||
, ConduitT
|
||||
@@ -29,11 +60,11 @@ import Control.Monad.Logger ( MonadLoggerIO
|
||||
, logErrorSH
|
||||
)
|
||||
import qualified Data.Conduit.List as CL
|
||||
import Data.Conduit.Process.Typed
|
||||
import Data.Conduit.Process.Typed ( createSource )
|
||||
import GHC.IO.Exception ( IOErrorType(NoSuchThing)
|
||||
, IOException(ioe_description, ioe_type)
|
||||
)
|
||||
import Lib.Error
|
||||
import Lib.Error ( S9Error(AppMgrE) )
|
||||
import System.FilePath ( (</>) )
|
||||
import UnliftIO ( MonadUnliftIO
|
||||
, bracket
|
||||
|
||||
@@ -71,7 +71,12 @@ import Lib.Types.Emver ( Version
|
||||
, parseVersion
|
||||
, satisfies
|
||||
)
|
||||
import Model
|
||||
import Model ( EntityField(EosHashHash, PkgRecordUpdatedAt)
|
||||
, EosHash(EosHash)
|
||||
, Key(PkgRecordKey)
|
||||
, PkgDependency(PkgDependency)
|
||||
, PkgRecord(PkgRecord)
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, (&&)
|
||||
, (.)
|
||||
|
||||
@@ -5,12 +5,27 @@
|
||||
|
||||
module Lib.Registry where
|
||||
|
||||
import Startlude
|
||||
import Startlude ( ($)
|
||||
, (.)
|
||||
, ConvertText(toS)
|
||||
, Eq((==))
|
||||
, KnownSymbol
|
||||
, Proxy(Proxy)
|
||||
, Read
|
||||
, Show
|
||||
, String
|
||||
, Symbol
|
||||
, readMaybe
|
||||
, show
|
||||
, symbolVal
|
||||
)
|
||||
|
||||
import qualified GHC.Read ( Read(..) )
|
||||
import qualified GHC.Show ( Show(..) )
|
||||
import System.FilePath
|
||||
import Yesod.Core
|
||||
import System.FilePath ( (<.>)
|
||||
, splitExtension
|
||||
)
|
||||
import Yesod.Core ( PathPiece(..) )
|
||||
|
||||
newtype Extension (a :: Symbol) = Extension String deriving (Eq)
|
||||
type S9PK = Extension "s9pk"
|
||||
|
||||
@@ -2,15 +2,34 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Lib.Ssl where
|
||||
import System.Directory
|
||||
import System.Process
|
||||
import System.Directory ( doesPathExist )
|
||||
import System.Process ( rawSystem
|
||||
, system
|
||||
)
|
||||
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
|
||||
import Startlude
|
||||
import Startlude ( ($)
|
||||
, (&&&)
|
||||
, (.)
|
||||
, (<&&>)
|
||||
, Applicative(pure)
|
||||
, Bool
|
||||
, Eq((/=))
|
||||
, ExitCode(ExitSuccess)
|
||||
, IO
|
||||
, MonadIO(liftIO)
|
||||
, ReaderT
|
||||
, Semigroup((<>))
|
||||
, Text
|
||||
, asks
|
||||
, unless
|
||||
, void
|
||||
)
|
||||
|
||||
import Foundation
|
||||
import Settings
|
||||
import Foundation ( RegistryCtx(appSettings) )
|
||||
import Settings ( AppSettings(..) )
|
||||
|
||||
-- openssl genrsa -out key.pem 2048
|
||||
-- openssl req -new -key key.pem -out certificate.csr
|
||||
|
||||
@@ -22,6 +22,7 @@ import qualified Data.ByteString.Lazy as BS
|
||||
import Data.Functor.Contravariant ( contramap )
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import qualified Data.Text as T
|
||||
import Database.Persist ( PersistField(..)
|
||||
, PersistValue(PersistText)
|
||||
|
||||
@@ -36,10 +36,41 @@ module Lib.Types.Emver
|
||||
, parseRange
|
||||
) where
|
||||
|
||||
import Startlude hiding ( Any )
|
||||
import Startlude ( ($)
|
||||
, ($>)
|
||||
, (&&)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, (<&>)
|
||||
, (<<$>>)
|
||||
, Alternative((<|>))
|
||||
, Applicative((*>), (<*), liftA2, pure)
|
||||
, Bool(..)
|
||||
, Either(..)
|
||||
, Eq(..)
|
||||
, Foldable(foldMap, length)
|
||||
, Hashable
|
||||
, IsString(..)
|
||||
, Monad((>>=))
|
||||
, Monoid(mappend, mempty)
|
||||
, Num((+))
|
||||
, Ord(compare)
|
||||
, Ordering(..)
|
||||
, Read
|
||||
, Semigroup((<>))
|
||||
, Show
|
||||
, String
|
||||
, Word
|
||||
, either
|
||||
, flip
|
||||
, id
|
||||
, on
|
||||
, show
|
||||
, (||)
|
||||
)
|
||||
|
||||
import Control.Monad.Fail ( fail )
|
||||
import Data.Aeson
|
||||
import Data.Aeson ( ToJSONKey )
|
||||
import qualified Data.Attoparsec.Text as Atto
|
||||
import qualified Data.Text as T
|
||||
import GHC.Base ( error )
|
||||
@@ -205,7 +236,7 @@ parseVersion = do
|
||||
-- >>> Atto.parseOnly parseRange ">=2.14.1.1 <3.0.0"
|
||||
-- Right >=2.14.1.1 <3.0.0
|
||||
parseRange :: Atto.Parser VersionRange
|
||||
parseRange = s <|> (Atto.char '*' *> pure Any) <|> (Anchor (Right EQ) <$> parseVersion)
|
||||
parseRange = s <|> (Atto.char '*' $> Any) <|> (Anchor (Right EQ) <$> parseVersion)
|
||||
where
|
||||
sub = Atto.char '(' *> Atto.skipSpace *> parseRange <* Atto.skipSpace <* Atto.char ')'
|
||||
s =
|
||||
|
||||
@@ -1,6 +1,15 @@
|
||||
module Migration where
|
||||
|
||||
import Database.Persist.Migration
|
||||
import Database.Persist.Migration ( Column(Column)
|
||||
, ColumnProp(NotNull)
|
||||
, MigrateSql(MigrateSql)
|
||||
, Migration
|
||||
, MigrationPath((:=))
|
||||
, Operation(AddColumn, DropColumn, RawOperation)
|
||||
, PersistValue(PersistText)
|
||||
, SqlType(SqlString)
|
||||
, rawSql
|
||||
)
|
||||
import Database.Persist.Sql ( Single(..) )
|
||||
import Startlude ( ($)
|
||||
, (<<$>>)
|
||||
|
||||
25
src/Model.hs
25
src/Model.hs
@@ -11,13 +11,28 @@
|
||||
|
||||
module Model where
|
||||
|
||||
import Crypto.Hash
|
||||
import Database.Persist.TH
|
||||
import Lib.Types.AppIndex
|
||||
import Lib.Types.Emver
|
||||
import Crypto.Hash ( Digest
|
||||
, SHA256
|
||||
)
|
||||
import Database.Persist.TH ( mkMigrate
|
||||
, mkPersist
|
||||
, persistLowerCase
|
||||
, share
|
||||
, sqlSettings
|
||||
)
|
||||
import Lib.Types.AppIndex ( PkgId(PkgId) )
|
||||
import Lib.Types.Emver ( Version
|
||||
, VersionRange
|
||||
)
|
||||
import Orphans.Cryptonite ( )
|
||||
import Orphans.Emver ( )
|
||||
import Startlude
|
||||
import Startlude ( Eq
|
||||
, Int
|
||||
, Show
|
||||
, Text
|
||||
, UTCTime
|
||||
, Word32
|
||||
)
|
||||
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
|
||||
PkgRecord
|
||||
|
||||
@@ -4,15 +4,34 @@
|
||||
-- aeson, persistent, and yesod are not. So we put those here as they will not be extracted into a separate library.
|
||||
module Orphans.Emver where
|
||||
|
||||
import Startlude
|
||||
import Startlude ( ($)
|
||||
, (.)
|
||||
, (<=<)
|
||||
, Applicative(pure)
|
||||
, Bifunctor(first)
|
||||
, either
|
||||
, show
|
||||
)
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson ( FromJSON(parseJSON)
|
||||
, ToJSON(toJSON)
|
||||
, Value(String)
|
||||
, withText
|
||||
)
|
||||
import qualified Data.Attoparsec.Text as Atto
|
||||
|
||||
import Control.Monad.Fail ( MonadFail(fail) )
|
||||
import qualified Data.Text as T
|
||||
import Database.Persist.Sql
|
||||
import Lib.Types.Emver
|
||||
import Database.Persist.Sql ( PersistField(..)
|
||||
, PersistFieldSql(..)
|
||||
, PersistValue(PersistText)
|
||||
, SqlType(SqlString)
|
||||
)
|
||||
import Lib.Types.Emver ( Version
|
||||
, VersionRange
|
||||
, parseRange
|
||||
, parseVersion
|
||||
)
|
||||
|
||||
instance FromJSON Version where
|
||||
parseJSON = withText "Emver Version" $ either fail pure . Atto.parseOnly parseVersion
|
||||
|
||||
@@ -9,16 +9,40 @@
|
||||
module Settings where
|
||||
|
||||
import Paths_start9_registry ( version )
|
||||
import Startlude
|
||||
import Startlude ( ($)
|
||||
, (.)
|
||||
, (<$>)
|
||||
, Applicative(liftA2)
|
||||
, Bool(..)
|
||||
, ByteString
|
||||
, ConvertText(toS)
|
||||
, FilePath
|
||||
, IsString(fromString)
|
||||
, Monad(return)
|
||||
, Monoid(mempty)
|
||||
, Text
|
||||
, Word16
|
||||
, either
|
||||
, id
|
||||
, panic
|
||||
)
|
||||
|
||||
import qualified Control.Exception as Exception
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import Data.Aeson ( (.!=)
|
||||
, (.:)
|
||||
, (.:?)
|
||||
, FromJSON(parseJSON)
|
||||
, Result(Error, Success)
|
||||
, Value(String)
|
||||
, fromJSON
|
||||
, withObject
|
||||
)
|
||||
import Data.Aeson.Types ( parseMaybe )
|
||||
import Data.FileEmbed ( embedFile )
|
||||
import Data.Maybe
|
||||
import Data.Maybe ( fromJust )
|
||||
import Data.Version ( showVersion )
|
||||
import Data.Yaml ( decodeEither' )
|
||||
import Data.Yaml.Config
|
||||
import Data.Yaml.Config ( applyEnvValue )
|
||||
import Database.Persist.Postgresql ( PostgresConf )
|
||||
import Network.Wai.Handler.Warp ( HostPreference )
|
||||
import System.FilePath ( (</>)
|
||||
@@ -30,7 +54,7 @@ import Control.Monad.Reader.Has ( Has(extract, update) )
|
||||
import Lib.PkgRepository ( EosRepo(EosRepo, eosRepoFileRoot)
|
||||
, PkgRepo(..)
|
||||
)
|
||||
import Lib.Types.Emver
|
||||
import Lib.Types.Emver ( Version )
|
||||
import Orphans.Emver ( )
|
||||
-- | Runtime settings to configure this application. These settings can be
|
||||
-- loaded from various sources: defaults, environment variables, config files,
|
||||
|
||||
@@ -10,8 +10,20 @@ module Util.Shared where
|
||||
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Types
|
||||
import Yesod.Core
|
||||
import Network.HTTP.Types ( Status
|
||||
, status400
|
||||
)
|
||||
import Yesod.Core ( MonadHandler
|
||||
, MonadLogger
|
||||
, MonadUnliftIO
|
||||
, ToContent(toContent)
|
||||
, TypedContent(TypedContent)
|
||||
, addHeader
|
||||
, logInfo
|
||||
, lookupGetParam
|
||||
, sendResponseStatus
|
||||
, typePlain
|
||||
)
|
||||
|
||||
import Conduit ( ConduitT
|
||||
, awaitForever
|
||||
@@ -28,7 +40,7 @@ import Database.Esqueleto.Experimental
|
||||
, Key
|
||||
, entityVal
|
||||
)
|
||||
import Foundation
|
||||
import Foundation ( Handler )
|
||||
import GHC.List ( lookup )
|
||||
import Handler.Types.Marketplace ( PackageDependencyMetadata(..)
|
||||
, PackageMetadata(..)
|
||||
@@ -37,7 +49,11 @@ import Lib.PkgRepository ( PkgRepo
|
||||
, getHash
|
||||
)
|
||||
import Lib.Types.AppIndex ( PkgId )
|
||||
import Lib.Types.Emver
|
||||
import Lib.Types.Emver ( (<||)
|
||||
, Version
|
||||
, VersionRange(Any)
|
||||
, satisfies
|
||||
)
|
||||
import Model ( Category
|
||||
, PkgDependency(pkgDependencyDepId, pkgDependencyDepVersionRange)
|
||||
, PkgRecord
|
||||
|
||||
@@ -1,140 +0,0 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Handler.AppSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Data.Maybe
|
||||
import Database.Persist.Sql
|
||||
import Startlude
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types ( parseEither )
|
||||
import Data.String.Interpolate.IsString
|
||||
( i )
|
||||
import Handler.Types.Marketplace ( PackageRes(packageResDependencies, packageResManifest) )
|
||||
import Lib.Types.AppIndex
|
||||
import Model
|
||||
import Seed
|
||||
import TestImport
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "GET /package/index" $ withApp $ it "returns list of packages" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/index" :: Text)
|
||||
statusIs 200
|
||||
(res :: [PackageRes]) <- requireJSONResponse
|
||||
assertEq "response should have two packages" (length res) 3
|
||||
describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.2\"}]" :: Text)
|
||||
statusIs 200
|
||||
(res :: [PackageRes]) <- requireJSONResponse
|
||||
assertEq "response should have one package" (length res) 1
|
||||
let pkg = fromJust $ head res
|
||||
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
|
||||
pure
|
||||
(parseEither parseJSON $ packageResManifest pkg)
|
||||
assertEq "manifest id should be bitcoind" (packageManifestId manifest) "bitcoind"
|
||||
describe "GET /package/index?ids"
|
||||
$ withApp
|
||||
$ it "returns list of packages and dependencies at specified version"
|
||||
$ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/index?ids=[{\"id\":\"lnd\",\"version\":\"=0.13.3.1\"}]" :: Text)
|
||||
statusIs 200
|
||||
(res :: [PackageRes]) <- requireJSONResponse
|
||||
assertEq "response should have one package" (length res) 1
|
||||
let pkg = fromJust $ head res
|
||||
assertEq "package dependency metadata should not be empty" (null $ packageResDependencies pkg) False
|
||||
describe "GET /package/index?ids" $ withApp $ it "returns list of packages at exactly specified version" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\"=0.21.1.1\"}]" :: Text)
|
||||
statusIs 200
|
||||
(res :: [PackageRes]) <- requireJSONResponse
|
||||
assertEq "response should have one package" (length res) 1
|
||||
let pkg = fromJust $ head res
|
||||
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
|
||||
pure
|
||||
(parseEither parseJSON $ packageResManifest pkg)
|
||||
assertEq "manifest version should be 0.21.1.1" (packageManifestVersion manifest) "0.21.1.1"
|
||||
describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version or greater" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.1\"}]" :: Text)
|
||||
statusIs 200
|
||||
(res :: [PackageRes]) <- requireJSONResponse
|
||||
assertEq "response should have one package" (length res) 1
|
||||
let pkg = fromJust $ head res
|
||||
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
|
||||
pure
|
||||
(parseEither parseJSON $ packageResManifest pkg)
|
||||
assertEq "manifest version should be 0.21.1.2" (packageManifestVersion manifest) "0.21.1.2"
|
||||
describe "GET /package/index?ids" $ withApp $ it "returns list of packages at specified version or greater" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/index?ids=[{\"id\":\"bitcoind\",\"version\":\">=0.21.1.2\"}]" :: Text)
|
||||
statusIs 200
|
||||
(res :: [PackageRes]) <- requireJSONResponse
|
||||
assertEq "response should have one package" (length res) 1
|
||||
let pkg = fromJust $ head res
|
||||
(manifest :: PackageManifest) <- either (\e -> panic [i|failed to parse package manifest: #{e}|])
|
||||
pure
|
||||
(parseEither parseJSON $ packageResManifest pkg)
|
||||
assertEq "manifest version should be 0.21.1.2" (packageManifestVersion manifest) "0.21.1.2"
|
||||
describe "GET /package/:pkgId with unknown version spec for bitcoind" $ withApp $ it "fails to get unknown app" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/bitcoind.s9pk?spec==0.20.0" :: Text)
|
||||
statusIs 404
|
||||
describe "GET /package/:pkgId with unknown package" $ withApp $ it "fails to get an unregistered app" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/tempapp.s9pk?spec=0.0.1" :: Text)
|
||||
statusIs 404
|
||||
describe "GET /package/:pkgId with package at unknown version"
|
||||
$ withApp
|
||||
$ it "fails to get an unregistered app"
|
||||
$ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/lightning.s9pk?spec==0.0.1" :: Text)
|
||||
statusIs 404
|
||||
describe "GET /package/:pkgId with existing version spec for bitcoind"
|
||||
$ withApp
|
||||
$ it "creates app and metric records"
|
||||
$ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/bitcoind.s9pk?spec==0.21.1.2" :: Text)
|
||||
statusIs 200
|
||||
packages <- runDBtest $ selectList [PkgRecordId ==. PkgRecordKey "bitcoind"] []
|
||||
assertEq "app should exist" (length packages) 1
|
||||
let app = fromJust $ head packages
|
||||
metrics <- runDBtest $ selectList [MetricPkgId ==. entityKey app] []
|
||||
assertEq "metric should exist" (length metrics) 1
|
||||
describe "GET /package/:pkgId with existing version spec for lnd" $ withApp $ it "creates metric records" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
request $ do
|
||||
setMethod "GET"
|
||||
setUrl ("/package/lnd.s9pk?spec=>=0.13.3.0" :: Text)
|
||||
statusIs 200
|
||||
metrics <- runDBtest $ selectList [MetricPkgId ==. PkgRecordKey "lnd"] []
|
||||
assertEq "metric should exist" (length metrics) 1
|
||||
@@ -1,55 +0,0 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Handler.MarketplaceSpec
|
||||
( spec
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Maybe
|
||||
import Database.Persist.Sql
|
||||
import Startlude hiding ( Any )
|
||||
|
||||
import Conduit ( (.|)
|
||||
, runConduit
|
||||
, sinkList
|
||||
)
|
||||
import Database.Marketplace
|
||||
import Lib.Types.Category
|
||||
import Model
|
||||
import TestImport
|
||||
import Seed
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "searchServices with category" $ withApp $ it "should filter services with featured category" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
packages <- runDBtest $ runConduit $ searchServices (Just FEATURED) "" .| sinkList
|
||||
assertEq "should exist" (length packages) 1
|
||||
let pkg = fromJust $ head packages
|
||||
assertEq "should be bitcoin" (pkgRecordTitle $ entityVal pkg) "Bitcoin Core"
|
||||
describe "searchServices with category" $ withApp $ it "should filter services with bitcoin category" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
packages <- runDBtest $ runConduit $ searchServices (Just BITCOIN) "" .| sinkList
|
||||
assertEq "should exist" (length packages) 3
|
||||
describe "searchServices with fuzzy query"
|
||||
$ withApp
|
||||
$ it "runs search service with fuzzy text in long description and no category"
|
||||
$ do
|
||||
_ <- seedBitcoinLndStack
|
||||
packages <- runDBtest $ runConduit $ searchServices Nothing "lightning" .| sinkList
|
||||
assertEq "should exist" (length packages) 1
|
||||
let pkg = fromJust $ head packages
|
||||
assertEq "package should be lnd" (entityKey pkg) (PkgRecordKey "lnd")
|
||||
describe "searchServices with fuzzy query"
|
||||
$ withApp
|
||||
$ it "runs search service with fuzzy text in long description and bitcoin category"
|
||||
$ do
|
||||
_ <- seedBitcoinLndStack
|
||||
packages <- runDBtest $ runConduit $ searchServices (Just BITCOIN) "proxy" .| sinkList
|
||||
assertEq "should exist" (length packages) 1
|
||||
let pkg = fromJust $ head packages
|
||||
assertEq "package should be lnc" (entityKey pkg) (PkgRecordKey "btc-rpc-proxy")
|
||||
describe "searchServices with any category" $ withApp $ it "runs search service for any category" $ do
|
||||
_ <- seedBitcoinLndStack
|
||||
packages <- runDBtest $ runConduit $ searchServices Nothing "" .| sinkList
|
||||
assertEq "should exist" (length packages) 3
|
||||
55
test/Seed.hs
55
test/Seed.hs
@@ -1,55 +0,0 @@
|
||||
module Seed where
|
||||
|
||||
import Database.Persist.Sql ( PersistStoreWrite(insert, insertKey, insert_) )
|
||||
import Model ( Category(Category)
|
||||
, Key(PkgRecordKey)
|
||||
, PkgCategory(PkgCategory)
|
||||
, PkgDependency(PkgDependency)
|
||||
, PkgRecord(PkgRecord)
|
||||
, VersionRecord(VersionRecord)
|
||||
)
|
||||
import Startlude ( ($)
|
||||
, Applicative(pure)
|
||||
, Maybe(Just, Nothing)
|
||||
, MonadIO(liftIO)
|
||||
, getCurrentTime
|
||||
)
|
||||
|
||||
import Lib.Types.Category ( CategoryTitle(BITCOIN, FEATURED, LIGHTNING) )
|
||||
import Prelude ( read )
|
||||
import TestImport ( RegistryCtx
|
||||
, SIO
|
||||
, YesodExampleData
|
||||
, runDBtest
|
||||
)
|
||||
|
||||
seedBitcoinLndStack :: SIO (YesodExampleData RegistryCtx) ()
|
||||
seedBitcoinLndStack = runDBtest $ do
|
||||
time <- liftIO getCurrentTime
|
||||
insertKey (PkgRecordKey "bitcoind")
|
||||
$ PkgRecord time (Just time) "Bitcoin Core" "short desc bitcoin" "long desc bitcoin" "png"
|
||||
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "bitcoind") "0.21.1.2" "notes" "0.3.0" Nothing
|
||||
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "bitcoind") "0.21.1.1" "notes" "0.3.0" Nothing
|
||||
_ <- insertKey (PkgRecordKey "lnd")
|
||||
$ PkgRecord time (Just time) "Lightning Network Daemon" "short desc lnd" "long desc lnd" "png"
|
||||
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.0" "notes" "0.3.0" Nothing
|
||||
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "lnd") "0.13.3.1" "notes" "0.3.0" Nothing
|
||||
_ <- insertKey (PkgRecordKey "btc-rpc-proxy")
|
||||
$ PkgRecord time (Just time) "BTC RPC Proxy" "short desc btc-rpc-proxy" "long desc btc-rpc-proxy" "png"
|
||||
_ <- insert $ VersionRecord time (Just time) (PkgRecordKey "btc-rpc-proxy") "0.3.2.1" "notes" "0.3.0" Nothing
|
||||
featuredCat <- insert $ Category time FEATURED Nothing "desc" 0
|
||||
btcCat <- insert $ Category time BITCOIN Nothing "desc" 0
|
||||
lnCat <- insert $ Category time LIGHTNING Nothing "desc" 0
|
||||
_ <- insert_ $ PkgCategory time (PkgRecordKey "bitcoind") featuredCat
|
||||
_ <- insert_ $ PkgCategory time (PkgRecordKey "lnd") lnCat
|
||||
_ <- insert_ $ PkgCategory time (PkgRecordKey "lnd") btcCat
|
||||
_ <- insert_ $ PkgCategory time (PkgRecordKey "bitcoind") btcCat
|
||||
_ <- insert_ $ PkgCategory time (PkgRecordKey "btc-rpc-proxy") btcCat
|
||||
_ <- insert_
|
||||
$ PkgDependency time (PkgRecordKey "lnd") "0.13.3.1" (PkgRecordKey "bitcoind") (read ">=0.21.1.2 <0.22.0")
|
||||
_ <- insert_ $ PkgDependency time
|
||||
(PkgRecordKey "lnd")
|
||||
"0.13.3.1"
|
||||
(PkgRecordKey "btc-rpc-proxy")
|
||||
(read ">=0.3.2.1 <0.4.0")
|
||||
pure ()
|
||||
Reference in New Issue
Block a user