Merge pull request 'Merge github/cg/purify-token-decryption (which ca…

…rries a few other changes)' (#18) from cg/purify-token-decryption into master

Reviewed-on: https://code.obsidian.systems/rhyolite/rhyolite/pulls/18

.gitignore

@@ -7,3 +7,4 @@ result-*
 .attr-cache
 tags
 TAGS
+beam/task/backend/psql-test*

ChangeLog.md

@@ -10,6 +10,13 @@ This project's release branch is `master`. This log is written from the perspect
 * Update to vessel-0.3
 * Support ghc-8.10
 * Add Data.Vessel.Void
+* Breaking: handleAuthMapQuery and handlePersonalAuthMapQuery now take pure functions for decrypting user
+  tokens. This is fine in practice because it should almost always be readSignedWithKey from signed-data,
+  partially applied to a CSK. We had a major performance issue when someone stuck a database query inside
+  the function, and it ran in a loop for every connected user on every database notification, so we want
+  to defend against that sort of thing happening. There may still be legitimate reasons to do other IO
+  inside such a thing (e.g. if a different encryption mechanism were used), but if that's needed, we'll
+  reconsider the API further.
 
 ## 2023-01-26
 * Breaking: Rhyolite.Frontend.Cookie now always Base64 encodes cookies

beam/db/rhyolite-beam-db.cabal

@@ -10,7 +10,6 @@ author:             Obsidian Systems LLC
 maintainer:         [email protected]
 copyright:          2021 Obsidian Systems LLC
 category:           Web
-extra-source-files: README.md
 
 library
   exposed-modules:

beam/orphans/rhyolite-beam-orphans.cabal

@@ -10,7 +10,6 @@ author:             Obsidian Systems LLC
 maintainer:         [email protected]
 copyright:          2021 Obsidian Systems LLC
 category:           Web
-extra-source-files: README.md
 
 library
   exposed-modules:

beam/task/backend/rhyolite-beam-task-worker-backend.cabal

@@ -10,7 +10,6 @@ author:             Obsidian Systems LLC
 maintainer:         [email protected]
 copyright:          2021 Obsidian Systems LLC
 category:           Web
-extra-source-files: README.md
 
 library
   exposed-modules:

beam/task/types/rhyolite-beam-task-worker-types.cabal

@@ -10,7 +10,6 @@ author:             Obsidian Systems LLC
 maintainer:         [email protected]
 copyright:          2021 Obsidian Systems LLC
 category:           Web
-extra-source-files: README.md
 
 library
   exposed-modules:

common/Rhyolite/Vessel/AuthMapV.hs

@@ -35,7 +35,6 @@ import Data.Vessel
 import Data.Vessel.SubVessel
 import Data.Vessel.Vessel
 import Data.Vessel.ViewMorphism
-import Data.Witherable
 import GHC.Generics
 import Reflex.Query.Class
 
@@ -166,8 +165,10 @@ instance (View v, Ord token) => Keyed
 handleAuthMapQuery
   :: forall m v token user f g.
      (Monad m, Ord token, View v, Applicative g)
-  => (token -> m (Maybe user))
-  -- ^ How to figure out the identity corresponding to a token
+  => (token -> Maybe user)
+  -- ^ How to figure out the identity corresponding to a token. Note: this is pure because it absolutely must be cheap, and we don't want people
+  -- attempting to put a database query inside it, which would result in terrible performance failures. Fast IO would be permissible, but generally
+  -- decrypting a token with a known CSK can be done with a pure function.
   -> (forall proxy. v proxy -> m (v g))
   -- ^ Handle the aggregate query for all identities
   -> AuthMapV token v f
@@ -176,7 +177,7 @@ handleAuthMapQuery
 handleAuthMapQuery readToken handler (AuthMapV vt) = do
   let unfilteredVt = getSubVessel vt
       unvalidatedTokens = MMap.keys unfilteredVt
-  validTokens <- Set.fromList <$> witherM (\t -> (t <$) <$> readToken t) unvalidatedTokens
+      validTokens = Set.fromList (filter (isJust . readToken) unvalidatedTokens)
   let filteredVt = MMap.intersectionWith const unfilteredVt (MMap.fromSet (\_ -> ()) validTokens)
       invalidTokens = MMap.fromSet (\_ -> failureErrorV ()) $
         Set.difference (Set.fromList unvalidatedTokens) validTokens
@@ -209,8 +210,9 @@ type instance ViewQueryResult (TaggedQuery w a) = (w, a)
 handlePersonalAuthMapQuery
   :: forall m token v user p q.
      (Monad m, Ord token, View v, Ord user, Applicative q)
-  => (token -> m (Maybe user))
-  -- ^ How to figure out the identity corresponding to a token
+  => (token -> Maybe user)
+  -- ^ How to figure out the identity corresponding to a token. Note: this is pure because it absolutely must be cheap. See the corresponding comment on
+  -- 'handleAuthMapQuery'.
   -> (forall f g.
      ViewQueryResult f ~ g
      => (forall x. x -> f x -> g x)
@@ -224,8 +226,8 @@ handlePersonalAuthMapQuery
 handlePersonalAuthMapQuery readToken handler vt = do
   let unauthorisedAuthMapSingleton token = Map.singleton token $ failureErrorV ()
 
-      authoriseAction t v = do
-        lift (readToken t) >>= \case
+      authoriseAction t v =
+        case readToken t of
           Nothing -> do
             tell $ unauthorisedAuthMapSingleton t
             pure Nothing

common/Rhyolite/Vessel/AuthenticatedV.hs

@@ -163,7 +163,7 @@ handleAuthenticatedQuery' public private personal (AuthenticatedV q) = fmap Auth
 -- handler bakes this assumption in.
 handleAuthenticatedQuery
   :: (Monad m, Ord token, View public, View private, View personal, Ord user, Applicative q)
-  => (token -> m (Maybe user))
+  => (token -> Maybe user)
   -> (forall p'. public p' -> m (public q))
   -> (forall p'. private p' -> m (private q))
   -- ^ The result of private queries is only available to authenticated identities

signed-data/signed-data-clientsession/signed-data-clientsession.cabal

@@ -13,7 +13,6 @@ author:             Obsidian Systems LLC
 maintainer:         [email protected]
 copyright:          2021 Obsidian Systems LLC
 category:           Data
-extra-source-files: CHANGELOG.md
 
 library
   exposed-modules:  Data.Signed.ClientSession