never executed always true always false
1 module PureClaw.CLI.Import
2 ( -- * JSON5 preprocessing
3 stripJson5
4 -- * OpenClaw config parsing
5 , OpenClawConfig (..)
6 , OpenClawAgent (..)
7 , OpenClawSignal (..)
8 , OpenClawTelegram (..)
9 , parseOpenClawConfig
10 -- * $include resolution
11 , resolveIncludes
12 -- * Import execution
13 , importOpenClawConfig
14 , importOpenClawDir
15 , ImportResult (..)
16 , DirImportResult (..)
17 -- * CLI options
18 , ImportOptions (..)
19 , resolveImportOptions
20 -- * Utilities (exported for testing)
21 , camelToSnake
22 ) where
23
24 import Control.Exception (IOException, try)
25 import Control.Monad ((>=>))
26 import Data.Aeson
27 import Data.Aeson.Key qualified as Key
28 import Data.Aeson.KeyMap qualified as KM
29 import Data.Aeson.Types (Parser, parseEither, parseMaybe)
30 import Data.ByteString.Lazy qualified as LBS
31 import Data.Char qualified as Char
32 import Data.IORef
33 import Data.Maybe (fromMaybe)
34 import Data.Text (Text)
35 import Data.Text qualified as T
36 import Data.Text.Encoding qualified as TE
37 import Data.Text.IO qualified as TIO
38 import Data.Vector qualified as V
39 import System.Directory qualified as Dir
40 import System.FilePath ((</>), takeDirectory, takeExtension)
41
42 -- ---------------------------------------------------------------------------
43 -- JSON5 preprocessor
44 -- ---------------------------------------------------------------------------
45
46 -- | Strip JSON5 features (// comments, trailing commas) to produce valid JSON.
47 -- Handles comments inside strings correctly (does not strip them).
48 -- Does NOT handle: block comments, hex literals, multiline strings,
49 -- unquoted keys, or other advanced JSON5 features.
50 stripJson5 :: Text -> Text
51 stripJson5 = T.pack . go False . T.unpack
52 where
53 go :: Bool -> String -> String
54 go _ [] = []
55 go True ('\\' : c : rest) = '\\' : c : go True rest
56 go True ('"' : rest) = '"' : go False rest
57 go True (c : rest) = c : go True rest
58 go False ('"' : rest) = '"' : go True rest
59 go False ('/' : '/' : rest) = go False (dropWhile (/= '\n') rest)
60 go False (',' : rest)
61 | trailingComma rest = go False rest
62 go False (c : rest) = c : go False rest
63
64 trailingComma :: String -> Bool
65 trailingComma [] = True
66 trailingComma (c : rest)
67 | c `elem` (" \t\n\r" :: String) = trailingComma rest
68 | c == ']' || c == '}' = True
69 | otherwise = False
70
71 -- ---------------------------------------------------------------------------
72 -- OpenClaw config types
73 -- ---------------------------------------------------------------------------
74
75 data OpenClawConfig = OpenClawConfig
76 { _oc_defaultModel :: Maybe Text
77 , _oc_workspace :: Maybe Text
78 , _oc_agents :: [OpenClawAgent]
79 , _oc_signal :: Maybe OpenClawSignal
80 , _oc_telegram :: Maybe OpenClawTelegram
81 }
82 deriving stock (Show, Eq)
83
84 data OpenClawAgent = OpenClawAgent
85 { _oca_id :: Text
86 , _oca_systemPrompt :: Maybe Text
87 , _oca_model :: Maybe Text
88 , _oca_toolProfile :: Maybe Text
89 , _oca_workspace :: Maybe Text
90 }
91 deriving stock (Show, Eq)
92
93 data OpenClawSignal = OpenClawSignal
94 { _ocs_account :: Maybe Text
95 , _ocs_dmPolicy :: Maybe Text
96 , _ocs_allowFrom :: Maybe [Text]
97 }
98 deriving stock (Show, Eq)
99
100 data OpenClawTelegram = OpenClawTelegram
101 { _oct_botToken :: Maybe Text
102 , _oct_dmPolicy :: Maybe Text
103 , _oct_allowFrom :: Maybe [Text]
104 }
105 deriving stock (Show, Eq)
106
107 -- ---------------------------------------------------------------------------
108 -- OpenClaw config parsing
109 -- ---------------------------------------------------------------------------
110
111 parseOpenClawConfig :: Value -> Either String OpenClawConfig
112 parseOpenClawConfig = parseEither parseOC
113
114 parseOC :: Value -> Parser OpenClawConfig
115 parseOC = withObject "OpenClawConfig" $ \o -> do
116 mAgents <- o .:? "agents"
117 defaults <- maybe (pure emptyDefaults) parseDefaults mAgents
118 agents <- maybe (pure []) parseAgentList mAgents
119 mChannels <- o .:? "channels"
120 signal <- maybe (pure Nothing) (withObject "channels" (.:? "signal") >=> traverse parseSignalCfg) mChannels
121 telegram <- maybe (pure Nothing) (withObject "channels" (.:? "telegram") >=> traverse parseTelegramCfg) mChannels
122 pure OpenClawConfig
123 { _oc_defaultModel = fst defaults
124 , _oc_workspace = snd defaults
125 , _oc_agents = agents
126 , _oc_signal = signal
127 , _oc_telegram = telegram
128 }
129
130 emptyDefaults :: (Maybe Text, Maybe Text)
131 emptyDefaults = (Nothing, Nothing)
132
133 parseDefaults :: Value -> Parser (Maybe Text, Maybe Text)
134 parseDefaults = withObject "agents" $ \o -> do
135 mDefaults <- o .:? "defaults"
136 case mDefaults of
137 Nothing -> pure emptyDefaults
138 Just defVal -> flip (withObject "defaults") defVal $ \d -> do
139 mModelVal <- d .:? "model"
140 model <- case mModelVal of
141 Just (Object m) -> m .:? "primary"
142 Just (String s) -> pure (Just s)
143 _ -> pure Nothing
144 ws <- d .:? "workspace"
145 pure (model, ws)
146
147 parseAgentList :: Value -> Parser [OpenClawAgent]
148 parseAgentList = withObject "agents" $ \o -> do
149 mList <- o .:? "list"
150 case mList of
151 Nothing -> pure []
152 Just agents -> mapM parseAgentDef agents
153
154 parseAgentDef :: Value -> Parser OpenClawAgent
155 parseAgentDef = withObject "OpenClawAgent" $ \o -> do
156 agentId <- o .: "id"
157 systemPrompt <- o .:? "systemPrompt"
158 mModelVal <- o .:? "model"
159 let model = case mModelVal of
160 Just (Object m) -> parseMaybe (.: "primary") m
161 Just (String s) -> Just s
162 _ -> Nothing
163 mTools <- o .:? "tools"
164 let toolProfile = mTools >>= parseMaybe (withObject "tools" (.: "profile"))
165 ws <- o .:? "workspace"
166 pure OpenClawAgent
167 { _oca_id = agentId
168 , _oca_systemPrompt = systemPrompt
169 , _oca_model = model
170 , _oca_toolProfile = toolProfile
171 , _oca_workspace = ws
172 }
173
174 parseSignalCfg :: Value -> Parser OpenClawSignal
175 parseSignalCfg = withObject "signal" $ \o ->
176 OpenClawSignal <$> o .:? "account" <*> o .:? "dmPolicy" <*> o .:? "allowFrom"
177
178 parseTelegramCfg :: Value -> Parser OpenClawTelegram
179 parseTelegramCfg = withObject "telegram" $ \o ->
180 OpenClawTelegram <$> o .:? "botToken" <*> o .:? "dmPolicy" <*> o .:? "allowFrom"
181
182 -- ---------------------------------------------------------------------------
183 -- $include resolution
184 -- ---------------------------------------------------------------------------
185
186 -- | Resolve $include directives in a JSON Value, up to a max depth.
187 resolveIncludes :: Int -> FilePath -> Value -> IO Value
188 resolveIncludes maxDepth baseDir val
189 | maxDepth <= 0 = pure val
190 | otherwise = case val of
191 Object o -> case KM.lookup (Key.fromText "$include") o of
192 Just (String path) -> do
193 let fullPath = baseDir </> T.unpack path
194 included <- loadJson5File fullPath
195 case included of
196 Left _ -> pure val
197 Right inc -> resolveIncludes (maxDepth - 1) (takeDirectory fullPath) inc
198 Just (Array paths) -> do
199 resolved <- mapM (resolveIncludePath (maxDepth - 1) baseDir) (V.toList paths)
200 pure (foldl deepMerge (Object KM.empty) resolved)
201 _ -> do
202 resolved <- KM.traverseWithKey (\_ v -> resolveIncludes maxDepth baseDir v) o
203 pure (Object resolved)
204 _ -> pure val
205
206 resolveIncludePath :: Int -> FilePath -> Value -> IO Value
207 resolveIncludePath depth baseDir (String path) = do
208 let fullPath = baseDir </> T.unpack path
209 loaded <- loadJson5File fullPath
210 case loaded of
211 Left _ -> pure (Object KM.empty)
212 Right inc -> resolveIncludes depth (takeDirectory fullPath) inc
213 resolveIncludePath _ _ other = pure other
214
215 deepMerge :: Value -> Value -> Value
216 deepMerge (Object a) (Object b) = Object (KM.unionWith deepMerge a b)
217 deepMerge _ b = b
218
219 -- | Load and parse a JSON5 file.
220 loadJson5File :: FilePath -> IO (Either String Value)
221 loadJson5File path = do
222 result <- try @IOException (TIO.readFile path)
223 case result of
224 Left err -> pure (Left (show err))
225 Right text ->
226 let cleaned = stripJson5 text
227 bs = TE.encodeUtf8 cleaned
228 in pure (eitherDecodeStrict' bs)
229
230 -- ---------------------------------------------------------------------------
231 -- Import execution
232 -- ---------------------------------------------------------------------------
233
234 data ImportResult = ImportResult
235 { _ir_configWritten :: Bool
236 , _ir_agentsWritten :: [Text]
237 , _ir_skippedFields :: [Text]
238 , _ir_warnings :: [Text]
239 }
240 deriving stock (Show, Eq)
241
242 -- | Import an OpenClaw config file into PureClaw's directory structure.
243 -- Writes to @configDir/config.toml@ and @configDir/agents/*/AGENTS.md@.
244 importOpenClawConfig :: FilePath -> FilePath -> IO (Either Text ImportResult)
245 importOpenClawConfig openclawPath configDir = do
246 loaded <- loadJson5File openclawPath
247 case loaded of
248 Left err -> pure (Left ("Failed to parse OpenClaw config: " <> T.pack err))
249 Right rawJson -> do
250 resolved <- resolveIncludes 3 (takeDirectory openclawPath) rawJson
251 case parseOpenClawConfig resolved of
252 Left err -> pure (Left ("Failed to extract config fields: " <> T.pack err))
253 Right ocConfig -> writeImportedConfig configDir ocConfig
254
255 writeImportedConfig :: FilePath -> OpenClawConfig -> IO (Either Text ImportResult)
256 writeImportedConfig configDir ocConfig = do
257 Dir.createDirectoryIfMissing True configDir
258 let agentsDir = configDir </> "agents"
259
260 -- Write main config.toml
261 let configContent = buildConfigToml ocConfig
262 TIO.writeFile (configDir </> "config.toml") configContent
263
264 -- Write agent AGENTS.md files
265 agentNames <- mapM (writeAgentFile agentsDir) (_oc_agents ocConfig)
266
267 -- Write default agent if there are defaults
268 case (_oc_defaultModel ocConfig, _oc_workspace ocConfig) of
269 (Nothing, Nothing) -> pure ()
270 _ -> do
271 let defaultDir = agentsDir </> "default"
272 Dir.createDirectoryIfMissing True defaultDir
273 TIO.writeFile (defaultDir </> "AGENTS.md") $ T.unlines
274 [ "---"
275 , maybe "" ("model: " <>) (_oc_defaultModel ocConfig)
276 , maybe "" ("workspace: " <>) (_oc_workspace ocConfig)
277 , "---"
278 , ""
279 , "Default PureClaw agent."
280 ]
281
282 pure (Right ImportResult
283 { _ir_configWritten = True
284 , _ir_agentsWritten = agentNames
285 , _ir_skippedFields = []
286 , _ir_warnings = []
287 })
288
289 buildConfigToml :: OpenClawConfig -> Text
290 buildConfigToml oc = T.unlines $ concatMap (filter (not . T.null))
291 [ maybe [] (\m -> ["model = " <> quoted m]) (_oc_defaultModel oc)
292 , case _oc_signal oc of
293 Nothing -> []
294 Just sig ->
295 [ ""
296 , "[signal]"
297 ] ++ catMaybes
298 [ fmap (\a -> "account = " <> quoted a) (_ocs_account sig)
299 , fmap (\p -> "dm_policy = " <> quoted (camelToSnake p)) (_ocs_dmPolicy sig)
300 , fmap (\af -> "allow_from = " <> fmtList af) (_ocs_allowFrom sig)
301 ]
302 , case _oc_telegram oc of
303 Nothing -> []
304 Just tg ->
305 [ ""
306 , "[telegram]"
307 ] ++ catMaybes
308 [ fmap (\t -> "bot_token = " <> quoted t) (_oct_botToken tg)
309 , fmap (\p -> "dm_policy = " <> quoted (camelToSnake p)) (_oct_dmPolicy tg)
310 , fmap (\af -> "allow_from = " <> fmtList af) (_oct_allowFrom tg)
311 ]
312 ]
313 where
314 catMaybes = foldr (\x acc -> maybe acc (: acc) x) []
315
316 writeAgentFile :: FilePath -> OpenClawAgent -> IO Text
317 writeAgentFile agentsDir agent = do
318 let agentDir = agentsDir </> T.unpack (_oca_id agent)
319 Dir.createDirectoryIfMissing True agentDir
320 let frontmatterLines = filter (/= "")
321 [ maybe "" ("model: " <>) (_oca_model agent)
322 , maybe "" ("tool_profile: " <>) (_oca_toolProfile agent)
323 , maybe "" ("workspace: " <>) (_oca_workspace agent)
324 ]
325 hasFrontmatter = not (null frontmatterLines)
326 header = if hasFrontmatter
327 then ["---"] ++ frontmatterLines ++ ["---", ""]
328 else []
329 body = fromMaybe "" (_oca_systemPrompt agent)
330 TIO.writeFile (agentDir </> "AGENTS.md") (T.unlines (header ++ [body]))
331 pure (_oca_id agent)
332
333 quoted :: Text -> Text
334 quoted t = "\"" <> T.replace "\"" "\\\"" t <> "\""
335
336 fmtList :: [Text] -> Text
337 fmtList xs = "[" <> T.intercalate ", " (map quoted xs) <> "]"
338
339 camelToSnake :: Text -> Text
340 camelToSnake = T.concatMap $ \c ->
341 if Char.isAsciiUpper c
342 then T.pack ['_', Char.toLower c]
343 else T.singleton c
344
345 -- ---------------------------------------------------------------------------
346 -- CLI options for import command
347 -- ---------------------------------------------------------------------------
348
349 -- | Options for the import command.
350 data ImportOptions = ImportOptions
351 { _io_from :: Maybe FilePath
352 , _io_to :: Maybe FilePath
353 }
354 deriving stock (Show, Eq)
355
356 -- | Resolve import options: handle backward compat with a single positional arg.
357 -- If a positional arg is given:
358 -- - If it's a directory, use as --from
359 -- - If it's a .json file, use dirname as --from
360 -- Defaults: --from = ~/.openclaw, --to = ~/.pureclaw
361 resolveImportOptions :: ImportOptions -> Maybe FilePath -> IO (FilePath, FilePath)
362 resolveImportOptions opts mPositional = do
363 home <- Dir.getHomeDirectory
364 let defaultFrom = home </> ".openclaw"
365 defaultTo = home </> ".pureclaw"
366 fromDir <- case mPositional of
367 Just pos -> do
368 isDir <- Dir.doesDirectoryExist pos
369 if isDir
370 then pure pos
371 else if takeExtension pos == ".json"
372 then pure (takeDirectory pos)
373 else pure pos -- let it fail later with a clear error
374 Nothing -> pure (fromMaybe defaultFrom (_io_from opts))
375 let toDir = fromMaybe defaultTo (_io_to opts)
376 pure (fromDir, toDir)
377
378 -- ---------------------------------------------------------------------------
379 -- Full directory import
380 -- ---------------------------------------------------------------------------
381
382 -- | Result of a full OpenClaw directory import.
383 data DirImportResult = DirImportResult
384 { _dir_configResult :: ImportResult
385 , _dir_credentialsOk :: Bool
386 , _dir_deviceId :: Maybe Text
387 , _dir_workspacePath :: Maybe FilePath
388 , _dir_extraWorkspaces :: [FilePath]
389 , _dir_cronSkipped :: Bool
390 , _dir_modelsImported :: Bool
391 , _dir_warnings :: [Text]
392 }
393 deriving stock (Show, Eq)
394
395 -- | Import a full OpenClaw state directory into PureClaw.
396 importOpenClawDir :: FilePath -> FilePath -> IO (Either Text DirImportResult)
397 importOpenClawDir fromDir toDir = do
398 -- 1. Import openclaw.json → config.toml (existing logic)
399 let configPath = fromDir </> "openclaw.json"
400 configExists <- Dir.doesFileExist configPath
401 if not configExists
402 then pure (Left $ "No openclaw.json found in " <> T.pack fromDir)
403 else do
404 let configDir = toDir </> "config"
405 configResult <- importOpenClawConfig configPath configDir
406 case configResult of
407 Left err -> pure (Left err)
408 Right ir -> do
409 (addWarning, getWarnings) <- newWarnings
410
411 -- 2. Import auth-profiles.json → credentials.json
412 credOk <- importAuthProfiles fromDir toDir addWarning
413
414 -- 3. Import device.json → extract deviceId
415 mDeviceId <- importDeviceIdentity fromDir addWarning
416
417 -- 4. Find workspace path
418 let workspacePath = fromDir </> "workspace"
419 wsExists <- Dir.doesDirectoryExist workspacePath
420 let mWorkspace = if wsExists then Just workspacePath else Nothing
421
422 -- 5. Find extra workspace-* directories
423 extraWs <- findExtraWorkspaces fromDir
424
425 -- 6. Check for cron jobs
426 cronExists <- Dir.doesFileExist (fromDir </> "cron" </> "jobs.json")
427
428 -- 7. Import models.json
429 modelsOk <- importModels fromDir toDir addWarning
430
431 -- 8. Append workspace/identity sections to config.toml
432 appendConfigSections configDir mWorkspace mDeviceId extraWs
433
434 ws <- getWarnings
435
436 pure (Right DirImportResult
437 { _dir_configResult = ir
438 , _dir_credentialsOk = credOk
439 , _dir_deviceId = mDeviceId
440 , _dir_workspacePath = mWorkspace
441 , _dir_extraWorkspaces = extraWs
442 , _dir_cronSkipped = cronExists
443 , _dir_modelsImported = modelsOk
444 , _dir_warnings = ws
445 })
446
447 newWarnings :: IO (Text -> IO (), IO [Text])
448 newWarnings = do
449 ref <- newIORef []
450 let addW w = modifyIORef' ref (w :)
451 getW = reverse <$> readIORef ref
452 pure (addW, getW)
453
454 -- | Import auth-profiles.json → credentials.json
455 importAuthProfiles :: FilePath -> FilePath -> (Text -> IO ()) -> IO Bool
456 importAuthProfiles fromDir toDir addWarning = do
457 let authPath = fromDir </> "agents" </> "main" </> "agent" </> "auth-profiles.json"
458 loaded <- loadJson5File authPath
459 case loaded of
460 Left _ -> do
461 addWarning "auth-profiles.json not found — no credentials imported"
462 pure False
463 Right val -> do
464 let mProfiles = parseMaybe (withObject "auth" (.: "profiles")) val
465 case mProfiles of
466 Nothing -> do
467 addWarning "auth-profiles.json has no profiles field"
468 pure False
469 Just (Object profiles) -> do
470 let creds = KM.foldrWithKey extractCred [] profiles
471 if null creds
472 then do
473 addWarning "No API tokens found in auth-profiles.json"
474 pure False
475 else do
476 Dir.createDirectoryIfMissing True toDir
477 let credsJson = object (map (uncurry (.=)) creds)
478 LBS.writeFile (toDir </> "credentials.json") (encode credsJson)
479 pure True
480 _ -> do
481 addWarning "auth-profiles.json profiles field is not an object"
482 pure False
483 where
484 extractCred _key val acc =
485 case parseMaybe parseProfile val of
486 Just (provider, token) -> (Key.fromText provider, String token) : acc
487 Nothing -> acc
488
489 parseProfile = withObject "profile" $ \o -> do
490 provider <- o .: "provider"
491 token <- o .: "token"
492 pure (provider :: Text, token :: Text)
493
494 -- | Import device.json → extract deviceId
495 importDeviceIdentity :: FilePath -> (Text -> IO ()) -> IO (Maybe Text)
496 importDeviceIdentity fromDir addWarning = do
497 let devicePath = fromDir </> "identity" </> "device.json"
498 loaded <- loadJson5File devicePath
499 case loaded of
500 Left _ -> do
501 addWarning "identity/device.json not found — no device ID imported"
502 pure Nothing
503 Right val ->
504 case parseMaybe (withObject "device" (.: "deviceId")) val of
505 Just did -> pure (Just did)
506 Nothing -> do
507 addWarning "identity/device.json has no deviceId field"
508 pure Nothing
509
510 -- | Find extra workspace-* directories
511 findExtraWorkspaces :: FilePath -> IO [FilePath]
512 findExtraWorkspaces fromDir = do
513 entries <- try @IOException (Dir.listDirectory fromDir)
514 case entries of
515 Left _ -> pure []
516 Right es -> do
517 let candidates = filter ("workspace-" `T.isPrefixOf`) (map T.pack es)
518 dirs <- filterM (\e -> Dir.doesDirectoryExist (fromDir </> T.unpack e)) candidates
519 pure (map (\d -> fromDir </> T.unpack d) dirs)
520 where
521 filterM _ [] = pure []
522 filterM p (x:xs) = do
523 b <- p x
524 rest <- filterM p xs
525 if b then pure (x : rest) else pure rest
526
527 -- | Import models.json → models.json in toDir
528 importModels :: FilePath -> FilePath -> (Text -> IO ()) -> IO Bool
529 importModels fromDir toDir addWarning = do
530 let modelsPath = fromDir </> "agents" </> "main" </> "agent" </> "models.json"
531 loaded <- loadJson5File modelsPath
532 case loaded of
533 Left _ -> do
534 addWarning "agents/main/agent/models.json not found — no model overrides imported"
535 pure False
536 Right val -> do
537 Dir.createDirectoryIfMissing True toDir
538 LBS.writeFile (toDir </> "models.json") (encode val)
539 pure True
540
541 -- | Append workspace and identity sections to config.toml
542 appendConfigSections :: FilePath -> Maybe FilePath -> Maybe Text -> [FilePath] -> IO ()
543 appendConfigSections configDir mWorkspace mDeviceId extraWs = do
544 let configPath = configDir </> "config.toml"
545 exists <- Dir.doesFileExist configPath
546 if not exists
547 then pure ()
548 else do
549 existing <- TIO.readFile configPath
550 let sections = T.unlines $ concat
551 [ case mWorkspace of
552 Nothing -> []
553 Just ws ->
554 [ ""
555 , "[workspace]"
556 , "path = " <> quoted (T.pack ws)
557 ]
558 , case mDeviceId of
559 Nothing -> []
560 Just did ->
561 [ ""
562 , "[identity]"
563 , "device_id = " <> quoted did
564 ]
565 , if null extraWs then []
566 else
567 [ ""
568 , "# Additional OpenClaw workspaces found:"
569 ] ++ map (\ws -> "# workspace: " <> T.pack ws) extraWs
570 ]
571 TIO.writeFile configPath (existing <> sections)