ENH flatten config file using type key

This commit is contained in:
Nathan Dwarshuis 2021-03-20 14:00:47 -04:00
parent f09f646e13
commit 047d68a6d8
1 changed files with 88 additions and 172 deletions

View File

@ -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