ENH flatten config file using type key
This commit is contained in:
parent
f09f646e13
commit
047d68a6d8
240
app/rofi-dev.hs
240
app/rofi-dev.hs
|
@ -103,18 +103,6 @@ instance FromJSON MountConfig where
|
||||||
<$> o .: "mountpoint"
|
<$> o .: "mountpoint"
|
||||||
<*> o .:? "label"
|
<*> o .:? "label"
|
||||||
|
|
||||||
data DependsConfig = DependsConfig
|
|
||||||
{ _dependsVeracrypt :: V.Vector String
|
|
||||||
, _dependsSSHFS :: V.Vector String
|
|
||||||
, _dependsCIFS :: V.Vector String
|
|
||||||
} deriving Show
|
|
||||||
|
|
||||||
instance FromJSON DependsConfig where
|
|
||||||
parseJSON = withObject "depends" $ \o -> DependsConfig
|
|
||||||
<$> o .:& "veracrypt"
|
|
||||||
<*> o .:& "sshfs"
|
|
||||||
<*> o .:& "cifs"
|
|
||||||
|
|
||||||
data BitwardenConfig = BitwardenConfig
|
data BitwardenConfig = BitwardenConfig
|
||||||
{ _bitwardenKey :: String
|
{ _bitwardenKey :: String
|
||||||
, _bitwardenTries :: Integer }
|
, _bitwardenTries :: Integer }
|
||||||
|
@ -154,104 +142,51 @@ instance FromJSON PasswordConfig where
|
||||||
<*> o .:? "libsecret"
|
<*> o .:? "libsecret"
|
||||||
<*> o .:? "prompt"
|
<*> o .:? "prompt"
|
||||||
|
|
||||||
data VeracryptConfig = VeracryptConfig
|
data DeviceConfig = VeracryptConfig
|
||||||
{ _veracryptMount :: MountConfig
|
{ _veracryptMount :: MountConfig
|
||||||
, _veracryptVolume :: String
|
, _veracryptVolume :: String
|
||||||
, _veracryptDepends :: Maybe DependsConfig
|
, _veracryptDepends :: V.Vector String
|
||||||
, _veracryptPassword :: Maybe PasswordConfig
|
, _veracryptPassword :: Maybe PasswordConfig
|
||||||
} deriving Show
|
} | SSHFSConfig
|
||||||
|
|
||||||
instance FromJSON VeracryptConfig where
|
|
||||||
parseJSON = withObject "veracrypt" $ \o -> VeracryptConfig
|
|
||||||
<$> o .: "mount"
|
|
||||||
<*> o .: "volume"
|
|
||||||
<*> o .:? "depends"
|
|
||||||
<*> o .:? "password"
|
|
||||||
|
|
||||||
data SSHFSConfig = SSHFSConfig
|
|
||||||
{ _sshfsMount :: MountConfig
|
{ _sshfsMount :: MountConfig
|
||||||
, _sshfsRemote :: String
|
, _sshfsRemote :: String
|
||||||
, _sshfsDepends :: Maybe DependsConfig
|
, _sshfsDepends :: V.Vector String
|
||||||
} deriving Show
|
} | CIFSConfig
|
||||||
|
|
||||||
instance FromJSON SSHFSConfig where
|
|
||||||
parseJSON = withObject "sshfs" $ \o -> SSHFSConfig
|
|
||||||
<$> o .: "mount"
|
|
||||||
<*> o .: "remote"
|
|
||||||
<*> o .:? "depends"
|
|
||||||
|
|
||||||
data CIFSConfig = CIFSConfig
|
|
||||||
{ _cifsMount :: MountConfig
|
{ _cifsMount :: MountConfig
|
||||||
, _cifsRemote :: String
|
, _cifsRemote :: String
|
||||||
, _cifsDepends :: Maybe DependsConfig
|
, _cifsDepends :: V.Vector String
|
||||||
, _cifsPassword :: Maybe PasswordConfig
|
, _cifsPassword :: Maybe PasswordConfig
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
instance FromJSON CIFSConfig where
|
instance FromJSON DeviceConfig where
|
||||||
parseJSON = withObject "cifs" $ \o -> CIFSConfig
|
parseJSON = withObject "devices" $ \o -> do
|
||||||
|
devType <- o .: "type"
|
||||||
|
case (devType :: String) of
|
||||||
|
"cifs" -> CIFSConfig
|
||||||
<$> o .: "mount"
|
<$> o .: "mount"
|
||||||
<*> o .: "remote"
|
<*> o .: "remote"
|
||||||
<*> o .:? "depends"
|
<*> o .:& "depends"
|
||||||
<*> o .:? "password"
|
<*> o .:? "password"
|
||||||
|
"sshfs" -> SSHFSConfig
|
||||||
-- data DeviceConfig = VeracryptConfig
|
<$> o .: "mount"
|
||||||
-- { _veracryptMount :: MountConfig
|
<*> o .: "remote"
|
||||||
-- , _veracryptVolume :: String
|
<*> o .:& "depends"
|
||||||
-- , _veracryptDepends :: Maybe DependsConfig
|
"veracrypt" -> VeracryptConfig
|
||||||
-- , _veracryptPassword :: Maybe PasswordConfig
|
<$> o .: "mount"
|
||||||
-- } | SSHFSConfig
|
<*> o .: "volume"
|
||||||
-- { _sshfsMount :: MountConfig
|
<*> o .:& "depends"
|
||||||
-- , _sshfsRemote :: String
|
<*> o .:? "password"
|
||||||
-- , _sshfsDepends :: Maybe DependsConfig
|
_ -> fail "unknown device type"
|
||||||
-- } | CIFSConfig
|
|
||||||
-- { _cifsMount :: MountConfig
|
|
||||||
-- , _cifsRemote :: String
|
|
||||||
-- , _cifsDepends :: Maybe DependsConfig
|
|
||||||
-- , _cifsPassword :: Maybe PasswordConfig
|
|
||||||
-- } deriving Show
|
|
||||||
|
|
||||||
-- instance FromJSON DeviceConfig where
|
|
||||||
-- parseJSON = withObject "devices" $ \o -> do
|
|
||||||
-- devType <- o .: "type"
|
|
||||||
-- case devType of
|
|
||||||
-- "cifs" -> CIFSConfig
|
|
||||||
-- <$> o .: "mount"
|
|
||||||
-- <*> o .: "remote"
|
|
||||||
-- <*> o .:? "depends"
|
|
||||||
-- <*> o .:? "password"
|
|
||||||
-- "sshfs" -> SSHFSConfig
|
|
||||||
-- <$> o .: "mount"
|
|
||||||
-- <*> o .: "remote"
|
|
||||||
-- <*> o .:? "depends"
|
|
||||||
-- "veracrypt" -> VeracryptConfig
|
|
||||||
-- <$> o .: "mount"
|
|
||||||
-- <*> o .: "volume"
|
|
||||||
-- <*> o .:? "depends"
|
|
||||||
-- <*> o .:? "password"
|
|
||||||
-- _ -> fail "unknown device type"
|
|
||||||
|
|
||||||
data DevicesConfig = DevicesConfig
|
|
||||||
{ _veracryptConfigs :: M.Map String VeracryptConfig
|
|
||||||
, _sshfsConfigs :: M.Map String SSHFSConfig
|
|
||||||
, _cifsConfigs :: M.Map String CIFSConfig
|
|
||||||
} deriving Show
|
|
||||||
|
|
||||||
instance FromJSON DevicesConfig where
|
|
||||||
parseJSON = withObject "devices" $ \o -> DevicesConfig
|
|
||||||
<$> o .: "veracrypt"
|
|
||||||
<*> o .: "sshfs"
|
|
||||||
<*> o .: "cifs"
|
|
||||||
|
|
||||||
data StaticConfig = StaticConfig
|
data StaticConfig = StaticConfig
|
||||||
{ _staticconfigTmpPath :: Maybe String
|
{ _staticconfigTmpPath :: Maybe String
|
||||||
, _staticconfigDevices :: Maybe DevicesConfig
|
, _staticconfigDevices :: M.Map String DeviceConfig
|
||||||
-- , _staticconfigDevices :: M.Map String DeviceConfig
|
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
instance FromJSON StaticConfig where
|
instance FromJSON StaticConfig where
|
||||||
parseJSON = withObject "devices" $ \o -> StaticConfig
|
parseJSON = withObject "devices" $ \o -> StaticConfig
|
||||||
<$> o .:? "mountdir"
|
<$> o .:? "mountdir"
|
||||||
<*> o .:? "devices"
|
<*> o .: "devices"
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Static Devices typeclass
|
-- | Static Devices typeclass
|
||||||
|
@ -260,16 +195,18 @@ instance FromJSON StaticConfig where
|
||||||
-- file). Its methods define the machinery to extract specific devies types
|
-- file). Its methods define the machinery to extract specific devies types
|
||||||
-- from the parse tree.
|
-- from the parse tree.
|
||||||
|
|
||||||
class Mountable m => StaticDevice m a where
|
fromConfig :: M.Map String DeviceConfig -> RofiIO MountConf [DevTriple]
|
||||||
fromConfig :: DevicesConfig -> (DevicesConfig -> M.Map String a) -> RofiIO MountConf [m]
|
fromConfig st = do
|
||||||
fromConfig s f = fromConfig' s (M.elems . f)
|
p <- asks mountconfVolatilePath
|
||||||
|
mapM (configToDev p st) $ M.elems st
|
||||||
|
|
||||||
fromConfig' :: DevicesConfig -> (DevicesConfig -> [a]) -> RofiIO MountConf [m]
|
foldTriples :: [Triple a b c] -> ([a], [b], [c])
|
||||||
fromConfig' s f = do
|
foldTriples = foldl stackTriples ([], [], [])
|
||||||
v <- asks mountconfVolatilePath
|
|
||||||
mapM (configToDev v s) $ f s
|
|
||||||
|
|
||||||
configToDev :: FilePath -> DevicesConfig -> a -> RofiIO MountConf m
|
stackTriples :: ([a], [b], [c]) -> Triple a b c -> ([a], [b], [c])
|
||||||
|
stackTriples (c, v, s) (First x) = (x:c, v, s)
|
||||||
|
stackTriples (c, v, s) (Second x) = (c, x:v, s)
|
||||||
|
stackTriples (c, v, s) (Third x) = (c, v, x:s)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Global config used in the reader monad stack
|
-- | Global config used in the reader monad stack
|
||||||
|
@ -284,7 +221,7 @@ class Mountable m => StaticDevice m a where
|
||||||
data MountConf = MountConf
|
data MountConf = MountConf
|
||||||
{ mountconfVolatilePath :: FilePath
|
{ mountconfVolatilePath :: FilePath
|
||||||
, mountconfRofiArgs :: [String]
|
, mountconfRofiArgs :: [String]
|
||||||
, mountconfStaticDevs :: Maybe DevicesConfig
|
, mountconfStaticDevs :: M.Map String DeviceConfig
|
||||||
}
|
}
|
||||||
|
|
||||||
instance RofiConf MountConf where
|
instance RofiConf MountConf where
|
||||||
|
@ -343,7 +280,7 @@ runMounts opts = do
|
||||||
static <- join <$> traverse parseStaticConfig (optsConfig opts)
|
static <- join <$> traverse parseStaticConfig (optsConfig opts)
|
||||||
defaultTmpPath <- ("/tmp/media" </>) <$> getEffectiveUserName
|
defaultTmpPath <- ("/tmp/media" </>) <$> getEffectiveUserName
|
||||||
let tmpPath = fromMaybe defaultTmpPath (_staticconfigTmpPath =<< static)
|
let tmpPath = fromMaybe defaultTmpPath (_staticconfigTmpPath =<< static)
|
||||||
let staticDevs = _staticconfigDevices =<< static
|
let staticDevs = maybe M.empty _staticconfigDevices static
|
||||||
let mountconf = MountConf
|
let mountconf = MountConf
|
||||||
{ mountconfVolatilePath = tmpPath
|
{ mountconfVolatilePath = tmpPath
|
||||||
, mountconfRofiArgs = optsRofiArgs opts
|
, mountconfRofiArgs = optsRofiArgs opts
|
||||||
|
@ -369,7 +306,8 @@ runPrompt gs = selectAction $ emptyMenu
|
||||||
getGroups :: RofiIO MountConf [RofiGroup MountConf]
|
getGroups :: RofiIO MountConf [RofiGroup MountConf]
|
||||||
getGroups = do
|
getGroups = do
|
||||||
sysd <- io getSystemdDevices
|
sysd <- io getSystemdDevices
|
||||||
(cifsDevs, sshfsDevs, vcDevs) <- getStaticDevices
|
(cifsDevs, sshfsDevs, vcDevs) <- foldTriples
|
||||||
|
<$> (fromConfig =<< asks mountconfStaticDevs)
|
||||||
sequence
|
sequence
|
||||||
[ mkGroup2 "SSHFS Devices" (filterSysd SystemdSSHFS sysd) sshfsDevs
|
[ mkGroup2 "SSHFS Devices" (filterSysd SystemdSSHFS sysd) sshfsDevs
|
||||||
, mkGroup "CIFS Devices" cifsDevs
|
, mkGroup "CIFS Devices" cifsDevs
|
||||||
|
@ -383,30 +321,16 @@ getGroups = do
|
||||||
mountByAlias :: Bool -> String -> RofiIO MountConf ()
|
mountByAlias :: Bool -> String -> RofiIO MountConf ()
|
||||||
mountByAlias unmountFlag alias = do
|
mountByAlias unmountFlag alias = do
|
||||||
static <- asks mountconfStaticDevs
|
static <- asks mountconfStaticDevs
|
||||||
forM_ static $ \static' -> do
|
|
||||||
volatilePath <- asks mountconfVolatilePath
|
volatilePath <- asks mountconfVolatilePath
|
||||||
c <- toDev volatilePath static' _cifsConfigs alias
|
forM_(M.lookup alias static) $ \d -> do
|
||||||
s <- toDev volatilePath static' _sshfsConfigs alias
|
res <- configToDev volatilePath static d
|
||||||
v <- toDev volatilePath static' _veracryptConfigs alias
|
case res of
|
||||||
mountIfJust (c :: Maybe CIFS)
|
First d' -> mount' d'
|
||||||
$ mountIfJust (s :: Maybe SSHFS)
|
Second d' -> mount' d'
|
||||||
$ mountIfJust (v :: Maybe VeraCrypt) (return ())
|
Third d' -> mount' d'
|
||||||
where
|
where
|
||||||
toDev v s f = mapM (configToDev v s) . aliasToDevice s f
|
mount' :: Mountable a => a -> RofiIO MountConf ()
|
||||||
mountIfJust a b = if isNothing a then b else forM_ a $ flip mount unmountFlag
|
mount' = flip mount unmountFlag
|
||||||
|
|
||||||
aliasToDevice :: DevicesConfig -> (DevicesConfig -> M.Map String a) -> String -> Maybe a
|
|
||||||
aliasToDevice d f = flip M.lookup (f d)
|
|
||||||
|
|
||||||
getStaticDevices :: RofiIO MountConf ([CIFS], [SSHFS], [VeraCrypt])
|
|
||||||
getStaticDevices = do
|
|
||||||
static <- asks mountconfStaticDevs
|
|
||||||
maybe (return ( [] :: [CIFS], [] :: [SSHFS], [] :: [VeraCrypt]))
|
|
||||||
(\c -> liftM3 (,,)
|
|
||||||
(fromConfig c _cifsConfigs)
|
|
||||||
(fromConfig c _sshfsConfigs)
|
|
||||||
(fromConfig c _veracryptConfigs))
|
|
||||||
static
|
|
||||||
|
|
||||||
mkGroup :: Mountable d => String -> [d] -> RofiIO MountConf (RofiGroup MountConf)
|
mkGroup :: Mountable d => String -> [d] -> RofiIO MountConf (RofiGroup MountConf)
|
||||||
mkGroup header devs = sortGroup header <$> mapM mkAction devs
|
mkGroup header devs = sortGroup header <$> mapM mkAction devs
|
||||||
|
@ -517,17 +441,6 @@ instance Mountable CIFS where
|
||||||
|
|
||||||
fmtEntry (CIFS r _ _ _) = fmtEntry r
|
fmtEntry (CIFS r _ _ _) = fmtEntry r
|
||||||
|
|
||||||
instance StaticDevice CIFS CIFSConfig where
|
|
||||||
configToDev v s CIFSConfig { _cifsMount = MountConfig { _mountMountPoint = m }
|
|
||||||
, _cifsRemote = t
|
|
||||||
, _cifsDepends = d
|
|
||||||
, _cifsPassword = p } = do
|
|
||||||
let r = Removable { deviceSpec = smartSlashPrefix t, label = takeFileName m }
|
|
||||||
d' <- maybe (return initDependencies) (getDependencies s) d
|
|
||||||
return $ CIFS r (appendRoot v m) (configToPwd <$> p) d'
|
|
||||||
where
|
|
||||||
smartSlashPrefix a = if "//" `isPrefixOf` a then a else "//" ++ a
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | SSHFS Devices
|
-- | SSHFS Devices
|
||||||
--
|
--
|
||||||
|
@ -554,14 +467,6 @@ instance Mountable SSHFS where
|
||||||
|
|
||||||
fmtEntry (SSHFS r _ _) = fmtEntry r
|
fmtEntry (SSHFS r _ _) = fmtEntry r
|
||||||
|
|
||||||
instance StaticDevice SSHFS SSHFSConfig where
|
|
||||||
configToDev v s SSHFSConfig { _sshfsMount = MountConfig { _mountMountPoint = m }
|
|
||||||
, _sshfsDepends = d
|
|
||||||
, _sshfsRemote = t } = do
|
|
||||||
let r = Removable { deviceSpec = t, label = takeFileName m }
|
|
||||||
d' <- maybe (return initDependencies) (getDependencies s) d
|
|
||||||
return $ SSHFS r (appendRoot v m) d'
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | VeraCrypt Devices
|
-- | VeraCrypt Devices
|
||||||
--
|
--
|
||||||
|
@ -601,14 +506,36 @@ runVeraCrypt stdin args = do
|
||||||
where
|
where
|
||||||
defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"]
|
defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"]
|
||||||
|
|
||||||
instance StaticDevice VeraCrypt VeracryptConfig where
|
data Triple a b c = First a | Second b | Third c deriving Show
|
||||||
|
|
||||||
|
type DevTriple = Triple CIFS SSHFS VeraCrypt
|
||||||
|
|
||||||
|
-- TODO abstract parts of this away in new typeclass for static devices
|
||||||
|
configToDev :: FilePath -> M.Map String DeviceConfig -> DeviceConfig
|
||||||
|
-> RofiIO MountConf DevTriple
|
||||||
|
configToDev v s CIFSConfig { _cifsMount = MountConfig { _mountMountPoint = m }
|
||||||
|
, _cifsRemote = t
|
||||||
|
, _cifsDepends = d
|
||||||
|
, _cifsPassword = p } = do
|
||||||
|
-- stuff like this is totally refactorable
|
||||||
|
let r = Removable { deviceSpec = smartSlashPrefix t, label = takeFileName m }
|
||||||
|
d' <- getDependencies s $ V.toList d
|
||||||
|
return $ First $ CIFS r (appendRoot v m) (configToPwd <$> p) d'
|
||||||
|
where
|
||||||
|
smartSlashPrefix a = if "//" `isPrefixOf` a then a else "//" ++ a
|
||||||
|
configToDev v s SSHFSConfig { _sshfsMount = MountConfig { _mountMountPoint = m }
|
||||||
|
, _sshfsDepends = d
|
||||||
|
, _sshfsRemote = t } = do
|
||||||
|
let r = Removable { deviceSpec = t, label = takeFileName m }
|
||||||
|
d' <- getDependencies s $ V.toList d
|
||||||
|
return $ Second $ SSHFS r (appendRoot v m) d'
|
||||||
configToDev v s VeracryptConfig { _veracryptMount = MountConfig { _mountMountPoint = m }
|
configToDev v s VeracryptConfig { _veracryptMount = MountConfig { _mountMountPoint = m }
|
||||||
, _veracryptVolume = t
|
, _veracryptVolume = t
|
||||||
, _veracryptDepends = d
|
, _veracryptDepends = d
|
||||||
, _veracryptPassword = p } = do
|
, _veracryptPassword = p } = do
|
||||||
let r = Removable { deviceSpec = t, label = takeFileName m }
|
let r = Removable { deviceSpec = t, label = takeFileName m }
|
||||||
d' <- maybe (return initDependencies) (getDependencies s) d
|
d' <- getDependencies s $ V.toList d
|
||||||
return $ VeraCrypt r (appendRoot v m) (configToPwd <$> p) d'
|
return $ Third $ VeraCrypt r (appendRoot v m) (configToPwd <$> p) d'
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Dependencies
|
-- | Dependencies
|
||||||
|
@ -624,24 +551,13 @@ data Dependency = Dependency
|
||||||
, dependencyVeracrypt :: [VeraCrypt]
|
, dependencyVeracrypt :: [VeraCrypt]
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
initDependencies :: Dependency
|
getDependencies :: M.Map String DeviceConfig -> [String] -> RofiIO MountConf Dependency
|
||||||
initDependencies = Dependency [] [] []
|
getDependencies devMap aliases = do
|
||||||
|
(c, s, v) <- fmap foldTriples
|
||||||
getDependencies :: DevicesConfig -> DependsConfig -> RofiIO MountConf Dependency
|
$ fromConfig $ M.filterWithKey (\k _ -> k `elem` aliases) devMap
|
||||||
getDependencies devConf DependsConfig { _dependsCIFS = c
|
return Dependency { dependencyCIFS = c
|
||||||
, _dependsSSHFS = s
|
, dependencySSHFS = s
|
||||||
, _dependsVeracrypt = v} = do
|
, dependencyVeracrypt = v}
|
||||||
c' <- getDepConfigs c _cifsConfigs
|
|
||||||
s' <- getDepConfigs s _sshfsConfigs
|
|
||||||
v' <- getDepConfigs v _veracryptConfigs
|
|
||||||
return Dependency
|
|
||||||
{ dependencyCIFS = c'
|
|
||||||
, dependencySSHFS = s'
|
|
||||||
, dependencyVeracrypt = v'
|
|
||||||
}
|
|
||||||
where
|
|
||||||
getDepConfigs aliases getConfig = fromConfig' devConf
|
|
||||||
$ M.elems . M.filterWithKey (\k _ -> k `elem` V.toList aliases) . getConfig
|
|
||||||
|
|
||||||
mountDependencies :: Dependency -> RofiIO MountConf ()
|
mountDependencies :: Dependency -> RofiIO MountConf ()
|
||||||
mountDependencies Dependency { dependencyCIFS = c
|
mountDependencies Dependency { dependencyCIFS = c
|
||||||
|
|
Loading…
Reference in New Issue