filter packages for os compatibility before fetching metadata (#117)

* filter packages for os compatibility before fetching metadata

* address PR feedback and add os filtering to get package latest version endpoint

* additional test suite data

* filter empty version sets

* attempt to fix leak

Co-authored-by: Keagan McClelland <keagan.mcclelland@gmail.com>

resources/apps/lnd/0.13.3/hash.bin

@@ -0,0 +1 @@
+PFLZO3TPFC57UTPBE3NKBLOTBRHSZH4DMNYQNX4FEQ54XCC6OB3R3UZEAS62ZLPNVRVNPRE2Z67O6NW4NHV2NEP5NPJ2FTDVHNJZFMY

resources/apps/lnd/0.13.3/instructions.md

@@ -0,0 +1,52 @@
+# Lightning Network Daemon (LND)
+
+## Dependencies
+
+LND on the Embassy requires a full archival Bitcoin node to function. Since your Embassy Bitcoin node is pruned by default, an additional service, Bitcoin Proxy, is also required.
+
+## LND Config
+
+Your LND node is highly configurable. Many settings are considered _advanced_ and should be used with caution. For the vast majority of users and use-cases, we recommend using the defaults. Once configured, you may start your node!
+
+## Bitcoin Proxy Config
+
+On the LND page, scroll down to find the Bitcoin Proxy dependency. Click `Configure`. This will automatically configure Bitcoin Proxy to satisfy LND.
+
+# Lightning Usage Guide
+
+## Using a Wallet
+
+Enter your LND-Connect QR code (located in `properties`) into any wallet that supports connecting to a remote LND node over Tor. For a list of compatible wallets, see <a href="https://github.com/start9labs/lnd-wrapper/blob/master/docs/wallets.md" target="_blank">https://github.com/start9labs/lnd-wrapper/blob/master/docs/wallets.md</a>.
+
+## Getting On-Chain Funds
+
+Before you can open and channel and start transacting on the Lightning network, you need some Bitcoin stored on your LND node. Be advised, Bitcoin funds that you transfer to your LND node are hot, meaning, the are stored directly on your Embassy. There is no way to use cold storage when using Lightning, which is why people call it reckless. For this reason, it is usually unwise to move large amounts of Bitcoin to your LND node. That said, you don't want to move a tiny amount either, since that would limit your purchasing power on the Lightning network. We recommend moving about 500,000-5,000,000 satoshis, or .005-.05 Bitcoin, which at current (May 7, 2021) prices is about $250-$2,500. This gives you a solid amount of purchasing power, but hopefully wouldn't ruin your life if something were to go terribly wrong. If you feel comfortable using more Bitcoin, then by all means, go for it.
+
+## Depositing to LND
+
+When using LND or any wallet that is connected to LND it is important to note that until "Synced to Chain" in the Properties page is reporting ✅, your deposits to your LND on-chain wallet may not appear.
+
+## Opening a Channel and Getting Outbound Liquidity
+
+Once your LND node is synced, it's time to open a channel. Opening a channel with a well-connected node is how you get connected to the rest of the network, and it immediately grants you outbound liquidity. Meaning, you will be able to send money to others. Unless you are planning to become a Lightning Service Provider, you do not want to open more than a couple of channels at most. Managing many channels is difficult, it can be quite expensive, and unless you plan to devote significant resources in the form of time and Bitcoin, there is no profit in it. If your goal is to use Lightning to benefit from instant and near-free transactions, you only need 2-3 good channels.
+
+If you are looking for destinations for your first channel, we suggest you open a channel with the [Start9 HQ](025d28dc4c4f5ce4194c31c3109129cd741fafc1ff2f6ea53f97de2f58877b2295@64.225.19.231:9735) node, which is already very well connected.
+
+It is not recommended to open a channel less than 100,000 satoshi, or .001 BTC, or $50 USD in today's prices. Anything less, and it's possible that the cost to open and close the channel might approach the size of the channel itself. The bigger the channel you open, the more outbound liquidity you will have, which means you have more spending power on the network. In this tutorial, we are going to open a channel of 2,000,000 satoshi. When opening a channel with Start9 HQ, we ask that you make it a private channel, meaning it will not display publicly on network graph. The reason for this is that unless you plan to be a very active Lightning Node Operator, having public channels decreases not only the reliability of your node but also hurts Start9's ability to route payments for you. If you do intend to be a serious node operator, we require that your channel be for a minimum of 5,000,000 sats. Please contact us in one of our community channels for further details.
+
+## Getting Inbound Liquidity
+
+If you want to receive payments, you will need some inbound liquidity.
+
+The first, easiest, and best way to get inbound liquidity is to use your outbound liquidity to buy something. Any Bitcoin you spend using your outbound liquidity is Bitcoin you can now receive back. So if there is something you want to buy, like a Start9 Embassy or a t-shirt from the Start9 store, simply make the purchase, and you will then have inbound liquidity equal to the amount of Satoshis you spend.
+
+Option 2 is to personally ask Start9 for an invoice for however much inbound liquity you want. Then you send Bitcoin to the invoice, and in turn we will transfer fiat currency to you equal to the amount of the Bitcoin you send us. In other words, Start9 will buy some Bitcoin from you at market rate, such that you then have inbound liquidity. In either case, you are spending or selling some Bitcoin.
+
+The only way to get inbound liquidity without spending or selling Bitcoin is to convince someone to open a channel with you, just as you opened a channel with Start9 HQ. This may be a difficult task, since there is not much incentive for someone to open a channel with you unless you are also very well connected. Also, you will need to make sure that they too, are well connected with plenty of inbound liquidity, or else your inbound liquidity with them will not really matter. In other words, they might be the only person capable of paying you.
+
+So options 1 or 2 are best. Use your Lightning node's outbound liquidity to either purchase something or sell some Bitcoin. Now, you can pay and get paid using Lightning in an amount equal to your outbound and inbound liquidity.
+
+## Sending payments over Lightning
+
+Once you have open channels and are ready to transact on the Lightning Network, it is important to note that until "Synced to Graph" in the Properties page is reporting ✅, you may experience problems finding routes to your destination.
+

resources/apps/lnd/0.13.3/license.md

@@ -0,0 +1,19 @@
+Copyright (C) 2015-2018 Lightning Labs and The Lightning Network Developers
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

resources/apps/lnd/0.13.3/manifest.json

@@ -0,0 +1,348 @@
+{
+  "id": "lnd",
+  "title": "Lightning Network Daemon",
+  "version": "0.13.3",
+  "description": {
+    "short": "A complete implementation of a Lightning Network node by Lightning Labs",
+    "long": "LND fully conforms to the Lightning Network specification (BOLTs). BOLT stands for: Basis of Lightning Technology. In the current state lnd is capable of: creating channels, closing channels, managing all channel states (including the exceptional ones!), maintaining a fully authenticated+validated channel graph, performing path finding within the network, passively forwarding incoming payments, sending outgoing onion-encrypted payments through the network, updating advertised fee schedules, and automatic channel management (autopilot).\n"
+  },
+  "assets": {
+    "license": "LICENSE",
+    "instructions": "instructions.md",
+    "icon": "icon.png",
+    "docker-images": "image.tar",
+    "assets": null
+  },
+  "build": [
+    "make"
+  ],
+  "release-notes": "Upgrade to EmbassyOS v0.3.0",
+  "license": "mit",
+  "wrapper-repo": "https://github.com/Start9Labs/lnd-wrapper",
+  "upstream-repo": "https://github.com/lightningnetwork/lnd",
+  "support-site": "https://lightning.engineering/slack.html",
+  "marketing-site": "https://lightning.engineering/",
+  "donation-url": null,
+  "alerts": {
+    "install": "READ CAREFULLY! LND and the Lightning Network are considered beta software. Please use with caution and do not risk more money than you are willing to lose. We encourage frequent backups. If for any reason, you need to restore LND from a backup, your on-chain wallet will be restored, but all your channels will be closed and their funds returned to your on-chain wallet, minus fees. It may also take some time for this process to occur.\n",
+    "uninstall": "READ CAREFULLY! Uninstalling LND will result in permanent loss of data, including its private keys for its on-chain wallet and all channel states. Please make a backup if you have any funds in your on-chain wallet or in any channels. Recovering from backup will restore your on-chain wallet, but due to the architecture of the Lightning Network, your channels cannot be recovered. All your channels will be closed and their funds returned to your on-chain wallet, minus fees. \n",
+    "restore": "Restoring LND will overwrite its current data, including its on-chain wallet and channels. Any channels opened since the last backup will be forgotten and may linger indefinitely, and channels contained in the backup will be closed and their funds returned to your on-chain wallet, minus fees.\n",
+    "start": null,
+    "stop": null
+  },
+  "main": {
+    "type": "docker",
+    "image": "main",
+    "system": false,
+    "entrypoint": "docker_entrypoint.sh",
+    "args": [],
+    "mounts": {
+      "bitcoind": "/mnt/bitcoind",
+      "btc-rpc-proxy": "/mnt/btc-rpc-proxy",
+      "main": "/root/.lnd"
+    },
+    "io-format": "yaml",
+    "inject": false,
+    "shm-size-mb": null
+  },
+  "health-checks": {
+    "synced": {
+      "type": "docker",
+      "image": "main",
+      "system": false,
+      "entrypoint": "health-check",
+      "args": [],
+      "mounts": {},
+      "io-format": "yaml",
+      "inject": true,
+      "shm-size-mb": null,
+      "critical": false
+    }
+  },
+  "config": {
+    "get": {
+      "type": "docker",
+      "image": "compat",
+      "system": true,
+      "entrypoint": "compat",
+      "args": [
+        "config",
+        "get",
+        "/root/.lnd",
+        "/mnt/assets/config_spec.yaml"
+      ],
+      "mounts": {
+        "compat": "/mnt/assets",
+        "main": "/root/.lnd"
+      },
+      "io-format": "yaml",
+      "inject": false,
+      "shm-size-mb": null
+    },
+    "set": {
+      "type": "docker",
+      "image": "compat",
+      "system": true,
+      "entrypoint": "compat",
+      "args": [
+        "config",
+        "set",
+        "lnd",
+        "/root/.lnd",
+        "/mnt/assets/config_rules.yaml"
+      ],
+      "mounts": {
+        "compat": "/mnt/assets",
+        "main": "/root/.lnd"
+      },
+      "io-format": "yaml",
+      "inject": false,
+      "shm-size-mb": null
+    }
+  },
+  "properties": {
+    "type": "docker",
+    "image": "compat",
+    "system": true,
+    "entrypoint": "compat",
+    "args": [
+      "properties",
+      "/root/.lnd"
+    ],
+    "mounts": {
+      "main": "/root/.lnd"
+    },
+    "io-format": "yaml",
+    "inject": false,
+    "shm-size-mb": null
+  },
+  "volumes": {
+    "bitcoind": {
+      "type": "pointer",
+      "package-id": "bitcoind",
+      "volume-id": "main",
+      "path": "/root",
+      "readonly": true
+    },
+    "btc-rpc-proxy": {
+      "type": "pointer",
+      "package-id": "btc-rpc-proxy",
+      "volume-id": "main",
+      "path": "/root",
+      "readonly": false
+    },
+    "certificates": {
+      "type": "certificate",
+      "interface-id": "control"
+    },
+    "compat": {
+      "type": "assets"
+    },
+    "main": {
+      "type": "data"
+    }
+  },
+  "min-os-version": "0.3.0",
+  "interfaces": {
+    "control": {
+      "name": "Control Interface",
+      "description": "Specifies the interfaces to listen on for RPC and REST connections.",
+      "tor-config": {
+        "port-mapping": {
+          "8080": "8080",
+          "10009": "10009"
+        }
+      },
+      "lan-config": null,
+      "ui": false,
+      "protocols": [
+        "tcp",
+        "http",
+        "grpc"
+      ]
+    },
+    "peer": {
+      "name": "Peer Interface",
+      "description": "Specifies the interfaces to listen on for p2p connections.",
+      "tor-config": {
+        "port-mapping": {
+          "9735": "9735"
+        }
+      },
+      "lan-config": null,
+      "ui": false,
+      "protocols": [
+        "tcp",
+        "http"
+      ]
+    },
+    "watchtower": {
+      "name": "Watchtower Interface",
+      "description": "Specifies the interfaces to listen on for watchtower client connections.",
+      "tor-config": {
+        "port-mapping": {
+          "9911": "9911"
+        }
+      },
+      "lan-config": null,
+      "ui": false,
+      "protocols": [
+        "tcp",
+        "grpc"
+      ]
+    }
+  },
+  "backup": {
+    "create": {
+      "type": "docker",
+      "image": "compat",
+      "system": true,
+      "entrypoint": "compat",
+      "args": [
+        "duplicity",
+        "create",
+        "/mnt/backup",
+        "/root/.lnd"
+      ],
+      "mounts": {
+        "BACKUP": "/mnt/backup",
+        "main": "/root/.lnd"
+      },
+      "io-format": "yaml",
+      "inject": false,
+      "shm-size-mb": null
+    },
+    "restore": {
+      "type": "docker",
+      "image": "compat",
+      "system": true,
+      "entrypoint": "/mnt/assets/backup-restore.sh",
+      "args": [
+        "duplicity",
+        "restore",
+        "/mnt/backup",
+        "/root/.lnd"
+      ],
+      "mounts": {
+        "BACKUP": "/mnt/backup",
+        "compat": "/mnt/assets",
+        "main": "/root/.lnd"
+      },
+      "io-format": "yaml",
+      "inject": false,
+      "shm-size-mb": null
+    }
+  },
+  "migrations": {
+    "from": {},
+    "to": {}
+  },
+  "actions": {},
+  "dependencies": {
+    "bitcoind": {
+      "version": ">=0.21.1.2 <0.22.0",
+      "requirement": {
+        "type": "opt-out",
+        "how": "Can alternatively configure an external bitcoin node."
+      },
+      "description": "Used to subscribe to new block events.",
+      "critical": true,
+      "config": {
+        "check": {
+          "type": "docker",
+          "image": "compat",
+          "system": true,
+          "entrypoint": "compat",
+          "args": [
+            "dependency",
+            "check",
+            "lnd",
+            "bitcoind",
+            "/root/.lnd",
+            "/mnt/assets/bitcoind_config_rules.yaml"
+          ],
+          "mounts": {
+            "compat": "/mnt/assets",
+            "main": "/root/.lnd"
+          },
+          "io-format": null,
+          "inject": false,
+          "shm-size-mb": null
+        },
+        "auto-configure": {
+          "type": "docker",
+          "image": "compat",
+          "system": true,
+          "entrypoint": "compat",
+          "args": [
+            "dependency",
+            "auto-configure",
+            "lnd",
+            "bitcoind",
+            "/root/.lnd",
+            "/mnt/assets/bitcoind_config_rules.yaml"
+          ],
+          "mounts": {
+            "compat": "/mnt/assets"
+          },
+          "io-format": null,
+          "inject": false,
+          "shm-size-mb": null
+        }
+      }
+    },
+    "btc-rpc-proxy": {
+      "version": ">=0.3.2.1 <0.4.0",
+      "requirement": {
+        "type": "opt-out",
+        "how": "Can alternatively use the internal full archival bitcoind node or configure an external bitcoin node."
+      },
+      "description": "Used to fetch validated blocks.",
+      "critical": false,
+      "config": {
+        "check": {
+          "type": "docker",
+          "image": "compat",
+          "system": true,
+          "entrypoint": "compat",
+          "args": [
+            "dependency",
+            "check",
+            "lnd",
+            "btc-rpc-proxy",
+            "/root/.lnd",
+            "/mnt/assets/btc-rpc-proxy_config_rules.yaml"
+          ],
+          "mounts": {
+            "compat": "/mnt/assets",
+            "main": "/root/.lnd"
+          },
+          "io-format": "yaml",
+          "inject": false,
+          "shm-size-mb": null
+        },
+        "auto-configure": {
+          "type": "docker",
+          "image": "compat",
+          "system": true,
+          "entrypoint": "compat",
+          "args": [
+            "dependency",
+            "auto-configure",
+            "lnd",
+            "btc-rpc-proxy",
+            "/root/.lnd",
+            "/mnt/assets/btc-rpc-proxy_config_rules.yaml"
+          ],
+          "mounts": {
+            "compat": "/mnt/assets",
+            "main": "/root/.lnd"
+          },
+          "io-format": "yaml",
+          "inject": false,
+          "shm-size-mb": null
+        }
+      }
+    }
+  }
+}

src/Database/Queries.hs

@@ -229,8 +229,8 @@ getDependencyVersions pkgDepRecord = do
     pure $ entityVal <$> depVers
 
 
-fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord]
+fetchAllPkgVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord]
-fetchAllAppVersions appConnPool appId = do
+fetchAllPkgVersions appConnPool appId = do
     entityAppVersions <- runSqlPool (P.selectList [VersionRecordPkgId P.==. PkgRecordKey appId] []) appConnPool
     pure $ entityVal <$> entityAppVersions
 

