persist profile & relay updates

Add UpdateProfile and UpdateRelays effects to KeyMgmt to save changes to disk.
Rename Account fields to avoid naming conflicts with Profile type.

src/Futr.hs

@@ -257,8 +257,8 @@ parseNprofileOrNpub input =
 -- | Login with an account.
 loginWithAccount :: FutrEff es => ObjRef () -> PKeyMgmt.Account -> Eff es Bool
 loginWithAccount obj a = do
-  modify @AppState $ \s -> s { keyPair = Just (secKeyToKeyPair $ PKeyMgmt.nsec a) }
-  let (rs, _) = PKeyMgmt.relays a
+  modify @AppState $ \s -> s { keyPair = Just (secKeyToKeyPair $ PKeyMgmt.accountNsec a) }
+  let (rs, _) = PKeyMgmt.accountRelays a
   -- add general relays
   --modify @AppState $ \st -> st { generalRelays = (rs, t) }
   -- add all relays to the relay pool

src/Main.hs

@@ -50,16 +50,16 @@ main = do
         . runConcurrent
         -- nostr related
         . runNostr
+        . KeyMgmt.runKeyMgmt
         . runWebSocket 3 -- max 3 retries
         . runGiftWrap
         . runPublishManager
         . runSubscription
         . runRelayPool
         . runOutboxModel
+        . RelayMgmt.runRelayMgmt
         -- presentation related
-        . KeyMgmt.runKeyMgmt
         . KeyMgmt.runKeyMgmtUI
-        . RelayMgmt.runRelayMgmt
         . RelayMgmt.runRelayMgmtUI
         -- run futr
         . Futr.runFutr

src/Nostr/OutboxModel.hs

@@ -15,10 +15,12 @@ import Effectful.Dispatch.Dynamic
 import Effectful.State.Static.Shared
 import Effectful.TH
 
+import Nostr.Bech32 (pubKeyXOToBech32)
 import Nostr.Keys (PubKeyXO, keyPairToPubKeyXO)
 import Nostr.RelayPool qualified as RP
 import Nostr.Types (Kind(..), Event(..), Relay(..), RelayURI, Response(..), eventFilter, getUri)
 import Nostr.Util
+import Presentation.KeyMgmt (KeyMgmt, updateRelays, AccountId(..))
 import Types (AppState(..), OutboxModelState(..), PublishStatus(..))
 
 
@@ -50,6 +52,7 @@ type OutboxModelEff es =
     , State AppState :> es
     , Util :> es
     , Concurrent :> es
+    , KeyMgmt :> es
     )
 
 runOutboxModel :: OutboxModelEff es => Eff (OutboxModel : es) a -> Eff es a
@@ -65,13 +68,17 @@ runOutboxModel = interpret $ \_ -> \case
                         (True, False) -> InboxRelay relay'
                         (False, True) -> OutboxRelay relay'
                         (False, False) -> error "Unreachable due to guard above"
+                let newRelays = ([relay''], timestamp)
                 modify $ \st -> st 
-                    { generalRelays = Map.insertWith keepMostRecent pk ([relay''], timestamp) (generalRelays st) }
+                    { generalRelays = Map.insertWith keepMostRecent pk newRelays (generalRelays st) }
+                updateRelays (AccountId $ pubKeyXOToBech32 pk) newRelays
                 return True
 
     RemoveGeneralRelay pk r -> do
         modify $ \st -> st 
             { generalRelays = Map.adjust (removeAllRelayTypes r) pk (generalRelays st) }
+        updatedRelays <- gets (Map.findWithDefault ([], 0) pk . generalRelays)
+        updateRelays (AccountId $ pubKeyXOToBech32 pk) updatedRelays
 
     AddDMRelay pk r -> do
         timestamp <- getCurrentTime

src/Nostr/Subscription.hs

