fixes

resources/apps/lnd/0.13.3.1/manifest.json

@@ -16,6 +16,13 @@
   "build": [
     "make"
   ],
+    "hardware-requirements" {
+    "device": {
+      "processor": "intel",
+      "display": "r'^{.*}$'"
+    },
+    "ram": "8"
+  }
   "release-notes": "Upgrade to EmbassyOS v0.3.0",
   "license": "mit",
   "wrapper-repo": "https://github.com/Start9Labs/lnd-wrapper",

src/Database/Queries.hs

@@ -122,17 +122,17 @@ serviceQuerySource ::
     (MonadResource m, MonadIO m) =>
     Maybe Text ->
     Text ->
-    Maybe OsArch ->
+    [OsArch] ->
     Maybe Int ->
     ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
-serviceQuerySource mCat query mOsArch mRam = selectSource $ do
+serviceQuerySource mCat query arches mRam = selectSource $ do
     service <- case mCat of
         Nothing -> do
             (service :& vp :& pr) <- from $ table @VersionRecord 
                 `innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
                 `innerJoin` table @PkgRecord `on` (\(v :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
             where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
-            where_ (vp ^. VersionPlatformArch ==. val mOsArch)
+            where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
             where_ (vp ^. VersionPlatformRam ==. val mRam)
             where_ (pr ^. PkgRecordHidden ==. val False)
             where_ $ queryInMetadata query service
@@ -149,7 +149,7 @@ serviceQuerySource mCat query mOsArch mRam = selectSource $ do
             -- weight title, short, long (bitcoin should equal Bitcoin Core)
             where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
             where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
-            where_ (vp ^. VersionPlatformArch ==. val mOsArch)
+            where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
             where_ (vp ^. VersionPlatformRam >. val mRam)
             where_ (pr ^. PkgRecordHidden ==. val False)
             pure service
@@ -168,12 +168,12 @@ queryInMetadata query service =
         ||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
 
 
-getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> Maybe OsArch -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
+getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> [OsArch] -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
-getPkgDataSource pkgs mOsArch = selectSource $ do
+getPkgDataSource pkgs arches = selectSource $ do
     (pkgData :& vp) <- from $ table @VersionRecord
         `innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
     where_ (pkgData ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
-    where_ (vp ^. VersionPlatformArch ==. val mOsArch)
+    where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
     where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs))
     pure pkgData
 
@@ -317,12 +317,12 @@ upsertPackageVersionPlatform maybeArches PackageManifest{..} = do
 getVersionPlatform ::
     (Monad m, MonadIO m) =>
     PkgRecordId ->
-    [Maybe OsArch] ->
+    [OsArch] ->
     ReaderT SqlBackend m [VersionPlatform]
 getVersionPlatform pkgId arches = do
     vps <- select $ do
         v <- from $ table @VersionPlatform
         where_ $ v ^. VersionPlatformPkgId ==. val pkgId
-        where_ (v ^. VersionPlatformArch `in_` valList arches)
+        where_ (v ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
         pure v
     pure $ entityVal <$> vps

src/Handler/Package/V0/Latest.hs

@@ -16,9 +16,9 @@ import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version (..), satisfies)
 import Model (VersionRecord (..))
 import Network.HTTP.Types (status400)
-import Startlude (Bool (True), Down (Down), Either (..), Generic, Maybe (..), NonEmpty, Show, const, encodeUtf8, filter, flip, nonEmpty, pure, ($), (.), (<$>), (<&>))
+import Startlude (Bool (True), Down (Down), Either (..), Generic, Maybe (..), NonEmpty, Show, const, encodeUtf8, filter, flip, nonEmpty, pure, ($), (.), (<$>), (<&>), (>>=))
 import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
-import Handler.Util (getOsArch, filterDeprecatedVersions)
+import Handler.Util (filterDeprecatedVersions, getPkgArch)
 import Yesod.Core (getsYesod)
 import Settings (AppSettings(communityVersion))
 
@@ -39,7 +39,9 @@ getVersionLatestR = do
         getOsVersionCompat <&> \case
             Nothing -> const True
             Just v -> flip satisfies v
