diff options
author | Vincent Ambo <v.ambo@me.com> | 2012-03-13T20·29+0100 |
---|---|---|
committer | Vincent Ambo <v.ambo@me.com> | 2012-03-13T20·29+0100 |
commit | f6446aec725234ea38b5431defa8e4c987e07f20 (patch) | |
tree | cf4395955a9f54306d24407c9fe4637ae29e7c7a /src/BlogDB.hs | |
parent | eaa9ed5b981375167d3c0f31d6eeff84a397e547 (diff) |
* added flushSessions :: IO()
* updated TODO
Diffstat (limited to 'src/BlogDB.hs')
-rw-r--r-- | src/BlogDB.hs | 14 |
1 files changed, 14 insertions, 0 deletions
diff --git a/src/BlogDB.hs b/src/BlogDB.hs index 9bffd79c3b30..d5a964da8a5a 100644 --- a/src/BlogDB.hs +++ b/src/BlogDB.hs @@ -168,6 +168,12 @@ getSession sId = do b@Blog{..} <- ask return $ getOne $ blogSessions @= sId +clearSessions :: Update Blog [Session] +clearSessions = + do b@Blog{..} <- get + put $ b { blogSessions = empty } + return [] + addUser :: Text -> String -> Update Blog User addUser un pw = do b@Blog{..} <- get @@ -203,6 +209,7 @@ $(makeAcidic ''Blog , 'addUser , 'getUser , 'checkUser + , 'clearSessions ]) interactiveUserAdd :: IO () @@ -215,3 +222,10 @@ interactiveUserAdd = do pw <- getLine update' acid (AddUser (pack un) pw) createCheckpointAndClose acid + +flushSessions :: IO () +flushSessions = do + tbDir <- getEnv "TAZBLOG" + acid <- openLocalStateFrom (tbDir ++ "/BlogState") initialBlogState + update' acid (ClearSessions) + createCheckpointAndClose acid |