@@ -30,6 +30,7 @@ import Nostr.Types (Event(..), EventId(..), Kind(..), Relay(..), RelayURI, Reque
 import Nostr.Util
 import Types ( AppState(..), Follow(..), FollowModel(..), UIReferences(..)
              , OutboxModelState(..), PublishStatus(..), RelayData(..), RelayPoolState(..))
+import Presentation.KeyMgmt (AccountId(..), KeyMgmt, updateProfile)
 
 
 -- Subscription Effects
@@ -47,6 +48,7 @@ type SubscriptionEff es = ( GiftWrap :> es
                           , State RelayPoolState :> es
                           , State OutboxModelState :> es
                           , State AppState :> es
+                          , KeyMgmt :> es
                           , Logging :> es
                           , Nostr :> es
                           , Util :> es
@@ -248,11 +250,19 @@ handleEvent event' _ = do
                 Metadata -> do
                     case eitherDecode (BSL.fromStrict $ TE.encodeUtf8 $ content event') of
                         Right profile -> do
-                            modify $ \st -> st { profiles = Map.insertWith (\new old -> if snd new > snd old then new else old)
+                            st <- get @AppState
+                            let isOwnProfile = maybe False (\kp -> pubKey event' == keyPairToPubKeyXO kp) (keyPair st)
+
+                            modify $ \s -> s { profiles = Map.insertWith (\new old -> if snd new > snd old then new else old)
                                                 (pubKey event')
                                                 (profile, createdAt event')
-                                                (profiles st)
+                                                (profiles s)
                                             }
+
+                            when isOwnProfile $ do
+                                let aid = AccountId $ pubKeyXOToBech32 (pubKey event')
+                                updateProfile aid profile
+
                             pure $ emptyUpdates { profilesChanged = True }
                         Left err -> do
                             logWarning $ "Failed to decode metadata: " <> pack err

src/Presentation/KeyMgmt.hs

@@ -7,7 +7,7 @@
 module Presentation.KeyMgmt where
 
 import Control.Monad (filterM)
-import Data.Aeson (FromJSON (..), eitherDecode)
+import Data.Aeson (FromJSON (..), eitherDecode, encode)
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Maybe (catMaybes, fromMaybe)
@@ -28,26 +28,30 @@ import Effectful.FileSystem
   )
 import Effectful.FileSystem.IO.ByteString qualified as FIOE (readFile, writeFile)
 import Effectful.FileSystem.IO.ByteString.Lazy qualified as BL
-import Effectful.State.Static.Shared (State, get, modify)
+import Effectful.State.Static.Shared (State, get, gets, modify)
 import Effectful.TH
 import EffectfulQML
 import Graphics.QML hiding (fireSignal, runEngineLoop)
+
+import Logging
 import Nostr
 import Nostr.Bech32
 import Nostr.Keys ( KeyPair, PubKeyXO, SecKey, derivePublicKeyXO
                   , keyPairToPubKeyXO, keyPairToSecKey, secKeyToKeyPair)
 import Nostr.Types hiding (displayName, picture)
+import Nostr.Types (Profile(..))
 import System.FilePath (takeFileName, (</>))
 import Text.Read (readMaybe)
+import qualified Nostr.Types as NT
 
 
 -- | Account.
 data Account = Account
-  { nsec :: SecKey,
-    npub :: PubKeyXO,
-    displayName :: Maybe Text,
-    picture :: Maybe Text,
-    relays :: ([Relay], Int)
+  { accountNsec :: SecKey,
+    accountNpub :: PubKeyXO,
+    accountDisplayName :: Maybe Text,
+    accountPicture :: Maybe Text,
+    accountRelays :: ([Relay], Int)
   }
   deriving (Eq, Show)
 
@@ -85,14 +89,17 @@ type KeyMgmtEff es = ( State KeyMgmtState :> es
                      , Nostr :> es
                      , FileSystem :> es
                      , IOE :> es
-                     , EffectfulQML :> es )
+                     , EffectfulQML :> es
+                     , Logging :> es )
 
 -- | Key Management Effects.
 data KeyMgmt :: Effect where
   ImportSecretKey :: ObjRef () -> Text -> KeyMgmt m Bool
   ImportSeedphrase :: ObjRef () -> Text -> Text -> KeyMgmt m Bool
   GenerateSeedphrase :: ObjRef () -> KeyMgmt m ()
   RemoveAccount :: ObjRef () -> Text -> KeyMgmt m ()
+  UpdateRelays :: AccountId -> ([Relay], Int) -> KeyMgmt m ()
+  UpdateProfile :: AccountId -> Profile -> KeyMgmt m ()
 
 type instance DispatchOf KeyMgmt = Dynamic
 
@@ -185,6 +192,35 @@ runKeyMgmt = interpret $ \_ -> \case
       then removeDirectoryRecursive dir
       else return ()
 
+  UpdateRelays aid newRelays -> do
+    modify $ \st -> st 
+      { accountMap = Map.adjust (\acc -> acc { accountRelays = newRelays }) aid (accountMap st) }
+    accounts <- gets accountMap
+    case Map.lookup aid accounts of 
+      Just account -> do
+        let npubStr = unpack $ pubKeyXOToBech32 $ accountNpub account
+        dir <- getXdgDirectory XdgData $ "futrnostr/" ++ npubStr
+        BL.writeFile (dir </> "relays.json") (encode newRelays)
+      Nothing -> do
+        logError $ "Account not found: " <>accountId aid
+        return ()
+
+  UpdateProfile aid profile -> do
+    modify $ \st -> st 
+      { accountMap = Map.adjust (\acc -> acc 
+          { accountDisplayName = NT.displayName profile
+          , accountPicture = NT.picture profile
+          }) aid (accountMap st) 
+      }
+    accounts <- gets accountMap
+    case Map.lookup aid accounts of 
+      Just account -> do
+        let npubStr = unpack $ pubKeyXOToBech32 $ accountNpub account
+        dir <- getXdgDirectory XdgData $ "futrnostr/" ++ npubStr
+        BL.writeFile (dir </> "profile.json") (encode profile)
+      Nothing -> do
+        logError $ "Account not found: " <> accountId aid
+        return ()
 
 -- | Run the Key Management UI effect.
 runKeyMgmtUI :: KeyMgmgtUIEff es => Eff (KeyMgmtUI : es) a -> Eff es a
@@ -209,10 +245,10 @@ runKeyMgmtUI action = interpret handleKeyMgmtUI action
 
         accountClass <-
           newClass
-            [ prop "nsec" (secKeyToBech32 . nsec),
-              prop "npub" (pubKeyXOToBech32 . npub),
-              mprop "displayName" displayName,
-              mprop "picture" picture
+            [ prop "nsec" (secKeyToBech32 . accountNsec),
+              prop "npub" (pubKeyXOToBech32 . accountNpub),
+              mprop "displayName" accountDisplayName,
+              mprop "picture" accountPicture
             ]
 
         accountPool' <- newFactoryPool (newObject accountClass)
@@ -311,11 +347,11 @@ loadAccount storageDir npubDir = do
 
     Just
       Account
-        { nsec = nsecKey,
-          npub = pubKeyXO,
-          relays = fromMaybe defaultRelays relayData,
-          displayName = profile >>= \(Profile _ d _ _ _ _) -> d,
-          picture = profile >>= \(Profile _ _ _ p _ _) -> p
+        { accountNsec = nsecKey,
+          accountNpub = pubKeyXO,
+          accountRelays = fromMaybe defaultRelays relayData,
+          accountDisplayName = profile >>= \(Profile _ d _ _ _ _) -> d,
+          accountPicture = profile >>= \(Profile _ _ _ p _ _) -> p
         }
 
 -- | Read a file and return its contents as a Maybe Text.
@@ -343,9 +379,9 @@ accountFromKeyPair kp = (AccountId newNpub, account)
     newNpub = pubKeyXOToBech32 $ keyPairToPubKeyXO kp
     account =
       Account
-        { nsec = keyPairToSecKey kp,
-          npub = keyPairToPubKeyXO kp,
-          relays = defaultRelays,
-          displayName = Nothing,
-          picture = Nothing
+        { accountNsec = keyPairToSecKey kp,
+          accountNpub = keyPairToPubKeyXO kp,
+          accountRelays = defaultRelays,
+          accountDisplayName = Nothing,
+          accountPicture = Nothing
         }