separate welcomescreen into own qt ctx

futr.cabal

@@ -54,6 +54,8 @@ executable futr
     Nostr.Kind
     Nostr.Profile
     Nostr.Relay
+    Presentation.WelcomeScreen
+    Types
     Paths_futr
   default-language: Haskell2010
   data-dir: resources

resources/qml/content/App.qml

@@ -25,18 +25,14 @@ ApplicationWindow {
     }
 
     KeysGeneratedScreen {
-        visible: seedphrase != ""
+        visible: ctxWelcomeScreen.seedphrase != ""
     }
 
     HomeScreen {
         anchors.fill: parent
         visible: currentScreen == "HomeScreen"
     }
 
-    ErrorScreen {
-        visible: errorMsg != ""
-    }
-
     ToolBar {
         id: statusBar
         anchors.bottom: parent.bottom

resources/qml/content/KeysGeneratedScreen.ui.qml

@@ -45,7 +45,7 @@ Rectangle {
 
         TextArea {
             id: seedPhraseText
-            text: seedphrase
+            text: ctxWelcomeScreen.seedphrase
             readOnly: true
             wrapMode: Text.Wrap
             font.pixelSize: 16
@@ -67,7 +67,7 @@ Rectangle {
 
         TextArea {
             id: privateKeyText
-            text: nsec
+            text: ctxWelcomeScreen.nsec
             readOnly: true
             wrapMode: Text.Wrap
             font.pixelSize: 16
@@ -89,7 +89,7 @@ Rectangle {
 
         TextArea {
             id: publicKeyText
-            text: npub
+            text: ctxWelcomeScreen.npub
             readOnly: true
             wrapMode: Text.Wrap
             font.pixelSize: 16
@@ -118,7 +118,7 @@ Rectangle {
             anchors.margins: 10
             highlighted: true
             onClicked: {
-                seedphrase = ""
+                ctxWelcomeScreen.seedphrase = ""
                 currentScreen = "HomeScreen"
             }
         }

resources/qml/content/WelcomeScreen.ui.qml

@@ -97,13 +97,15 @@ Rectangle {
                             id: radionsec
                             checked: true
                             Layout.alignment: Qt.AlignLeft
+                            onClicked: ctxWelcomeScreen.errorMsg = ""
                         }
 
                         RadioButton {
                             text: qsTr("Import from seedphrase")
                             id: radioseedphrase
                             checked: false
                             Layout.alignment: Qt.AlignRight
+                            onClicked: ctxWelcomeScreen.errorMsg = ""
                         }
                     }
 
@@ -131,6 +133,15 @@ Rectangle {
                         visible: radioseedphrase.checked
                     }
 
+                    Text {
+                        id: errorMessage
+                        text: ctxWelcomeScreen.errorMsg
+                        color: "red"
+                        visible: errorMessage != ""
+                        Layout.alignment: Qt.AlignLeft
+                        Layout.leftMargin: 10
+                    }
+
                     Item {
                         Layout.fillHeight: true
                         Layout.alignment: Qt.AlignTop
@@ -148,9 +159,9 @@ Rectangle {
                             target: importbutton
                             onClicked: function () {
                                 if (radionsec.checked) {
-                                    importSecretKey(secretkey.text)
+                                    ctxWelcomeScreen.importSecretKey(secretkey.text)
                                 } else if (radioseedphrase.checked) {
-                                    importSeedphrase(seedphrase.text,
+                                    ctxWelcomeScreen.importSeedphrase(seedphrase.text,
                                                      password.text)
                                 }
                             }
@@ -203,7 +214,7 @@ Rectangle {
                         Layout.alignment: Qt.AlignRight
                         Layout.margins: 10
                         onClicked: function () {
-                            generateSeedphrase()
+                            ctxWelcomeScreen.generateSeedphrase()
                         }
                     }
                 }

src/Main.hs

@@ -4,66 +4,30 @@
 
 module Main where
 
-import Control.Concurrent (MVar, modifyMVar_, newMVar, takeMVar, putMVar, readMVar)
-import Data.Text (Text, isPrefixOf, pack, unpack)
-import qualified Data.Text.IO as TIO
-import Data.Typeable (Typeable)
+import Control.Concurrent (modifyMVar_, newMVar, readMVar)
+import Data.Text (pack, unpack)
 import Graphics.QML
 import Nostr.Keys
-    ( bech32ToSecKey
-    , SecKey
-    , PubKeyXO
-    , KeyPair
-    , createMnemonic
-    , derivePublicKeyXO
-    , keyPairToPubKeyXO
+    ( keyPairToPubKeyXO
     , keyPairToSecKey
-    , mnemonicToKeyPair
     , pubKeyXOToBech32
     , secKeyToBech32
-    , secKeyToKeyPair
     )
 import Paths_futr (getDataFileName)
 import System.Environment (setEnv)
-import System.Directory (XdgDirectory(XdgData), createDirectoryIfMissing, getXdgDirectory)
 import Text.Read (readMaybe)
 
-data AppScreen
-    = WelcomeScreen
-    | SelectAccountScreen
-    | RelayScreen
-    | CreateAccountScreen
-    | HomeScreen
-    deriving (Eq, Read, Show)
-
-data AppModel = AppModel
-    { keyPair :: Maybe KeyPair
-    , seedphrase :: Text
-    , availableKeys :: [PubKeyXO]
-    , currentScreen :: AppScreen
-    , errorMsg :: Text
-    } deriving (Typeable)
-
-type ModelVar = MVar AppModel
+import Types
+import Presentation.WelcomeScreen
 
 createContext :: ModelVar -> SignalKey (IO ()) -> IO (ObjRef ())
 createContext modelVar changeKey = do
-    let handleError :: ObjRef() -> String -> IO ()
-        handleError obj err = do
-            model <- takeMVar modelVar
-            putMVar modelVar model { errorMsg = "Error: " <> pack err }
-            fireSignal changeKey obj
+    welcomeScreenObj <- createWelcomeScreenCtx modelVar changeKey
 
-    rootClass <- newClass [            
-        defPropertySigRW' "seedphrase" changeKey 
-            (\_ -> do
-                model <- readMVar modelVar
-                return $ seedphrase model)
-            (\obj newSeedphrase -> do
-                modifyMVar_ modelVar $ \model -> return model { seedphrase = newSeedphrase }
-                fireSignal changeKey obj),
+    rootClass <- newClass [
+        defPropertyConst' "ctxWelcomeScreen" (\_ -> return welcomeScreenObj),
 
-        defPropertySigRO' "nsec" changeKey $ \_ -> 
+        defPropertySigRO' "nsec" changeKey $ \_ ->
             fmap (maybe (pack "") (secKeyToBech32 . keyPairToSecKey) . keyPair) (readMVar modelVar),
 
         defPropertySigRO' "npub" changeKey $ \_ -> 
@@ -74,83 +38,18 @@ createContext modelVar changeKey = do
             return $ map pubKeyXOToBech32 (availableKeys model),
 
         defPropertySigRW' "currentScreen" changeKey
-            (\_ -> do
-                model <- readMVar modelVar
-                return $ pack $ show $ currentScreen model)
+            (\_ -> fmap (pack . show . currentScreen) (readMVar modelVar))
             (\obj newScreen -> do
                 case readMaybe (unpack newScreen) :: Maybe AppScreen of
                     Just s -> do
                         modifyMVar_ modelVar $ \model -> return model { currentScreen = s }
                         fireSignal changeKey obj
-                    Nothing -> return ()),
-
-        defPropertySigRW' "errorMsg" changeKey 
-            (\_ -> do
-                model <- readMVar modelVar
-                return $ errorMsg model)
-            (\obj newErrorMsg -> handleError obj $ unpack newErrorMsg),
-
-        defMethod' "importSecretKey" $ \this (input :: Text) -> do
-            mkp <- importSecretKey input
-            case mkp of
-                Just _ -> do
-                    model <- takeMVar modelVar
-                    putMVar modelVar model { keyPair = mkp, currentScreen = HomeScreen }
-                    fireSignal changeKey this
-                Nothing -> handleError this "Error: Importing secret key failed",          
-
-        defMethod' "importSeedphrase" $ \this input pwd -> do
-            mkp <- mnemonicToKeyPair input pwd
-            case mkp of
-                Right kp -> do
-                    let secKey = keyPairToSecKey kp
-                    importSecretKey (secKeyToBech32 secKey) >>= \mkp' ->
-                        case mkp' of
-                            Just _ -> do
-                                model <- takeMVar modelVar
-                                putMVar modelVar model { keyPair = mkp', currentScreen = HomeScreen }
-                                fireSignal changeKey this
-                            Nothing -> handleError this "Unknown error generating new keys"
-                Left err -> handleError this err,
-
-        defMethod' "generateSeedphrase" $ \this -> do
-            createMnemonic >>= either (handleError this) (\m' -> do
-                mnemonicToKeyPair m' "" >>= either (handleError this) (\mkp' -> do
-                    let secKey = keyPairToSecKey mkp'
-                    importSecretKey (secKeyToBech32 secKey) >>= \mkp ->
-                        case mkp of
-                            Just _ -> do
-                                model <- takeMVar modelVar
-                                putMVar modelVar model { seedphrase = m', keyPair = mkp }
-                                fireSignal changeKey this
-                            Nothing -> handleError this "Unknown error generating new keys"
-                    )
-                )
-
+                    Nothing -> return ())
         ]
 
     newObject rootClass ()
 
 
-importSecretKey :: Text -> IO (Maybe KeyPair)
-importSecretKey input = do
-    let skMaybe = if "nsec" `isPrefixOf` input
-                  then bech32ToSecKey input
-                  else readMaybe (unpack input) :: Maybe SecKey
-    case skMaybe of
-        Just sk -> do
-            storageDir <- getXdgDirectory XdgData $ "futrnostr/" ++ (unpack $ pubKeyXOToBech32 pk)
-            _ <- createDirectoryIfMissing True storageDir
-            _ <- TIO.writeFile (storageDir ++ "/keys.json") content
-            return $ Just kp
-            where
-                pk = derivePublicKeyXO sk
-                content = "[" <> secKeyToBech32 sk <> ", " <> pubKeyXOToBech32 pk <> "]"
-                kp = secKeyToKeyPair sk
-        Nothing ->
-            return Nothing
-
-
 main :: IO ()
 main = do
     modelVar <- newMVar $ AppModel { keyPair = Nothing, availableKeys = [], currentScreen = WelcomeScreen, seedphrase = "", errorMsg = "" }