ADD password prompt to sshfs and FIX password prompt since it never actually worked

app/rofi-dev.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 --------------------------------------------------------------------------------
 -- | rofi-dev - a rofi prompt for mountable devices
@@ -290,21 +290,21 @@ newtype PromptConfig = PromptConfig
   deriving Show
 
 instance FromJSON PromptConfig where
-  parseJSON = withObject "libsecret" $ \o -> PromptConfig
-    <$> o .: "tries" .!= defaultTries
+  parseJSON = withObject "prompt" $ \o -> PromptConfig
+    <$> o .:? "tries" .!= defaultTries
 
-data PasswordConfig = PasswordConfig
-  { passwordBitwarden :: Maybe BitwardenConfig
-  , passwordLibSecret :: Maybe LibSecretConfig
-  , passwordPrompt    :: Maybe PromptConfig
-  }
+data PasswordConfig = PwdBW BitwardenConfig
+  | PwdLS LibSecretConfig
+  | PwdPr PromptConfig
   deriving Show
 
 instance FromJSON PasswordConfig where
-  parseJSON = withObject "password" $ \o -> PasswordConfig
-    <$> o .:? "bitwarden"
-    <*> o .:? "libsecret"
-    <*> o .:? "prompt"
+  parseJSON = withObject "password" $ \o -> do
+    br <- fmap PwdBW <$> o .:? "bitwarden"
+    ls <- maybe (fmap PwdLS <$> o .:? "libsecret") (return . Just) br
+    -- TODO this is silly because I need to pass 'prompt: {}' instead of
+    -- just 'prompt:' if I just want the defaults
+    maybe (PwdPr <$> o .: "prompt") return ls
 
 data CIFSOptsConfig = CIFSOptsConfig
   { cifsoptsUsername  :: Maybe String
@@ -327,6 +327,7 @@ data DataConfig = VeracryptConfig
   , veracryptPassword :: Maybe PasswordConfig
   } | SSHFSConfig
   { sshfsRemote   :: String
+  , sshfsPassword :: Maybe PasswordConfig
   } | CIFSConfig
   { cifsRemote   :: String
   , cifsSudo     :: Bool
@@ -357,6 +358,7 @@ instance FromJSON TreeConfig where
                    <*> o .:? "options"
                  "sshfs"     -> SSHFSConfig
                    <$> o .: "remote"
+                   <*> o .:? "password"
                  "veracrypt" -> VeracryptConfig
                    <$> o .: "volume"
                    <*> o .:? "password"
@@ -446,7 +448,7 @@ instance Mountable DeviceConfig where
     withTmpMountDir m'
       $ io
       $ case devData of
-          SSHFSConfig{ sshfsRemote = r } -> mountSSHFS m' r
+          SSHFSConfig{ sshfsRemote = r, sshfsPassword = p } -> mountSSHFS m' p r
           CIFSConfig
             { cifsRemote = r
             , cifsSudo = s
@@ -477,8 +479,11 @@ instance Mountable DeviceConfig where
     { deviceMount = MountConfig { mountMountpoint = p, mountLabel = l }
     } = fromMaybe (takeFileName p) l
 
-mountSSHFS :: FilePath -> String -> IO MountResult
-mountSSHFS mountpoint remote = runMount "sshfs" [remote, mountpoint] ""
+mountSSHFS :: FilePath -> Maybe PasswordConfig -> String -> IO MountResult
+mountSSHFS mountpoint pwdConfig remote =
+  withPasswordGetter pwdConfig (run ["-o", "password_stdin"]) $ run [] ""
+  where
+    run other = runMount "sshfs" (other ++ [remote, mountpoint])
 
 mountCIFS :: Bool -> String -> FilePath -> Maybe CIFSOptsConfig
   -> Maybe PasswordConfig -> IO MountResult
@@ -542,20 +547,26 @@ runPromptLoop n pwd = do
     if n <= 0 then return Nothing else runPromptLoop (n-1) pwd
     else return res
 
+-- configToPwd :: PasswordConfig -> PasswordGetter
+-- configToPwd PasswordConfig
+--   { passwordBitwarden = b
+--   , passwordLibSecret = s
+--   , passwordPrompt = p
+--   } =
+--     getBW b `runMaybe` getLS s `runMaybe` getPrompt p
+--   where
+--     getBW (Just BitwardenConfig{ bitwardenKey = k, bitwardenTries = n }) =
+--       runPromptLoop n $ runBitwarden k
+--     getBW _ = return Nothing
+--     getLS = maybe (return Nothing) (runSecret . libsecretAttributes)
+--     getPrompt = maybe (return Nothing) (flip runPromptLoop readPassword . promptTries)
+--     runMaybe x y = (\r -> if isNothing r then y else return r) =<< x
+
 configToPwd :: PasswordConfig -> PasswordGetter
-configToPwd PasswordConfig
-  { passwordBitwarden = b
-  , passwordLibSecret = s
-  , passwordPrompt = p
-  } =
-    getBW b `runMaybe` getLS s `runMaybe` getPrompt p
-  where
-    getBW (Just BitwardenConfig{ bitwardenKey = k, bitwardenTries = n }) =
+configToPwd (PwdBW (BitwardenConfig { bitwardenKey = k, bitwardenTries = n })) =
   runPromptLoop n $ runBitwarden k
-    getBW _ = return Nothing
-    getLS = maybe (return Nothing) (runSecret . libsecretAttributes)
-    getPrompt = maybe (return Nothing) (flip runPromptLoop readPassword . promptTries)
-    runMaybe x y = (\r -> if isNothing r then y else return r) =<< x
+configToPwd (PwdLS s) = runSecret $ libsecretAttributes s
+configToPwd (PwdPr p) = flip runPromptLoop readPassword $ promptTries p
 
 withPasswordGetter :: Maybe PasswordConfig -> (String -> IO MountResult)
   -> IO MountResult -> IO MountResult