-    osArch <- getOsArch
+    pkgArch <- getPkgArch >>= \case
+        Nothing -> pure []
+        Just a -> pure a
     communityServiceDeprecationVersion <- getsYesod $ communityVersion . appSettings
     do
         case lookup "ids" getParameters of
@@ -48,7 +50,7 @@ getVersionLatestR = do
                 Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages)
                 Right p -> do
                     let packageList = (,Nothing) <$> p
-                    let source = getPkgDataSource p osArch
+                    let source = getPkgDataSource p pkgArch
                     filteredPackages <-
                         runDB $
                             runConduit $

src/Handler/Package/V1/Index.hs

@@ -28,7 +28,7 @@ import Database.Queries (
 import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings, appConnPool))
 import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
 import Handler.Types.Api (ApiVersion (..))
-import Handler.Util (basicRender, parseQueryParam, filterDeprecatedVersions, filterDevices, getPkgArch, getOsArch)
+import Handler.Util (basicRender, parseQueryParam, filterDeprecatedVersions, filterDevices, getPkgArch)
 import Lib.PkgRepository (PkgRepo, getIcon, getManifest)
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||))
@@ -123,24 +123,22 @@ getPackageIndexR = do
         getOsVersionCompat <&> \case
             Nothing -> const True
             Just v -> flip satisfies v
-    osArch <- getOsArch
     pkgArch <- getPkgArch >>= \case
-        Nothing -> pure $ [Nothing]
+        Nothing -> pure []
-        Just a -> pure $ Just <$> a
+        Just a -> pure a
     ram <- getRamQuery
     hardwareDevices <- getHardwareDevicesQuery
     communityVersion <- getsYesod $ communityVersion . appSettings
     pool <- getsYesod appConnPool
-    do
     pkgIds <- getPkgIdsQuery
     category <- getCategoryQuery
     page <- fromMaybe 1 <$> getPageQuery
     limit' <- fromMaybe 20 <$> getLimitQuery
     query <- T.strip . fromMaybe "" <$> lookupGetParam "query"
     let (source, packageRanges) = case pkgIds of
-                Nothing -> (serviceQuerySource category query osArch ram, const Any)
+            Nothing -> (serviceQuerySource category query pkgArch ram, const Any)
             Just packages ->
-                    let s = getPkgDataSource (packageReqId <$> packages) osArch
+                let s = getPkgDataSource (packageReqId <$> packages) pkgArch
                     r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages)
                 in (s, r)
     filteredPackages <-
@@ -153,6 +151,7 @@ getPackageIndexR = do
                     .| mapC (second (filter (osPredicate . versionRecordOsVersion)))
                     -- filter out deprecated service versions after community registry release
                     .| mapC (second (filterDeprecatedVersions communityVersion osPredicate))
