Skip to content

Commit

Permalink
remove followRelay from Follow type
Browse files Browse the repository at this point in the history 
The followRelay field in the Follow type has been removed as it's redundant with
NIP-65 (RelayListMetadata). Instead of storing relay information with each follow,
we now rely on RelayListMetadata events to discover which relays to use for each
contact.

- Reduces complexity in follow list handling
- Removes duplicate relay information storage

event ID handling and post notifications

- Fix event ID serialization to avoid double quotes in QML
- Add missing notifications for post changes
- Store events locally before publishing
- Fix repost handling in MainContent.qml
  • Loading branch information
@prolic
prolic committed Jan 29, 2025
1 parent 1a91fd4 commit 35a130d
Show file tree
Hide file tree
Showing 5 changed files with 88 additions and 108 deletions.
4 changes: 3 additions & 1 deletion resources/qml/content/MainContent.ui.qml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,9 @@ Rectangle {

onMessageSubmitted: function(text) {
if (targetPost.postType == "repost") {
quoteRepost(targetPost.referencedEventId, text)
if (targetPost.referencedPosts.length > 0) {
quoteRepost(targetPost.referencedPosts[0].id, text)
}
} else {
quoteRepost(targetPost.id, text)
}
Expand Down
44 changes: 28 additions & 16 deletions src/Futr.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ import Control.Monad (forM, forM_, unless, void, when)
import Data.Aeson (ToJSON, pairs, toEncoding, (.=))
import Data.List (nub)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Maybe (catMaybes, listToMaybe)
import Data.Proxy (Proxy(..))
import Data.Set qualified as Set
import Data.Text (Text, isPrefixOf, pack, unpack)
Expand All @@ -28,17 +28,12 @@ import Effectful.FileSystem
)
import Effectful.State.Static.Shared (State, get, gets, modify, put)
import Effectful.TH
import Lmdb.Connection (closeEnvironment, withCursor)
import Lmdb.Connection qualified as Connection
import Lmdb.Map qualified as LMap
import Lmdb.Types (KeyValue(..))
import Lmdb.Connection (closeEnvironment)
import QtQuick
import GHC.Generics (Generic)
import Graphics.QML hiding (fireSignal, runEngineLoop)
import Graphics.QML qualified as QML
import Pipes.Prelude qualified as Pipes
import System.FilePath ((</>))
import Control.Concurrent.MVar (MVar, newMVar)

import Logging
import KeyMgmt (Account(..), AccountId(..), KeyMgmt, KeyMgmtState(..))
Expand All @@ -52,15 +47,15 @@ import Nostr.Publisher
import Nostr.RelayConnection (RelayConnection)
import Nostr.RelayPool
import Nostr.Subscription
import Nostr.Types ( Event(..), EventId, Profile(..), Relay(..), RelayURI, Tag(..)
import Nostr.Types ( Event(..), EventId, Relay(..), RelayURI, Tag(..)
, getUri, metadataFilter )
import Nostr.Util
import Presentation.KeyMgmtUI (KeyMgmtUI)
import Presentation.RelayMgmtUI (RelayMgmtUI)
import RelayMgmt (RelayMgmt)
import Store.Lmdb ( LmdbState(..), LmdbStore, initialLmdbState, initializeLmdbState
, getEvent, getFollows, putEvent )
import Types hiding (Comment, QuoteRepost)
import Types

-- | Signal key class for LoginStatusChanged.
data LoginStatusChanged deriving Typeable
Expand Down Expand Up @@ -138,6 +133,9 @@ runFutr = interpret $ \_ -> \case
Login obj input -> do
kst <- get @KeyMgmtState
case Map.lookup (AccountId input) (accountMap kst) of
Nothing -> do
logError $ "Account not found: " <> input
return ()
Just a -> do
logInfo $ "Starting login for account: " <> pack (show $ accountPubKeyXO a)
let pk = accountPubKeyXO a
Expand Down Expand Up @@ -191,7 +189,7 @@ runFutr = interpret $ \_ -> \case
Just userPK -> do
currentFollows <- getFollows userPK
unless (targetPK `elem` map pubkey currentFollows) $ do
let newFollow = Follow targetPK Nothing Nothing
let newFollow = Follow targetPK Nothing
newFollows = newFollow : currentFollows
sendFollowListEvent newFollows
notify $ emptyUpdates { followsChanged = True }
Expand Down Expand Up @@ -238,7 +236,10 @@ runFutr = interpret $ \_ -> \case
Nothing -> logError "Failed to create seal" >> return Nothing

let validGiftWraps = catMaybes giftWraps
forM_ validGiftWraps $ \gw -> publishGiftWrap gw senderPubKeyXO
forM_ validGiftWraps $ \gw -> do
putEvent $ EventWithRelays gw Set.empty
publishGiftWrap gw senderPubKeyXO
notify $ emptyUpdates { privateMessagesChanged = True }

(Nothing, _) -> logError "No key pair found"
(_, (Nothing, _)) -> logError "No current chat recipient"
Expand All @@ -249,7 +250,10 @@ runFutr = interpret $ \_ -> \case
let u = createShortTextNote input (keyPairToPubKeyXO kp) now
signed <- signEvent u kp
case signed of
Just s -> publishToOutbox s
Just s -> do
putEvent $ EventWithRelays s Set.empty
publishToOutbox s
notify $ emptyUpdates { postsChanged = True }
Nothing -> logError "Failed to sign short text note"

Logout obj -> do
Expand Down Expand Up @@ -306,8 +310,10 @@ runFutr = interpret $ \_ -> \case
let authorInboxUris = Set.fromList $ map getUri authorRelays
targetUris = eventRelayUris `Set.union` authorInboxUris `Set.union` relaySet

putEvent $ EventWithRelays s targetUris
forM_ (Set.toList targetUris) $ \relay ->
publishToRelay s relay
notify $ emptyUpdates { postsChanged = True }
Nothing -> return ()
Nothing -> logError "Failed to sign repost"

Expand All @@ -320,13 +326,14 @@ runFutr = interpret $ \_ -> \case
mEvent <- getEvent eid
case mEvent of
Nothing -> logError $ "Failed to fetch event " <> pack (show eid)
Just EventWithRelays{relays} | Set.null relays -> do
logError "Failed to fetch event: no relays"
Just EventWithRelays{event, relays} -> do
let q = createQuoteRepost event (Set.findMin relays) quote (keyPairToPubKeyXO kp) now
signed <- signEvent q kp
case signed of
Just s -> publishToOutbox s
Just s -> do
putEvent $ EventWithRelays s Set.empty
publishToOutbox s
notify $ emptyUpdates { postsChanged = True }
Nothing -> logError "Failed to sign quote repost"

Comment eid comment' -> do
Expand Down Expand Up @@ -357,8 +364,10 @@ runFutr = interpret $ \_ -> \case
let authorInboxUris = Set.fromList $ map getUri authorRelays
targetUris = eventRelayUris `Set.union` authorInboxUris `Set.union` relaySet

putEvent $ EventWithRelays s targetUris
forM_ (Set.toList targetUris) $ \relay ->
publishToRelay s relay
notify $ emptyUpdates { postsChanged = True }
Nothing -> return ()
Nothing -> logError "Failed to sign comment"

Expand All @@ -371,7 +380,10 @@ runFutr = interpret $ \_ -> \case
let deletion = createEventDeletion [eid] reason (keyPairToPubKeyXO kp) now
signed <- signEvent deletion kp
case signed of
Just s -> publishToOutbox s
Just s -> do
putEvent $ EventWithRelays s Set.empty
publishToOutbox s
notify $ emptyUpdates { postsChanged = True, privateMessagesChanged = True }
Nothing -> logError "Failed to sign event deletion"


Expand Down
98 changes: 44 additions & 54 deletions src/Store/Lmdb.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,41 +23,33 @@ module Store.Lmdb
) where

import Control.Concurrent.MVar (MVar, newMVar, withMVar)
import Control.Monad (forM_,void)
import Control.Monad (forM_)
import Data.Aeson (ToJSON, FromJSON, encode, decode, eitherDecode)
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.List (sort)
import Data.Maybe (mapMaybe)
import Data.Set qualified as Set
import Data.Text (pack)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.Encoding (encodeUtf8)
import Effectful
import Effectful.Exception (throwIO)
import Effectful.Dispatch.Dynamic
import Effectful.State.Static.Shared (State, get, modify, put)
import Effectful.State.Static.Shared qualified as State
import Effectful.FileSystem
import Effectful.TH (makeEffect)
import Lmdb.Codec qualified as Codec
import Lmdb.Connection
import Lmdb.Map qualified as Map
import Lmdb.Types
import Pipes.Prelude qualified as Pipes
import System.FilePath ((</>))
import Pipes ((>->))
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text.Encoding as TE
import GHC.Generics (Generic)
import qualified Data.Cache.LRU as LRU

import Logging
import Nostr.Event (validateEvent, unwrapGiftWrap, unwrapSeal)
import Nostr.Keys (PubKeyXO, keyPairToPubKeyXO)
import Nostr.Types ( Event(..), EventId(..), Kind(..), Profile, Relay(..), Tag(..)
import Nostr.Types ( Event(..), EventId(..), Kind(..), Profile, Tag(..)
, Rumor(..), rumorPubKey, rumorTags, rumorCreatedAt, emptyProfile )
import Nostr.Util
import Types (AppState(..), EventWithRelays(..), Follow(..))
import Types (EventWithRelays(..), Follow(..))


-- | Timeline types
Expand Down Expand Up @@ -104,96 +96,94 @@ makeEffect ''LmdbStore
runLmdbStore :: (Util :> es, IOE :> es, State LmdbState :> es, Logging :> es)
=> Eff (LmdbStore : es) a
-> Eff es a
runLmdbStore = interpret $ \env -> \case
runLmdbStore = interpret $ \_ -> \case
-- Event operations (main storage operation)
PutEvent ev -> do
LmdbState{..} <- get
-- Bind the current state to avoid shadowing
currentState <- get @LmdbState
kp <- getKeyPair
liftIO $ withMVar lmdbLock $ \_ -> withTransaction lmdbEnv $ \txn -> do
Map.repsert' txn eventDb (eventId $ event ev) ev
liftIO $ withMVar (lmdbLock currentState) $ \_ -> withTransaction (lmdbEnv currentState) $ \txn -> do
Map.repsert' txn (eventDb currentState) (eventId $ event ev) ev

case kind (event ev) of
GiftWrap -> do
mSealedEvent <- liftIO $ unwrapGiftWrap (event ev) kp
mSealedEvent <- unwrapGiftWrap (event ev) kp
case mSealedEvent of
Just sealedEvent | validateEvent sealedEvent ->
case kind sealedEvent of
Seal -> do
mDecryptedRumor <- liftIO $ unwrapSeal sealedEvent kp
mDecryptedRumor <- unwrapSeal sealedEvent kp
case mDecryptedRumor of
Just decryptedRumor | pubKey sealedEvent == rumorPubKey decryptedRumor -> do
let participants = if rumorPubKey decryptedRumor == keyPairToPubKeyXO kp
then sort $ getAllPTags (rumorTags decryptedRumor)
else filter (/= keyPairToPubKeyXO kp) $ rumorPubKey decryptedRumor : sort (getAllPTags (rumorTags decryptedRumor))
addTimelineEntryTx txn chatTimelineDb ev participants (rumorCreatedAt decryptedRumor)
Just decryptedRumor
| pubKey sealedEvent == rumorPubKey decryptedRumor -> do
let participants = if rumorPubKey decryptedRumor == keyPairToPubKeyXO kp
then sort $ getAllPTags (rumorTags decryptedRumor)
else filter (/= keyPairToPubKeyXO kp)
(rumorPubKey decryptedRumor : sort (getAllPTags (rumorTags decryptedRumor)))
addTimelineEntryTx txn (chatTimelineDb currentState) ev participants (rumorCreatedAt decryptedRumor)
_ -> pure ()
_ -> pure ()
_ -> pure ()

ShortTextNote ->
addTimelineEntryTx txn postTimelineDb ev [pubKey $ event ev] (createdAt $ event ev)
addTimelineEntryTx txn (postTimelineDb currentState) ev [pubKey $ event ev] (createdAt $ event ev)

Repost -> do
let etags = [t | t@(ETag _ _ _) <- tags (event ev)]
let mOriginalEvent = eitherDecode (fromStrict $ encodeUtf8 $ content $ event ev)
case (etags, mOriginalEvent) of
(ETag _ _ _:_, Right originalEvent) | validateEvent originalEvent -> do
Map.repsert' txn eventDb (eventId originalEvent) (EventWithRelays originalEvent Set.empty)
addTimelineEntryTx txn postTimelineDb ev [pubKey $ event ev] (createdAt $ event ev)
(ETag _ _ _ : _, Right originalEvent)
| validateEvent originalEvent -> do
Map.repsert' txn (eventDb currentState) (eventId originalEvent)
(EventWithRelays originalEvent Set.empty)
addTimelineEntryTx txn (postTimelineDb currentState) ev [pubKey $ event ev]
(createdAt $ event ev)
_ -> pure ()

EventDeletion -> do
let eventIdsToDelete = [eid | ETag eid _ _ <- tags (event ev)]
forM_ eventIdsToDelete $ \eid -> do
mEvent <- Map.lookup' (readonly txn) eventDb eid
mEvent <- Map.lookup' (readonly txn) (eventDb currentState) eid
case mEvent of
Just deletedEv -> do
let key = (pubKey $ event deletedEv, createdAt $ event deletedEv)
db = case kind (event deletedEv) of
ShortTextNote -> postTimelineDb
Repost -> postTimelineDb
_ -> chatTimelineDb
ShortTextNote -> (postTimelineDb currentState)
Repost -> (postTimelineDb currentState)
_ -> (chatTimelineDb currentState)
Map.delete' txn db key
Map.delete' txn eventDb eid
Map.delete' txn (eventDb currentState) eid
Nothing -> pure ()

Metadata ->
case eitherDecode (fromStrict $ encodeUtf8 $ content $ event ev) of
Right profile ->
Map.repsert' txn profileDb (pubKey $ event ev) (profile, createdAt $ event ev)
Map.repsert' txn (profileDb currentState) (pubKey $ event ev) (profile, createdAt $ event ev)
Left _ -> pure ()

FollowList -> do
let followList' = [Follow pk (fmap InboxRelay relay') petName' | PTag pk relay' petName' <- tags (event ev)]
let followList' = [Follow pk petName' | PTag pk _ petName' <- tags (event ev)]
authorPk = pubKey $ event ev
Map.repsert' txn followsDb authorPk followList'
Map.repsert' txn (followsDb currentState) authorPk followList'

_ -> pure ()

-- Update caches after transaction
LmdbState{..} <- get @LmdbState
let newEventCache = LRU.insert (eventId $ event ev) ev eventCache
let newEventCache = LRU.insert (eventId $ event ev) ev (eventCache currentState)
newProfileCache = case kind (event ev) of
Metadata -> case eitherDecode (fromStrict $ encodeUtf8 $ content $ event ev) of
Right profile -> LRU.insert (pubKey $ event ev) (profile, createdAt $ event ev) profileCache
Left _ -> profileCache
_ -> profileCache
Metadata -> case eitherDecode (fromStrict $ encodeUtf8 $ content (event ev)) of
Right profile -> LRU.insert (pubKey $ event ev) (profile, createdAt $ event ev) (profileCache currentState)
Left _ -> profileCache currentState
_ -> profileCache currentState
newFollowsCache = case kind (event ev) of
FollowList -> let followList' = [Follow pk (fmap InboxRelay relay') petName' | PTag pk relay' petName' <- tags (event ev)]
in LRU.insert (pubKey $ event ev) followList' followsCache
_ -> followsCache
put @LmdbState $ LmdbState
{ lmdbLock = lmdbLock
, lmdbEnv = lmdbEnv
, eventDb = eventDb
, profileDb = profileDb
, postTimelineDb = postTimelineDb
, chatTimelineDb = chatTimelineDb
, followsDb = followsDb
, eventCache = newEventCache
FollowList -> let followList' = [Follow pk petName' | PTag pk _ petName' <- tags (event ev)]
in LRU.insert (pubKey $ event ev) followList' (followsCache currentState)
_ -> followsCache currentState

put @LmdbState currentState
{ eventCache = newEventCache
, profileCache = newProfileCache
, followsCache = newFollowsCache
, timelineCache = timelineCache
}

GetEvent eid -> do
Expand Down
19 changes: 2 additions & 17 deletions src/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,17 +4,15 @@

module Types where

import Control.Concurrent.MVar (MVar)
import Data.Aeson (FromJSON, ToJSON, Value(..), toJSON, parseJSON, (.:), (.=), withObject, object)
import Data.Aeson (FromJSON, ToJSON, toJSON, parseJSON, (.:), (.=), withObject, object)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Text (Text)
import Effectful.Concurrent.STM (TChan, TQueue)
import Lmdb.Types (Database, Environment, Mode(..))
import GHC.Generics (Generic)
import Nostr.Keys (KeyPair, PubKeyXO)
import Nostr.Types (Event, EventId, Filter, Profile, Relay(..), RelayURI, Request, SubscriptionId)
import Nostr.Types (Event, EventId, Filter, Relay(..), RelayURI, Request, SubscriptionId)


-- | Status of a publish operation
Expand Down Expand Up @@ -129,17 +127,13 @@ data AppState = AppState
-- | Follow.
data Follow = Follow
{ pubkey :: PubKeyXO
, followRelay :: Maybe Relay
, petName :: Maybe Text
} deriving (Eq, Show, Generic)

-- | ToJSON instance for Follow
instance ToJSON Follow where
toJSON Follow{..} = object
[ "pubkey" .= pubkey
, "followRelay" .= (case followRelay of
Just (InboxRelay uri) -> object ["contents" .= uri, "tag" .= ("InboxRelay" :: Text)]
Nothing -> Null)
, "petName" .= petName
]

Expand All @@ -148,16 +142,7 @@ instance ToJSON Follow where
instance FromJSON Follow where
parseJSON = withObject "Follow" $ \v -> Follow
<$> v .: "pubkey"
<*> (v .: "followRelay" >>= parseRelay)
<*> v .: "petName"
where
parseRelay Null = pure Nothing
parseRelay (Object o) = do
tag <- o .: "tag"
if tag == ("InboxRelay" :: Text)
then Just . InboxRelay <$> o .: "contents"
else fail $ "Unknown relay tag: " ++ show tag
parseRelay _ = fail "Invalid relay format"


-- | Initial application state.
Expand Down
Loading

0 comments on commit 35a130d

Please sign in to comment.