FIX don't use partial fields

This commit is contained in:
Nathan Dwarshuis 2022-07-31 20:30:27 -04:00
parent 5fb8b404dc
commit f84407b793
2 changed files with 44 additions and 22 deletions

View File

@ -332,13 +332,22 @@ instance FromJSON CIFSOptsConfig where
<*> o .:? "gid" <*> o .:? "gid"
<*> o .:? "isocharset" <*> o .:? "isocharset"
data DataConfig = VeracryptConfig data DataConfig = VeracryptConfig VeracryptData
| SSHFSConfig SSHFSData
| CIFSConfig CIFSData
deriving Show
data VeracryptData = VeracryptData
{ veracryptVolume :: String { veracryptVolume :: String
, veracryptPassword :: Maybe PasswordConfig , veracryptPassword :: Maybe PasswordConfig
} | SSHFSConfig } deriving Show
data SSHFSData = SSHFSData
{ sshfsRemote :: String { sshfsRemote :: String
, sshfsPassword :: Maybe PasswordConfig , sshfsPassword :: Maybe PasswordConfig
} | CIFSConfig } deriving Show
data CIFSData = CIFSData
{ cifsRemote :: String { cifsRemote :: String
, cifsSudo :: Bool , cifsSudo :: Bool
, cifsPassword :: Maybe PasswordConfig , cifsPassword :: Maybe PasswordConfig
@ -361,17 +370,17 @@ instance FromJSON TreeConfig where
deps <- o .:& "depends" deps <- o .:& "depends"
mountconf <- o .: "mount" mountconf <- o .: "mount"
devData <- case (devType :: String) of devData <- case (devType :: String) of
"cifs" -> CIFSConfig "cifs" -> CIFSConfig <$> (CIFSData
<$> o .: "remote" <$> o .: "remote"
<*> o .:? "sudo" .!= False <*> o .:? "sudo" .!= False
<*> o .:? "password" <*> o .:? "password"
<*> o .:? "options" <*> o .:? "options")
"sshfs" -> SSHFSConfig "sshfs" -> SSHFSConfig <$> (SSHFSData
<$> o .: "remote" <$> o .: "remote"
<*> o .:? "password" <*> o .:? "password")
"veracrypt" -> VeracryptConfig "veracrypt" -> VeracryptConfig <$> (VeracryptData
<$> o .: "volume" <$> o .: "volume"
<*> o .:? "password" <*> o .:? "password")
-- TODO make this skip adding an entry to the map rather than -- TODO make this skip adding an entry to the map rather than
-- skipping the map entirely -- skipping the map entirely
_ -> fail $ "unknown device type: " ++ devType _ -> fail $ "unknown device type: " ++ devType
@ -423,9 +432,9 @@ instance Mountable a => Mountable (Tree a) where
instance Actionable (Tree DeviceConfig) where instance Actionable (Tree DeviceConfig) where
fmtEntry (Tree p@DeviceConfig{ deviceData = d } _) = [getLabel p, target d] fmtEntry (Tree p@DeviceConfig{ deviceData = d } _) = [getLabel p, target d]
where where
target CIFSConfig{ cifsRemote = r } = r target (CIFSConfig (CIFSData { cifsRemote = r })) = r
target SSHFSConfig{ sshfsRemote = r } = r target (SSHFSConfig (SSHFSData { sshfsRemote = r })) = r
target VeracryptConfig{ veracryptVolume = v } = v target (VeracryptConfig (VeracryptData { veracryptVolume = v })) = v
groupHeader (Tree DeviceConfig{ deviceData = d } _) = groupHeader (Tree DeviceConfig{ deviceData = d } _) =
case d of case d of
@ -458,21 +467,26 @@ instance Mountable DeviceConfig where
withTmpMountDir m' withTmpMountDir m'
$ io $ io
$ case devData of $ case devData of
SSHFSConfig{ sshfsRemote = r, sshfsPassword = p } -> mountSSHFS m' p r SSHFSConfig (SSHFSData { sshfsRemote = r, sshfsPassword = p }) ->
CIFSConfig mountSSHFS m' p r
{ cifsRemote = r CIFSConfig (CIFSData
, cifsSudo = s { cifsRemote = r
, cifsPassword = p , cifsSudo = s
, cifsOpts = o , cifsPassword = p
} -> mountCIFS s r m' o p , cifsOpts = o
VeracryptConfig{ veracryptPassword = p, veracryptVolume = v } -> }) ->
mountCIFS s r m' o p
VeracryptConfig (VeracryptData
{ veracryptPassword = p
, veracryptVolume = v
}) ->
mountVeracrypt m' p v mountVeracrypt m' p v
mount DeviceConfig{ deviceMount = m, deviceData = d } True = do mount DeviceConfig{ deviceMount = m, deviceData = d } True = do
m' <- getAbsMountpoint m m' <- getAbsMountpoint m
runAndRemoveDir m' $ io $ case d of runAndRemoveDir m' $ io $ case d of
CIFSConfig{ cifsSudo = s } -> runMountSudoMaybe s "umount" [m'] CIFSConfig (CIFSData { cifsSudo = s }) -> runMountSudoMaybe s "umount" [m']
VeracryptConfig{} -> runVeraCrypt ["-d", m'] "" VeracryptConfig _ -> runVeraCrypt ["-d", m'] ""
_ -> runMount "umount" [m'] "" _ -> runMount "umount" [m'] ""
allInstalled DeviceConfig{ deviceData = devData } = io $ isJust allInstalled DeviceConfig{ deviceData = devData } = io $ isJust

View File

@ -47,6 +47,7 @@ library:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
exposed-modules: exposed-modules:
- Bitwarden.Internal - Bitwarden.Internal
- Rofi.Command - Rofi.Command
@ -59,6 +60,7 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras
@ -69,6 +71,7 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras
@ -79,6 +82,7 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras
@ -89,6 +93,7 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras
@ -99,6 +104,7 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras
@ -109,6 +115,7 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras
@ -119,5 +126,6 @@ executables:
- -Wall - -Wall
- -Werror - -Werror
- -threaded - -threaded
- -Wpartial-fields
dependencies: dependencies:
- rofi-extras - rofi-extras