+                    -- filter hardware device compatability                        
                     .| mapMC (\(b,c) -> do 
                         l <- filterDevices pool hardwareDevices pkgArch c
                         pure (b, l)

src/Handler/Util.hs

@@ -23,7 +23,7 @@ import Lib.PkgRepository (
     PkgRepo,
     getHash,
  )
-import Lib.Types.Core (PkgId, OsArch)
+import Lib.Types.Core (PkgId, OsArch (..))
 import Lib.Types.Emver (
     Version,
     VersionRange,
@@ -61,7 +61,7 @@ import Startlude (
     ($),
     (.),
     (<$>),
-    (>>=), note, (=<<), catMaybes, all, traverse, or
+    (>>=), note, (=<<), catMaybes, all, traverse, or, encodeUtf8, toS
  )
 import UnliftIO (MonadUnliftIO)
 import Yesod (
@@ -86,6 +86,8 @@ import Startlude (MonadIO)
 import Text.Regex.TDFA ((=~))
 import Startlude (filterM)
 import Database.Persist.Postgresql (ConnectionPool, runSqlPool)
+import Data.Aeson (eitherDecodeStrict)
+import Data.Bifunctor (Bifunctor(first))
 
 orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a
 orThrow action other =
@@ -201,13 +203,25 @@ getOsVersionQuery = parseQueryParam "os.version" ((flip $ note . mappend "Invali
 
 getOsVersion :: Handler (Maybe Version)
 getOsVersion = do
-    osArch <- getOsVersionQuery >>= \case
+    osVersion <- getOsVersionQuery >>= \case
         Just a -> pure $ Just a
         Nothing -> getOsVersionLegacy
-    pure osArch
+    pure osVersion
 
 getPkgArch :: Handler (Maybe [OsArch])
-getPkgArch = parseQueryParam "hardware.arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe)
+getPkgArch = do 
+    arch <- parseQueryParam "hardware.arch" parseArch >>= \case
+        Just a -> pure $ Just a
+        Nothing -> do
+            getOsArch >>= \case
+                Just a -> pure $ Just [a]
+                Nothing -> pure $ Just []
+    pure arch
+
+-- >>> parseArch "[\"aarch64\"]"
+-- Right [aarch64]
+parseArch :: Text -> Either Text [OsArch]
+parseArch = first toS . eitherDecodeStrict . encodeUtf8
 
 filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord]
 filterDeprecatedVersions communityVersion osPredicate vrs = do
@@ -215,7 +229,7 @@ filterDeprecatedVersions communityVersion osPredicate vrs = do
         then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs
         else vrs
 
-filterDevices :: (MonadUnliftIO m) => ConnectionPool -> (HM.HashMap Text Text) -> [Maybe OsArch] -> [VersionRecord] -> m [VersionRecord]
+filterDevices :: (MonadUnliftIO m) => ConnectionPool -> (HM.HashMap Text Text) -> [OsArch] -> [VersionRecord] -> m [VersionRecord]
 filterDevices pool hardwareDevices arches pkgRecords = do
     res <- filterM compareHd pkgRecords
     pure res
@@ -232,6 +246,7 @@ regexMatch (RegexPattern pattern) text = text =~ pattern
 
 areRegexMatchesEqual :: (MonadIO m) => HM.HashMap Text Text -> PackageDevice ->  m Bool
 areRegexMatchesEqual textMap (PackageDevice regexMap) =
+    -- putStrLn @Text textMap
     pure $ all checkMatch (HM.toList regexMap)
   where
     checkMatch :: (Text, RegexPattern) -> Bool

src/Lib/Types/Core.hs

@@ -27,7 +27,7 @@ import Startlude (
     show,
     symbolVal,
     ($),
-    (.), Enum,
+    (.), Enum, Applicative (..),
  )
 
 import Data.Aeson (
@@ -57,7 +57,8 @@ import Web.HttpApiData (
     ToHttpApiData,
  )
 import Yesod (PathPiece (..))
-import Prelude (read)
+import Prelude (read, fail)
+import Data.Aeson.Types (withText)
 
 newtype PkgId = PkgId {unPkgId :: Text}
     deriving stock (Eq, Ord)
@@ -111,7 +112,14 @@ instance PersistField OsArch where
 instance PersistFieldSql OsArch where
     sqlType _ = SqlString
 instance FromJSON OsArch where
-    parseJSON = parseJSON
+    parseJSON = withText "OsArch" $ \case
+        "x86_64"         -> pure X86_64
+        "aarch64"        -> pure AARCH64
+        "raspberrypi"    -> pure RASPBERRYPI
+        "rasberrypi"    -> pure RASPBERRYPI
+        "x86_64-nonfree" -> pure X86_64_NONFREE
+        "arch64-nonfree"-> pure AARCH64_NONFREE
+        _                -> fail "Invalid OsArch value"
 instance ToJSON OsArch where
     toJSON = toJSON
 

src/Lib/Types/Manifest.hs

@@ -111,11 +111,10 @@ testManifest =
   },
   "hardware-requirements" {
     "device": {
-      processor: "intel",
+      "processor": "intel",
-      display: "r'^{.*}$'"
+      "display": "r'^{.*}$'"
     },
     "ram": "8"
-
   }
   "assets": {
     "license": "LICENSE",