Add Account Management Features

    UI: Added AccountScreen.ui.qml for listing and interacting with accounts. Updated App.qml to integrate AccountScreen.
    Backend: Introduced src/Presentation/Accounts.hs for managing accounts and integrated it into Main.hs.
    Changes: Updated Types.hs and Relay.hs for new account management functionality and improved data handling.

futr.cabal

@@ -32,6 +32,7 @@ executable futr
         Nostr.Kind
         Nostr.Profile
         Nostr.Relay
+        Presentation.Accounts
         Presentation.Welcome
         Types
 
@@ -55,6 +56,7 @@ executable futr
         data-default >=0.7.1.1 && <0.8,
         directory >=1.3.7.1 && <1.4,
         entropy >=0.4.1.10 && <0.5,
+        filepath >= 1.4.2 && <1.5,
         haskoin-core >=1.1.0 && <1.2,
         hsqml >=0.3.6.0 && <0.4,
         lens >=5.3.2 && <5.4,

resources/qml/content/AccountScreen.ui.qml

@@ -0,0 +1,62 @@
+import QtQuick 2.15
+import QtQuick.Controls 2.15
+import QtQuick.Layouts 1.15
+import HsQML.Model 1.0
+import Futr 1.0
+
+ScrollView {
+    ListView {
+        id: accountsView;
+        focus: true;
+        model: AutoListModel {
+            source: ctxAccounts.accounts; mode: AutoListModel.ByKey;
+        }
+        delegate: Rectangle {
+            width: parent.width
+            height: 80
+
+            property bool mouseHover: false
+
+            color: mouseHover ? "lightsteelblue" : "lightgray"
+            border.color: "gray"
+            radius: 10
+
+            // Display the account's picture
+            Image {
+                id: accountImage
+                source: modelData.picture
+                width: 60
+                height: 60
+                anchors.left: parent.left
+                anchors.leftMargin: 10
+                anchors.verticalCenter: parent.verticalCenter
+                fillMode: Image.PreserveAspectCrop
+            }
+
+            // Display the npub and displayName
+            Column {
+                anchors.left: accountImage.right
+                anchors.leftMargin: 10
+                anchors.fill: parent
+                anchors.verticalCenter: parent.verticalCenter
+
+                Text {
+                    text: modelData.displayName ? modelData.displayName + " (" + modelData.npub + ")" : modelData.npub
+                }
+            }
+
+            MouseArea {
+                id: mouseArea
+                anchors.fill: parent
+                hoverEnabled: true
+                //onClicked: ctxAccounts.login(modelData.npub)
+
+                onEntered: parent.mouseHover = true
+                onExited: parent.mouseHover = false
+            }
+        }
+        highlight: Rectangle {
+            color: 'lightsteelblue';
+        }
+    }
+}

resources/qml/content/App.qml

