+setSysConf :: forall m a. (MonadIO m, SysConfValue a) => SystemConfig -> String -> a -> m StatusCode
+setSysConf sc userID value
+ = liftIO $
+ do let path = confPath (undefined :: a)
+
+ current <- getSysConf sc
+ if current == value
+ then return NotModified
+ else do atomically $ do cache <- readTVar (scCache sc)
+ writeTVar (scCache sc) (M.delete path cache)
+ setSysConf' sc userID value
+
+
+setSysConf' :: forall a. SysConfValue a => SystemConfig -> String -> a -> IO StatusCode
+setSysConf' sc userID value
+ = do let path = fromConfPath $ confPath (undefined :: a)
+ str = L.pack $ encode $ serialize value ++ "\n"
+ repos = scRepository sc
+ fs <- getRepositoryFS repos
+ rev <- getYoungestRev fs
+ ret <- doReposTxn
+ repos
+ rev
+ userID
+ (Just "Automatic commit by Rakka for systemConfig update")
+ $ do exists <- isFile path
+ unless exists
+ $ createValueEntry path
+ applyTextLBS path Nothing str
+ case ret of
+ Left _ -> return Conflict
+ Right _ -> do debugM logger ("Set a config value at `" ++ path ++ "': " ++ show value)
+ return Created
+ where
+ createValueEntry :: FilePath -> Txn ()
+ createValueEntry path
+ = do createParentDirectories path
+ makeFile path
+
+ createParentDirectories :: FilePath -> Txn ()
+ createParentDirectories path
+ = do let parentPath = takeDirectory path
+ kind <- checkPath parentPath
+ case kind of
+ NoNode -> do createParentDirectories parentPath
+ makeDirectory parentPath
+ FileNode -> fail ("createParentDirectories: already exists a file: " ++ parentPath)
+ DirNode -> return ()
+
+