diff --git a/hbs2-peer/app/PeerConfig.hs b/hbs2-peer/app/PeerConfig.hs index 9ca18af3..9d1dd7a7 100644 --- a/hbs2-peer/app/PeerConfig.hs +++ b/hbs2-peer/app/PeerConfig.hs @@ -135,7 +135,7 @@ peerConfigRead mbfp = do confData' <- parseConf cfgPath - knownPeersFiles <- mapM (liftIO . canonicalizePath . (dir )) (cfgValue @PeerKnownPeersFile $ PeerConfig confData') + knownPeersFiles <- mapM (canonicalizePath' dir) (cfgValue @PeerKnownPeersFile $ PeerConfig confData') knownPeersConfData <- concat <$> mapM parseConf knownPeersFiles @@ -143,23 +143,21 @@ peerConfigRead mbfp = do -- debug $ pretty confData - config <- flip transformBiM confData $ \case - List co (Key "key" [LitStrVal p]) -> do - kp <- liftIO $ canonicalizePath (dir Text.unpack p) - pure $ List @C co [Symbol co "key", Literal co (mkLit (Text.pack kp)) ] - - List co (Key "storage" [LitStrVal p]) -> do - kp <- liftIO $ canonicalizePath (dir Text.unpack p) - pure $ List @C co [Symbol co "storage", Literal co (mkLit (Text.pack kp)) ] - - List co (Key "download-log" [LitStrVal p]) -> do - kp <- liftIO $ canonicalizePath (dir Text.unpack p) - pure $ List @C co [Symbol co "download-log", Literal co (mkLit (Text.pack kp)) ] - - x -> pure x + config <- transformBiM (canonicalizeConfPaths ["key", "storage", "download"] dir) confData pure $ PeerConfig config + where + canonicalizePath' :: MonadIO m => FilePath -> FilePath -> m FilePath + canonicalizePath' dir = liftIO . canonicalizePath . (dir ) + canonicalizeConfPaths :: MonadIO m => [Id] -> FilePath -> Syntax C -> m (Syntax C) + canonicalizeConfPaths keys dir x@(List co (Key k [LitStrVal path])) = + if k `elem` keys + then do + canonicalPath <- canonicalizePath' dir $ Text.unpack path + pure $ List @C co [Symbol co k, Literal co (mkLit (Text.pack canonicalPath))] + else pure x + canonicalizeConfPaths _ _ x = pure x instance {-# OVERLAPPABLE #-} (IsString b, HasCfgKey a (Maybe b)) => HasCfgValue a (Maybe b) where cfgValue (PeerConfig syn) = val