remove followRelay from Follow type

resources/qml/content/MainContent.ui.qml

@@ -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)
             }

src/Futr.hs

@@ -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)
@@ -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(..))
@@ -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
@@ -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
@@ -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 }
@@ -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"
@@ -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
@@ -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"
 
@@ -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
@@ -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"
 
@@ -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"
 
 

src/Store/Lmdb.hs

@@ -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
@@ -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

src/Types.hs

@@ -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
@@ -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
         ]
 
@@ -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.