mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[db] Update interactiveUserAdd for remote state

Browse source
This commit is contained in:
Vincent Ambo 2015-11-21 02:59:03 +01:00
parent 30e9f29fe1
commit 7610e79013
No known key found for this signature in database
GPG key ID: 66F505681DB8F43B
1 changed files with 25 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
src/BlogDB.hs
View file

@ -1,20 +1,20 @@
module BlogDB where module BlogDB where
import Control.Monad.Reader (ask) import Control.Monad.Reader (ask)
import Control.Monad.State (get, put) import Control.Monad.State (get, put)
import Data.Acid import Data.Acid
import Data.Acid.Advanced import Data.Acid.Advanced
import Data.Acid.Local import Data.Acid.Remote
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Data (Data, Typeable) import Data.Data (Data, Typeable)
import Data.IxSet (Indexable (..), IxSet (..), Proxy (..), import Data.IxSet (Indexable (..), IxSet (..), Proxy (..), getOne, ixFun, ixSet, (@=))
getOne, ixFun, ixSet, (@=)) import Data.List (insert)
import Data.List (insert) import Data.SafeCopy (SafeCopy, base, deriveSafeCopy)
import Data.SafeCopy (SafeCopy, base, deriveSafeCopy) import Data.Text (Text, pack)
import Data.Text (Text, pack) import Data.Text.Lazy (toStrict)
import Data.Text.Lazy (toStrict) import Data.Time
import Data.Time import Network (PortID (..))
import System.Environment (getEnv) import System.Environment (getEnv)
import qualified Crypto.Hash.SHA512 as SHA (hash) import qualified Crypto.Hash.SHA512 as SHA (hash)
import qualified Data.ByteString.Base64 as B64 (encode) import qualified Data.ByteString.Base64 as B64 (encode)
@ -22,7 +22,6 @@ import qualified Data.ByteString.Char8 as B
import qualified Data.IxSet as IxSet import qualified Data.IxSet as IxSet
import qualified Data.Text as Text import qualified Data.Text as Text
newtype EntryId = EntryId { unEntryId :: Integer } newtype EntryId = EntryId { unEntryId :: Integer }
deriving (Eq, Ord, Data, Enum, Typeable) deriving (Eq, Ord, Data, Enum, Typeable)
@ -41,13 +40,13 @@ instance Show BlogLang where
$(deriveSafeCopy 0 'base ''BlogLang) $(deriveSafeCopy 0 'base ''BlogLang)
data Entry = Entry { data Entry = Entry {
entryId :: EntryId, entryId :: EntryId,
lang :: BlogLang, lang :: BlogLang,
author :: Text, author :: Text,
title :: Text, title :: Text,
btext :: Text, btext :: Text,
mtext :: Text, mtext :: Text,
edate :: UTCTime edate :: UTCTime
} deriving (Eq, Ord, Show, Data, Typeable) } deriving (Eq, Ord, Show, Data, Typeable)
$(deriveSafeCopy 2 'base ''Entry) $(deriveSafeCopy 2 'base ''Entry)
@ -201,10 +200,9 @@ $(makeAcidic ''Blog
, 'clearSessions , 'clearSessions
]) ])
interactiveUserAdd :: IO () interactiveUserAdd :: String -> IO ()
interactiveUserAdd = do interactiveUserAdd dbHost = do
tbDir <- getEnv "TAZBLOG" acid <- openRemoteState skipAuthenticationPerform dbHost (PortNumber 8070)
acid <- openLocalStateFrom (tbDir ++ "/BlogState") initialBlogState
putStrLn "Username:" putStrLn "Username:"
un <- getLine un <- getLine
putStrLn "Password:" putStrLn "Password:"