Merge branch 'develop' into develop-to-iv

ChangeLog.md

@@ -3,13 +3,23 @@
 This project's release branch is `master`. This log is written from the perspective of the release branch: when changes hit `master`, they are considered released, and the date should reflect that release.
 
 ## Unreleased
-(Creating a separate list, because the previous changes probably deserve their own release)
 
+* Open source some "incremental view" infra (name is provision).
+
+## v1.1.0.0 2024-05-24
+
+* Breaking: Remove Reflex.Dom.Modal.Base and Reflex.Dom.Modal.Class. The `<dialog>` element is now broadly supported by browsers and provides a simpler solution to the problem of opening modals that is also more accessible. See the [documentation](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/dialog), and, in particular, this [example](https://developer.mozilla.org/en-US/docs/Web/API/HTMLDialogElement#opening_a_modal_dialog), which uses `showModal` and describes how to style the modal backdrop.
+* Breaking: [Make authentication easier to use and fix some things about ErrorV #213](https://github.com/obsidiansystems/rhyolite/pull/213)
+* Make it possible to use Rhyolite.Backend.Account without notifications. See Rhyolite.Backend.Account.Db for versions of createAccount and ensureAccountExists that don't send notifications.
+* Update to obelisk v1.3.0.0
+
+## v1.0.0.0 2023-08-03
 * Breaking: Drop groundhog support
 * Breaking: Use Commutative from commutative-semigroups instead of Additive from patch
 * Update to vessel-0.3
 * Support ghc-8.10
 * Add Data.Vessel.Void
+* Move .obelisk/impl to dep/obelisk
 * 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

README.md

@@ -28,28 +28,28 @@ Rhyolite provides:
    { system ? builtins.currentSystem, obelisk ? import ./.obelisk/impl {
      inherit system;
      iosSdkVersion = "13.2";
- 
+
      # You must accept the Android Software Development Kit License Agreement at
      # https://developer.android.com/studio/terms in order to build Android apps.
      # Uncomment and set this to `true` to indicate your acceptance:
      # config.android_sdk.accept_license = false;
- 
+
      # In order to use Let's Encrypt for HTTPS deployments you must accept
      # their terms of service at https://letsencrypt.org/repository/.
      # Uncomment and set this to `true` to indicate your acceptance:
      # terms.security.acme.acceptTerms = false;
    } }:
    with obelisk;
    project ./. ({ pkgs, hackGet, ... }@args: {
- 
+
      overrides = pkgs.lib.composeExtensions
        (pkgs.callPackage (hackGet ./dep/rhyolite) args).haskellOverrides
        (self: super:
          with pkgs.haskell.lib;
          {
            # Your custom overrides go here.
          });
- 
+
      android.applicationId = "systems.obsidian.obelisk.examples.minimal";
      android.displayName = "Obelisk Minimal Example";
      ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";
@@ -74,8 +74,9 @@ with this Rhyolite thunk:
   "owner": "obsidiansystems",
   "repo": "rhyolite",
   "branch": "master",
-  "rev": "06b9851a101408a86a4ec0b7df5b2f71bc532ab0",
-  "sha256": "18adbc1nnj94qhggpcxmpd5i1rz0zx93cpphl09mw4c7s65rzah7"
+  "private": false,
+  "rev": "9f13d8d8a2233aae54e15c39acf68181893b859a",
+  "sha256": "1vhbw9bdqpfddavfjfdrq6kk5wwsd8hbgb8pnna9i2db3x3cmzvy"
 }
 ```
 
@@ -96,5 +97,5 @@ You can use `nix-shell` to enter a shell from which you can build any of the sub
 Because of the inter-related nature of these packages, `rhyolite-test-suite` tests that all of them can be built against one another. To test, run:
 
 ```bash
-nix-shell --run cabal build test
+nix-shell --run "cabal build test"
 ```

account/backend/rhyolite-account-backend.cabal

@@ -13,6 +13,8 @@ category:           Web
 
 library
     exposed-modules:  Rhyolite.Backend.Account
+                      Rhyolite.Backend.Account.Db
+                      Rhyolite.Backend.Account.Notify
     build-depends:    base
                     , aeson
                     , beam-core

account/backend/src/Rhyolite/Backend/Account.hs

@@ -8,9 +8,8 @@ Description:
 {-# Language OverloadedStrings #-}
 module Rhyolite.Backend.Account
   ( createAccount
-  , login
   , ensureAccountExists
-  , ensureAccountExistsNoNotify
+  , login
   , setAccountPassword
   , setAccountPasswordHash
   , makePasswordHash
@@ -20,200 +19,5 @@ module Rhyolite.Backend.Account
   , resetPasswordHash
   ) where
 
-import Control.Monad (guard)
-import Control.Monad.Trans.Maybe
-import Crypto.PasswordStore
-import Data.Aeson
-import Data.ByteString
-import Data.Constraint.Extras
-import Data.Constraint.Forall
-import Data.Functor.Identity
-import Data.Maybe
-import Data.Text
-import Data.Text.Encoding (encodeUtf8)
-import qualified Data.Text.Encoding as T
-import Data.Time
-import Database.Beam
-import Database.Beam.Backend.SQL.BeamExtensions
-import Database.Beam.Postgres
-import Data.Signed
-import Data.Signed.ClientSession
-import Database.Beam.Postgres.Full hiding (insert)
-import Database.Beam.Postgres.Syntax
-import Database.PostgreSQL.Simple.Beam ()
-import Rhyolite.Account
-import Rhyolite.DB.Beam (current_timestamp_)
-import Rhyolite.DB.NotifyListen
-import Rhyolite.DB.NotifyListen.Beam
-import Web.ClientSession as CS
-
--- | Creates a new account and emits a db notification about it
-createAccount
-  :: (Has' ToJSON notice Identity, ForallF ToJSON notice)
-  => DatabaseEntity Postgres db (TableEntity Account)
-  -> notice (PrimaryKey Account Identity)
-  -> Text
-  -> Text
-  -> Pg (Either Text (PrimaryKey Account Identity))
-createAccount accountTable noticeWrapper email pass = do
-  hash <- makePasswordHash pass
-  accountIds <- runPgInsertReturningList $ flip returning _account_id $ insert accountTable $ insertExpressions
-    [ Account
-        { _account_id = default_
-        , _account_email = lower_ (val_ email)
-        , _account_password = val_ (Just hash)
-        , _account_passwordResetNonce = just_ current_timestamp_
-        }
-    ]
-  case accountIds of
-    [accountId] -> do
-      notify NotificationType_Insert noticeWrapper (AccountId accountId)
-      pure $ Right $ AccountId accountId
-    _ -> pure $ Left "Failed to create account"
-
--- | Attempts to login a user given some credentials.
-login
-  :: Database Postgres db
-  => DatabaseEntity Postgres db (TableEntity Account)
-  -> Text
-  -> Text
-  -> Pg (Maybe (PrimaryKey Account Identity))
-login accountTable email pass = runMaybeT $ do
-  (aid, mPwHash) <- MaybeT $ fmap listToMaybe $ runSelectReturningList $ select $ do
-    acc <- all_ accountTable
-    guard_ $ lower_ (_account_email acc) ==. lower_ (val_ email)
-    pure (_account_id acc, _account_password acc)
-  pwHash <- MaybeT $ pure mPwHash
-  guard $ verifyPasswordWith pbkdf2 (2^) (T.encodeUtf8 pass) pwHash
-  pure (AccountId aid)
-
-ensureAccountExistsNoNotify
-  :: (Database Postgres db)
-  => DatabaseEntity Postgres db (TableEntity Account)
-  -> Text
-  -> Pg (Bool, PrimaryKey Account Identity)
-ensureAccountExistsNoNotify accountTable email = do
-  existingAccountId <- runSelectReturningOne $ select $ fmap primaryKey $ filter_ (\x ->
-    lower_ (_account_email x) ==. lower_ (val_ email)) $ all_ accountTable
-  case existingAccountId of
-    Just existing -> return (False, existing)
-    Nothing -> do
-      results <- runInsertReturningList $ insert accountTable $ insertExpressions
-        [ Account
-            { _account_id = default_
-            , _account_email = lower_ (val_ email)
-            , _account_password = nothing_
-            , _account_passwordResetNonce = nothing_
-            }
-        ]
-      case results of
-        [acc] -> do
-          let aid = primaryKey acc
-          -- notify NotificationType_Insert (notification accountTable) aid
-          pure (True, aid)
-        _ -> error "ensureAccountExists: Creating account failed"
-
-ensureAccountExists
-  :: (Database Postgres db, HasNotification n Account, Has' ToJSON n Identity, ForallF ToJSON n)
-  => DatabaseEntity Postgres db (TableEntity Account)
-  -> Text
-  -> Pg (Bool, PrimaryKey Account Identity)
-ensureAccountExists accountTable email = do
-  existingAccountId <- runSelectReturningOne $ select $ fmap primaryKey $ filter_ (\x ->
-    lower_ (_account_email x) ==. lower_ (val_ email)) $ all_ accountTable
-  case existingAccountId of
-    Just existing -> return (False, existing)
-    Nothing -> do
-      results <- runInsertReturningList $ insert accountTable $ insertExpressions
-        [ Account
-            { _account_id = default_
-            , _account_email = lower_ (val_ email)
-            , _account_password = nothing_
-            , _account_passwordResetNonce = nothing_
-            }
-        ]
-      case results of
-        [acc] -> do
-          let aid = primaryKey acc
-          notify NotificationType_Insert (notification accountTable) aid
-          pure (True, aid)
-        _ -> error "ensureAccountExists: Creating account failed"
-
-setAccountPassword
-  :: DatabaseEntity Postgres db (TableEntity Account)
-  -> PrimaryKey Account Identity
-  -> Text
-  -> Pg ()
-setAccountPassword tbl aid password = do
-  pw <- liftIO $ makePasswordHash password
-  setAccountPasswordHash tbl aid pw
-
-setAccountPasswordHash
-  :: DatabaseEntity Postgres db (TableEntity Account)
-  -> PrimaryKey Account Identity
-  -> ByteString
-  -> Pg ()
-setAccountPasswordHash accountTable aid hash = runUpdate $ update accountTable
-  (\x -> mconcat
-    [ _account_password x <-. val_ (Just hash)
-    , _account_passwordResetNonce x <-. nothing_
-    ]
-  )
-  (\x -> primaryKey x ==. val_ aid)
-
-makePasswordHash
-  :: MonadIO m
-  => Text
-  -> m ByteString
-makePasswordHash pw = do
-  salt <- liftIO genSaltIO
-  return $ makePasswordSaltWith pbkdf2 (2^) (encodeUtf8 pw) salt 14
-
-resetPassword
-  :: (Database Postgres db)
-  => DatabaseEntity Postgres db (TableEntity Account)
-  -> PrimaryKey Account Identity
-  -> UTCTime
-  -> Text
-  -> Pg (Maybe (PrimaryKey Account Identity))
-resetPassword tbl aid t pw = do
-  hash <- makePasswordHash pw
-  resetPasswordHash tbl aid t hash
-
-resetPasswordHash
-  :: (Database Postgres db)
-  => DatabaseEntity Postgres db (TableEntity Account)
-  -> PrimaryKey Account Identity
-  -> UTCTime
-  -> ByteString
-  -> Pg (Maybe (PrimaryKey Account Identity))
-resetPasswordHash accountTable aid nonce pwhash = do
-  macc <- runSelectReturningOne $ lookup_ accountTable aid
-  case macc of
-    Nothing -> return Nothing
-    Just a -> if _account_passwordResetNonce a == Just nonce
-      then do
-        setAccountPasswordHash accountTable aid pwhash
-        return $ Just aid
-      else fail "nonce mismatch"
-
-passwordResetToken
-  :: MonadIO m
-  => CS.Key
-  -> PrimaryKey Account Identity
-  -> UTCTime
-  -> m (Signed PasswordResetToken)
-passwordResetToken csk aid nonce = do
-  liftIO $ signWithKey csk $ PasswordResetToken (aid, nonce)
-
-newNonce
-  :: DatabaseEntity Postgres db (TableEntity Account)
-  -> PrimaryKey Account Identity
-  -> Pg (Maybe UTCTime)
-newNonce accountTable aid = do
-  a <- runUpdateReturningList $ update accountTable
-    (\x -> _account_passwordResetNonce x <-. just_ current_timestamp_)
-    (\x -> primaryKey x ==. val_ aid)
-  pure $ case a of
-    [acc] -> _account_passwordResetNonce acc
-    _ -> Nothing
+import Rhyolite.Backend.Account.Db hiding (createAccount, ensureAccountExists)
+import Rhyolite.Backend.Account.Notify (createAccount, ensureAccountExists)