Skip to content

Commit

Permalink
Merge branch 'develop' into develop-to-iv
Browse files Browse the repository at this point in the history
  • Loading branch information
Ericson2314 committed Oct 2, 2024
2 parents 31f6a63 + 8a10a67 commit 1d449d2
Show file tree
Hide file tree
Showing 25 changed files with 379 additions and 615 deletions.
12 changes: 11 additions & 1 deletion ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
15 changes: 8 additions & 7 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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";
Expand All @@ -74,8 +74,9 @@ with this Rhyolite thunk:
"owner": "obsidiansystems",
"repo": "rhyolite",
"branch": "master",
"rev": "06b9851a101408a86a4ec0b7df5b2f71bc532ab0",
"sha256": "18adbc1nnj94qhggpcxmpd5i1rz0zx93cpphl09mw4c7s65rzah7"
"private": false,
"rev": "9f13d8d8a2233aae54e15c39acf68181893b859a",
"sha256": "1vhbw9bdqpfddavfjfdrq6kk5wwsd8hbgb8pnna9i2db3x3cmzvy"
}
```
Expand All @@ -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"
```
2 changes: 2 additions & 0 deletions account/backend/rhyolite-account-backend.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
202 changes: 3 additions & 199 deletions account/backend/src/Rhyolite/Backend/Account.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,8 @@ Description:
{-# Language OverloadedStrings #-}
module Rhyolite.Backend.Account
( createAccount
, login
, ensureAccountExists
, ensureAccountExistsNoNotify
, login
, setAccountPassword
, setAccountPasswordHash
, makePasswordHash
Expand All @@ -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)
Loading

0 comments on commit 1d449d2

Please sign in to comment.