src/Handler/Package/V0/Icon.hs

@@ -2,30 +2,50 @@
 
 module Handler.Package.V0.Icon where
 
-import Conduit (awaitForever, (.|))
+import Conduit (
+    awaitForever,
+    (.|),
+ )
 import Data.String.Interpolate.IsString (
     i,
  )
 import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
+    fetchCompatiblePkgVersions,
     getVersionSpecFromQuery,
     orThrow,
     versionPriorityFromQueryIsMin,
  )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getIcon)
+import Lib.PkgRepository (
+    getBestVersion,
+    getIcon,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
-import Startlude (show, ($))
+import Startlude (
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus)
+    pure,
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+ )
 
 
 getIconsR :: PkgId -> Handler TypedContent
 getIconsR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
     spec <- getVersionSpecFromQuery
     preferMin <- versionPriorityFromQueryIsMin
     version <-
-        getBestVersion pkg spec preferMin
+        (pure $ getBestVersion spec preferMin osCompatibleVersions)
             `orThrow` sendResponseStatus status400 (NotFoundE [i|Icon for #{pkg} satisfying #{spec}|])
     (ct, len, src) <- getIcon pkg version
     addHeader "Content-Length" (show len)

src/Handler/Package/V0/Instructions.hs

@@ -2,24 +2,53 @@
 
 module Handler.Package.V0.Instructions where
 
-import Conduit (awaitForever, (.|))
+import Conduit (
-import Data.String.Interpolate.IsString (i)
+    awaitForever,
+    (.|),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
-import Handler.Util (getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    fetchCompatiblePkgVersions,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getInstructions)
+import Lib.PkgRepository (
+    getBestVersion,
+    getInstructions,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
-import Startlude (show, ($))
+import Startlude (
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus, typePlain)
+    pure,
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+    typePlain,
+ )
 
 
 getInstructionsR :: PkgId -> Handler TypedContent
 getInstructionsR pkg = do
     spec <- getVersionSpecFromQuery
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
     preferMin <- versionPriorityFromQueryIsMin
     version <-
-        getBestVersion pkg spec preferMin
+        ( pure $
+                getBestVersion spec preferMin osCompatibleVersions
+            )
             `orThrow` sendResponseStatus status400 (NotFoundE [i|Instructions for #{pkg} satisfying #{spec}|])
     (len, src) <- getInstructions pkg version
     addHeader "Content-Length" (show len)

src/Handler/Package/V0/Latest.hs

@@ -1,19 +1,23 @@
 module Handler.Package.V0.Latest where
 
+import Conduit (concatMapC, mapC, runConduit, sinkList, (.|))
 import Data.Aeson (ToJSON (..), eitherDecode)
 import Data.ByteString.Lazy qualified as LBS
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
-import Data.List (lookup)
+import Data.List (lookup, sortOn)
-import Database.Queries (fetchLatestApp)
+import Data.List.NonEmpty.Extra qualified as NE
+import Data.Tuple.Extra (second)
+import Database.Queries (collateVersions, getPkgDataSource)
 import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
 import Lib.Error (S9Error (..))
 import Lib.Types.Core (PkgId)
-import Lib.Types.Emver (Version)
+import Lib.Types.Emver (Version, satisfies)
-import Model (Key (..), VersionRecord (..))
+import Model (VersionRecord (..))
 import Network.HTTP.Types (status400)
-import Startlude (Either (..), Generic, Maybe (..), Show, catMaybes, encodeUtf8, fst, pure, snd, traverse, ($), (.), (<$>))
+import Startlude (Bool (True), Down (Down), Either (..), Generic, Maybe (..), NonEmpty, Show, const, encodeUtf8, filter, flip, headMay, nonEmpty, pure, ($), (.), (<$>), (<&>))
-import Yesod (Entity (..), ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
+import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
 
 
 newtype VersionLatestRes = VersionLatestRes (HashMap PkgId (Maybe Version))
@@ -25,24 +29,37 @@ instance ToTypedContent VersionLatestRes where
     toTypedContent = toTypedContent . toJSON
 
 
--- TODO refactor with conduit
 getVersionLatestR :: Handler VersionLatestRes
 getVersionLatestR = do
     getParameters <- reqGetParams <$> getRequest
+    osPredicate' <-
+        getOsVersionQuery <&> \case
+            Nothing -> const True
+            Just v -> flip satisfies v
     case lookup "ids" getParameters of
         Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>")
         Just packages -> case eitherDecode $ LBS.fromStrict $ encodeUtf8 packages of
             Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages)
             Right p -> do
                 let packageList = (,Nothing) <$> p
-                found <- runDB $ traverse fetchLatestApp $ fst <$> packageList
+                let source = getPkgDataSource p
+                filteredPackages <-
+                    runDB $
+                        runConduit $
+                            source
+                                -- group conduit pipeline by pkg id
+                                .| collateVersions
+                                -- filter out versions of apps that are incompatible with the OS predicate
+                                .| mapC (second (filter (osPredicate' . versionRecordOsVersion)))
+                                -- prune empty version sets
+                                .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
+                                -- grab the latest matching version if it exists
+                                .| mapC (\(a, b) -> (a, (Just $ selectLatestVersion b)))
+                                .| sinkList
+                -- if the requested package does not have available versions, return it as a key with a null value
                 pure $
                     VersionLatestRes $
-                        HM.union
+                        HM.union (HM.fromList $ filteredPackages) (HM.fromList packageList)
-                            ( HM.fromList $
+    where
-                                ( \v ->
+        selectLatestVersion :: NonEmpty VersionRecord -> Version
-                                    (unPkgRecordKey . entityKey $ fst v, Just $ versionRecordNumber $ entityVal $ snd v)
+        selectLatestVersion vs = NE.head $ (versionRecordNumber <$>) $ NE.sortOn (Down . versionRecordNumber) $ vs
-                                )
-                                    <$> catMaybes found
-                            )
-                            $ HM.fromList packageList

src/Handler/Package/V0/License.hs

@@ -2,24 +2,51 @@
 
 module Handler.Package.V0.License where
 
-import Conduit (awaitForever, (.|))
+import Conduit (
-import Data.String.Interpolate.IsString (i)
+    awaitForever,
+    (.|),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
-import Handler.Util (getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    fetchCompatiblePkgVersions,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getLicense)
+import Lib.PkgRepository (
+    getBestVersion,
+    getLicense,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
-import Startlude (show, ($))
+import Startlude (
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus, typePlain)
+    pure,
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+    typePlain,
+ )
 
 
 getLicenseR :: PkgId -> Handler TypedContent
 getLicenseR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
     spec <- getVersionSpecFromQuery
     preferMin <- versionPriorityFromQueryIsMin
     version <-
-        getBestVersion pkg spec preferMin
+        (pure $ getBestVersion spec preferMin osCompatibleVersions)
             `orThrow` sendResponseStatus status400 (NotFoundE [i|License for #{pkg} satisfying #{spec}|])
     (len, src) <- getLicense pkg version
     addHeader "Content-Length" (show len)

src/Handler/Package/V0/Manifest.hs

@@ -2,26 +2,54 @@
 
 module Handler.Package.V0.Manifest where
 
-import Conduit (awaitForever, (.|))
+import Conduit (
-import Data.String.Interpolate.IsString (i)
+    awaitForever,
+    (.|),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
-import Handler.Util (addPackageHeader, getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    addPackageHeader,
+    fetchCompatiblePkgVersions,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getManifest)
+import Lib.PkgRepository (
+    getBestVersion,
+    getManifest,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status404)
-import Startlude (show, ($))
+import Startlude (
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus, typeJson)
+    pure,
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+    typeJson,
+ )
 
 
 getAppManifestR :: PkgId -> Handler TypedContent
 getAppManifestR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
     versionSpec <- getVersionSpecFromQuery
     preferMin <- versionPriorityFromQueryIsMin
     version <-
-        getBestVersion pkg versionSpec preferMin
+        (pure $ getBestVersion versionSpec preferMin osCompatibleVersions)
             `orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
     addPackageHeader pkg version
     (len, src) <- getManifest pkg version
     addHeader "Content-Length" (show len)
-    respondSource typeJson $ src .| awaitForever sendChunkBS
+    respondSource typeJson $ src .| awaitForever sendChunkBS

src/Handler/Package/V0/ReleaseNotes.hs

@@ -2,23 +2,45 @@
 
 module Handler.Package.V0.ReleaseNotes where
 
-import Data.Aeson (ToJSON (..), object, KeyValue((.=)))
+import Data.Aeson (
+    KeyValue ((.=)),
+    ToJSON (..),
+    object,
+ )
+import Data.Aeson.Key (fromText)
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
-import Database.Queries (fetchAllAppVersions)
+import Foundation (Handler)
-import Foundation (Handler, RegistryCtx (..))
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (fetchCompatiblePkgVersions)
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version)
 import Model (VersionRecord (..))
-import Startlude (Down (..), Eq, Show, Text, fst, pure, sortOn, ($), (&&&), (.), (<$>), show)
+import Startlude (
-import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), getYesod)
+    Down (..),
-import Data.Aeson.Key (fromText)
+    Eq,
+    Show,
+    Text,
+    fst,
+    pure,
+    show,
+    sortOn,
+    ($),
+    (&&&),
+    (.),
+    (<$>),
+ )
+import Yesod (
+    ToContent (..),
+    ToTypedContent (..),
+ )
 
 
 newtype ReleaseNotes = ReleaseNotes {unReleaseNotes :: HashMap Version Text}
     deriving (Eq, Show)
 instance ToJSON ReleaseNotes where
-    toJSON ReleaseNotes {..} = object [ version .= value | (key, value) <- HM.toList unReleaseNotes, let version = fromText $ show key]
+    toJSON ReleaseNotes{..} =
+        object [version .= value | (key, value) <- HM.toList unReleaseNotes, let version = fromText $ show key]
 instance ToContent ReleaseNotes where
     toContent = toContent . toJSON
 instance ToTypedContent ReleaseNotes where
@@ -27,9 +49,9 @@ instance ToTypedContent ReleaseNotes where
 
 getReleaseNotesR :: PkgId -> Handler ReleaseNotes
 getReleaseNotesR pkg = do
-    appConnPool <- appConnPool <$> getYesod
+    osVersion <- getOsVersionQuery
-    versionRecords <- runDB $ fetchAllAppVersions appConnPool pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
-    pure $ constructReleaseNotesApiRes versionRecords
+    pure $ constructReleaseNotesApiRes osCompatibleVersions
     where
         constructReleaseNotesApiRes :: [VersionRecord] -> ReleaseNotes
         constructReleaseNotesApiRes vers = do

src/Handler/Package/V0/S9PK.hs

@@ -4,30 +4,65 @@
 
 module Handler.Package.V0.S9PK where
 
-import Data.String.Interpolate.IsString (i)
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Data.Text qualified as T
-import Database.Queries (createMetric, fetchAppVersion)
+import Database.Queries (
+    createMetric,
+    fetchAppVersion,
+ )
 import Foundation (Handler)
 import GHC.Show (show)
-import Handler.Util (addPackageHeader, getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    addPackageHeader,
+    fetchCompatiblePkgVersions,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getPackage)
+import Lib.PkgRepository (
-import Lib.Types.Core (PkgId (..), S9PK)
+    getBestVersion,
+    getPackage,
+ )
+import Lib.Types.Core (
+    PkgId (..),
+    S9PK,
+ )
 import Lib.Types.Emver (Version (..))
 import Network.HTTP.Types (status404)
-import Startlude (Maybe (..), pure, void, ($), (.), (>>=))
+import Startlude (
+    Maybe (..),
+    pure,
+    void,
+    ($),
+    (.),
+    (>>=),
+ )
 import System.FilePath (takeBaseName)
-import Yesod (Content (..), TypedContent, YesodPersist (runDB), notFound, respond, sendResponseStatus, typeOctet)
+import Yesod (
+    Content (..),
+    TypedContent,
+    YesodPersist (runDB),
+    notFound,
+    respond,
+    sendResponseStatus,
+    typeOctet,
+ )
 import Yesod.Core (logError)
 
 
 getAppR :: S9PK -> Handler TypedContent
 getAppR file = do
     let pkg = PkgId . T.pack $ takeBaseName (show file)
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
     versionSpec <- getVersionSpecFromQuery
     preferMin <- versionPriorityFromQueryIsMin
     version <-
-        getBestVersion pkg versionSpec preferMin
+        (pure $ getBestVersion versionSpec preferMin osCompatibleVersions)
             `orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
     addPackageHeader pkg version
     void $ recordMetrics pkg version
@@ -42,8 +77,7 @@ recordMetrics :: PkgId -> Version -> Handler ()
 recordMetrics pkg appVersion = do
     existingVersion <- runDB $ fetchAppVersion pkg appVersion
     case existingVersion of
-        Nothing ->
+        Nothing -> do
-            do
+            $logError [i|#{pkg}@#{appVersion} not found in database|]
-                $logError [i|#{pkg}@#{appVersion} not found in database|]
+            notFound
-                notFound
+        Just _ -> runDB $ createMetric pkg appVersion
-        Just _ -> runDB $ createMetric pkg appVersion

src/Handler/Package/V0/Version.hs

@@ -2,10 +2,18 @@
 
 module Handler.Package.V0.Version where
 
-import Data.Aeson (ToJSON, object, (.=))
+import Data.Aeson (
-import Data.String.Interpolate.IsString (i)
+    ToJSON,
+    object,
+    (.=),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
+    fetchCompatiblePkgVersions,
     getVersionSpecFromQuery,
     orThrow,
     versionPriorityFromQueryIsMin,
@@ -15,9 +23,24 @@ import Lib.PkgRepository (getBestVersion)
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version (..))
 import Network.HTTP.Types (status404)
-import Startlude (Eq, Maybe, Show, (.), (<$>))
+import Startlude (
-import Yesod (ToContent (..), ToTypedContent, sendResponseStatus)
+    Eq,
-import Yesod.Core (ToJSON (..), ToTypedContent (..))
+    Maybe,
+    Show,
+    pure,
+    ($),
+    (.),
+    (<$>),
+ )
+import Yesod (
+    ToContent (..),
+    ToTypedContent,
+    sendResponseStatus,
+ )
+import Yesod.Core (
+    ToJSON (..),
+    ToTypedContent (..),
+ )
 
 
 newtype AppVersionRes = AppVersionRes
@@ -38,9 +61,11 @@ instance ToTypedContent (Maybe AppVersionRes) where
 
 getPkgVersionR :: PkgId -> Handler AppVersionRes
 getPkgVersionR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
     spec <- getVersionSpecFromQuery
     preferMin <- versionPriorityFromQueryIsMin
-    AppVersionRes <$> getBestVersion pkg spec preferMin
+    AppVersionRes <$> (pure $ getBestVersion spec preferMin osCompatibleVersions)
         `orThrow` sendResponseStatus
             status404
-            (NotFoundE [i|Version for #{pkg} satisfying #{spec}|])
+            (NotFoundE [i|Version for #{pkg} satisfying #{spec}|])

src/Handler/Util.hs

@@ -6,19 +6,32 @@ import Control.Monad.Reader.Has (
     Has,
     MonadReader,
  )
-import Data.Attoparsec.Text (Parser, parseOnly)
+import Data.Attoparsec.Text (
-import Data.String.Interpolate.IsString (i)
+    Parser,
+    parseOnly,
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Builder qualified as TB
+import Database.Queries (fetchAllPkgVersions)
 import Foundation
-import Lib.PkgRepository (PkgRepo, getHash)
+import Lib.PkgRepository (
+    PkgRepo,
+    getHash,
+ )
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (
     Version,
     VersionRange,
+    satisfies,
+ )
+import Model (
+    UserActivity (..),
+    VersionRecord (versionRecordOsVersion),
  )
-import Model (UserActivity (..))
 import Network.HTTP.Types (
     Status,
     status400,
@@ -31,7 +44,10 @@ import Startlude (
     Monoid (..),
     Semigroup ((<>)),
     Text,
+    const,
     decodeUtf8,
+    filter,
+    flip,
     fromMaybe,
     fst,
     getCurrentTime,
@@ -52,6 +68,7 @@ import Yesod (
     RenderRoute (..),
     TypedContent (..),
     YesodPersist (runDB),
+    getYesod,
     insertRecord,
     liftHandler,
     lookupGetParam,
@@ -106,8 +123,7 @@ queryParamAs k p =
     lookupGetParam k >>= \case
         Nothing -> pure Nothing
         Just x -> case parseOnly p x of
-            Left e ->
+            Left e -> sendResponseText status400 [i|Invalid Request! The query parameter '#{k}' failed to parse: #{e}|]
-                sendResponseText status400 [i|Invalid Request! The query parameter '#{k}' failed to parse: #{e}|]
             Right a -> pure (Just a)
 
 
@@ -118,3 +134,15 @@ tickleMAU = do
         Just sid -> do
             now <- liftIO getCurrentTime
             void $ liftHandler $ runDB $ insertRecord $ UserActivity now sid
+
+
+fetchCompatiblePkgVersions :: Maybe VersionRange -> PkgId -> Handler [VersionRecord]
+fetchCompatiblePkgVersions osVersion pkg = do
+    appConnPool <- appConnPool <$> getYesod
+    versionRecords <- fetchAllPkgVersions appConnPool pkg
+    pure $ filter (osPredicate osVersion . versionRecordOsVersion) versionRecords
+    where
+        osPredicate osV = do
+            case osV of
+                Nothing -> const True
+                Just v -> flip satisfies v

src/Lib/PkgRepository.hs

@@ -68,22 +68,24 @@ import Database.Persist.Sql (
 import Database.PostgreSQL.Simple (SqlError (sqlState))
 import Lib.Error (S9Error (NotFoundE))
 import Lib.External.AppMgr qualified as AppMgr
-import Lib.Types.Core (
+import Lib.Types.Core (PkgId (..))
-    PkgId (..),
- )
 import Lib.Types.Emver (
     Version,
     VersionRange,
     parseVersion,
     satisfies,
  )
-import Lib.Types.Manifest (PackageDependency (..), PackageManifest (..))
+import Lib.Types.Manifest (
+    PackageDependency (..),
+    PackageManifest (..),
+ )
 import Model (
     EntityField (EosHashHash, PkgRecordUpdatedAt),
     EosHash (EosHash),
     Key (PkgRecordKey),
     PkgDependency (PkgDependency),
     PkgRecord (PkgRecord),
+    VersionRecord (versionRecordNumber),
  )
 import Startlude (
     Bool (..),
@@ -208,17 +210,16 @@ getVersionsFor pkg = do
         else pure []
 
 
-getViableVersions :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> VersionRange -> m [Version]
+getViableVersions :: VersionRange -> [VersionRecord] -> [Version]
-getViableVersions pkg spec = filter (`satisfies` spec) <$> getVersionsFor pkg
+getViableVersions spec vrs = filter (`satisfies` spec) (versionRecordNumber <$> vrs)
 
 
 getBestVersion ::
-    (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) =>
-    PkgId ->
     VersionRange ->
     Bool ->
-    m (Maybe Version)
+    [VersionRecord] ->
-getBestVersion pkg spec preferMin = headMay . sortBy comparator <$> getViableVersions pkg spec
+    (Maybe Version)
+getBestVersion spec preferMin vrs = headMay $ sortBy comparator $ getViableVersions spec vrs
     where
         comparator = if preferMin then compare else compare `on` Down