@@ -19,6 +19,15 @@ ApplicationWindow {
     Material.accent: Material.Teal
     Material.primary: Material.BlueGrey
 
+    Text {
+        text: currentScreen
+    }
+
+    AccountScreen {
+        anchors.fill: parent
+        visible: currentScreen == "Account"
+    }
+
     WelcomeScreen {
         anchors.fill: parent
         visible: currentScreen == "Welcome"

resources/qml/content/qmldir

@@ -1,4 +1,5 @@
 module content
+AccountScreen 1.0 AccountScreen.ui.qml
 App 1.0 App.qml
 HomeScreen 1.0 HomeScreen.ui.qml
 KeysGeneratedScreen 1.0 KeysGeneratedScreen.ui.qml

src/Main.hs

@@ -4,21 +4,47 @@
 
 module Main where
 
-import Control.Concurrent (modifyMVar_, newMVar, readMVar)
+import Control.Concurrent (MVar, modifyMVar_, newMVar, readMVar)
+import qualified Data.Map as Map
 import Data.Text (pack, unpack)
+import Data.Typeable (Typeable)
 import Graphics.QML
 import System.Environment (setEnv)
 import Text.Read (readMaybe)
 
-import Types
+import Nostr.Keys (KeyPair, secKeyToKeyPair)
+import Presentation.Accounts
 import Presentation.Welcome
+import Types
+
+data AppModel = AppModel
+    { keyPair :: Maybe KeyPair
+    , currentScreen :: AppScreen
+    , welcomeModel :: MVar WelcomeModel
+    , accountModel :: MVar AccountModel
+    } deriving (Typeable)
 
-createContext :: ModelVar -> SignalKey (IO ()) -> IO (ObjRef ())
+createContext :: MVar AppModel -> SignalKey (IO ()) -> IO (ObjRef ())
 createContext modelVar changeKey = do
-    welcomeObj <- createWelcomeCtx modelVar changeKey
+    appModel <- readMVar modelVar
+
+    let getKeyPair :: IO (Maybe KeyPair)
+        getKeyPair = do
+            appModel' <- readMVar modelVar
+            return (keyPair appModel')
+
+        setKeyPair :: KeyPair -> IO ()
+        setKeyPair kp = modifyMVar_ modelVar $ \m -> return m { keyPair = Just kp }
+
+        setCurrentScreen :: AppScreen -> IO ()
+        setCurrentScreen screen = modifyMVar_ modelVar $ \m -> return m { currentScreen = screen }
+
+    welcomeObj <- createWelcomeCtx (welcomeModel appModel) changeKey getKeyPair setKeyPair setCurrentScreen
+    accountObj <- createAccountCtx (accountModel appModel) changeKey setKeyPair setCurrentScreen
 
     rootClass <- newClass [
         defPropertyConst' "ctxWelcome" (\_ -> return welcomeObj),
+        defPropertyConst' "ctxAccounts" (\_ -> return accountObj),
 
         defPropertySigRW' "currentScreen" changeKey
             (\_ -> fmap (pack . show . currentScreen) (readMVar modelVar))
@@ -35,7 +61,32 @@ createContext modelVar changeKey = do
 
 main :: IO ()
 main = do
-    modelVar <- newMVar $ AppModel { keyPair = Nothing, currentScreen = Welcome, seedphrase = "", errorMsg = "" }
+    accounts <- listAccounts
+
+    welcomeM <- newMVar $ WelcomeModel "" ""
+    accountM <- newMVar $ AccountModel { accountMap = accounts }
+
+    let appModel = case Map.size accounts of
+            0 -> AppModel
+                { keyPair = Nothing
+                , currentScreen = Welcome
+                , accountModel = accountM
+                , welcomeModel = welcomeM
+                }
+            1 -> AppModel
+                { keyPair = Just $ secKeyToKeyPair $ nsec $ snd $ head $ Map.toList accounts
+                , currentScreen = Home
+                , accountModel = accountM
+                , welcomeModel = welcomeM
+                }
+            _ -> AppModel
+                { keyPair = Nothing
+                , currentScreen = Types.Account
+                , accountModel = accountM
+                , welcomeModel = welcomeM
+                }
+
+    modelVar <- newMVar appModel
     changeKey <- newSignalKey :: IO (SignalKey (IO ()))
     ctx <- createContext modelVar changeKey
 

src/Nostr/Relay.hs

@@ -30,7 +30,7 @@ data RelayInfo = RelayInfo
   { readable  :: Bool
   , writable  :: Bool
   }
-  deriving (Eq, Show, Generic, FromJSON, ToJSON)
+  deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
 
 -- | Represents a relay entity containing URI, relay information, and connection status.
 data Relay = Relay
@@ -70,18 +70,10 @@ instance ToJSON Relay where
     ]
 
 -- | Provides a default list of relays.
-defaultRelays :: [Relay]
+defaultRelays :: [(RelayURI, RelayInfo)]
 defaultRelays =
-  [ Relay
-      { uri = RelayURI [QQ.uri|wss://nostr.rocks|]
-      , info = RelayInfo True True
-      , connected = False
-      }
-  , Relay
-      { uri = RelayURI [QQ.uri|ws://localhost:2700|]
-      , info = RelayInfo True True
-      , connected = False
-      }
+  [ (RelayURI [QQ.uri|wss://nostr.rocks|], RelayInfo True True)
+  , (RelayURI [QQ.uri|ws://localhost:2700|], RelayInfo True True)
   ]
 
 -- | Retrieves the textual representation of the relay's URI.

src/Presentation/Accounts.hs

@@ -0,0 +1,141 @@
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications, TypeFamilies      #-}
+
+module Presentation.Accounts where
+
+import Control.Concurrent (MVar, modifyMVar_, readMVar, withMVar)
+import Control.Monad (filterM)
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (FromJSON(..), eitherDecode, encode)
+import qualified Data.ByteString.Lazy as BL
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Text (Text, isPrefixOf, pack, strip)
+import Data.Typeable (Typeable)
+import qualified Data.Text.IO as TIO
+import Graphics.QML
+import System.Directory (XdgDirectory(XdgData), getXdgDirectory, listDirectory, doesDirectoryExist, doesFileExist)
+import System.FilePath ((</>), takeFileName)
+
+import Nostr.Keys (KeyPair, PubKeyXO, SecKey, bech32ToPubKeyXO, bech32ToSecKey, pubKeyXOToBech32, secKeyToBech32)
+import Nostr.Relay (RelayInfo, RelayURI, defaultRelays)
+import Types (AppScreen)
+
+data Account = Account
+    { nsec :: SecKey
+    , npub :: PubKeyXO
+    , relays :: [(RelayURI, RelayInfo)]
+    , displayName :: Text
+    , picture :: Text
+    } deriving (Eq, Show)
+
+newtype AccountId = AccountId {accountId :: Text} deriving (Eq, Ord, Show, Typeable)
+
+data AccountModel = AccountModel { accountMap :: Map AccountId Account }
+{-
+listAccounts :: IO [Account]
+listAccounts = do
+    storageDir <- getXdgDirectory XdgData "futrnostr"
+    directoryExists <- doesDirectoryExist storageDir
+    if not directoryExists
+        then return []
+        else do
+            contents <- listDirectory storageDir
+            npubDirs <- filterM (isNpubDirectory storageDir) contents
+            mapM (loadAccount storageDir) npubDirs >>= return . catMaybes
+-}
+listAccounts :: IO (Map AccountId Account)
+listAccounts = do
+    storageDir <- getXdgDirectory XdgData "futrnostr"
+    directoryExists <- doesDirectoryExist storageDir
+    if not directoryExists
+        then return Map.empty
+        else do
+            contents <- listDirectory storageDir
+            npubDirs <- filterM (isNpubDirectory storageDir) contents
+            accounts <- mapM (loadAccount storageDir) npubDirs
+            let accountPairs = catMaybes $ zipWith (\dir acc -> fmap (\a -> (AccountId $ pack dir, a)) acc) npubDirs accounts
+            return $ Map.fromList accountPairs
+
+isNpubDirectory :: FilePath -> FilePath -> IO Bool
+isNpubDirectory storageDir name = do
+    let fullPath = storageDir </> name
+    isDir <- doesDirectoryExist fullPath
+    let fileName = takeFileName fullPath
+    return $ isDir && "npub" `isPrefixOf` pack fileName
+
+loadAccount :: FilePath -> FilePath -> IO (Maybe Account)
+loadAccount storageDir npubDir = do
+    let dirPath = storageDir </> npubDir
+    nsecContent <- readFileMaybe (dirPath </> "nsec")
+
+    case (bech32ToSecKey . strip =<< nsecContent) of
+        Nothing -> 
+            return Nothing
+        Just nsecKey -> do
+            relayList <- readJSONFile (dirPath </> "relays.json")
+            let relayData = fromMaybe defaultRelays relayList
+
+            profile <- readJSONFile (dirPath </> "profile.json")
+            let (someName, somePicture) = case profile of
+                    Just [name, pic] -> (name, pic)
+                    _ -> ("", "")
+
+            let maybePubKeyXO = bech32ToPubKeyXO (pack npubDir)
+            case maybePubKeyXO of
+                Nothing -> return Nothing
+                Just pubKeyXO -> return $ Just Account
+                    { nsec = nsecKey
+                    , npub = pubKeyXO
+                    , relays = relayData
+                    , displayName = someName
+                    , picture = somePicture
+                    }
+
+readFileMaybe :: FilePath -> IO (Maybe Text)
+readFileMaybe path = do
+    exists <- doesFileExist path
+    if exists
+        then Just <$> TIO.readFile path
+        else return Nothing
+
+readJSONFile :: FromJSON a => FilePath -> IO (Maybe a)
+readJSONFile path = do
+    exists <- doesFileExist path
+    if exists
+        then eitherDecode <$> BL.readFile path >>= return . either (const Nothing) Just
+        else return Nothing
+
+createAccountCtx
+    :: MVar AccountModel 
+    -> SignalKey (IO ())
+    -> (KeyPair -> IO ())
+    -> (AppScreen -> IO ())
+    -> IO (ObjRef ())
+createAccountCtx modelVar changeKey setKeyPair go = do
+    accountClass <- newClass [
+        defPropertySigRO' "nsec" changeKey (\obj -> do
+            model <- readMVar modelVar
+            return $ maybe "" (secKeyToBech32 . nsec) $ Map.lookup (fromObjRef obj) (accountMap model)),
+        defPropertySigRO' "npub" changeKey (\obj -> do
+            model <- readMVar modelVar
+            return $ maybe "" (pubKeyXOToBech32 . npub) $ Map.lookup (fromObjRef obj) (accountMap model)),
+        defPropertySigRO' "displayName" changeKey (\obj -> do
+            model <- readMVar modelVar
+            return $ maybe "" displayName $ Map.lookup (fromObjRef obj) (accountMap model)),
+        defPropertySigRO' "picture" changeKey (\obj -> do
+            model <- readMVar modelVar
+            return $ maybe "" picture $ Map.lookup (fromObjRef obj) (accountMap model))
+        ]
+
+    accountPool <- newFactoryPool (newObject accountClass)
+
+    contextClass <- newClass [
+        defPropertySigRO' "accounts" changeKey $ \_ -> do
+            model <- readMVar modelVar
+            mapM (getPoolObject accountPool) $ Map.keys (accountMap model)
+        ]
+
+    newObject contextClass ()
+