added migration script

This commit is contained in:
nek0 2015-09-17 15:27:53 +02:00
parent ae567528d5
commit 3e783aafa2
2 changed files with 61 additions and 0 deletions

View File

@ -0,0 +1,49 @@
import Database.HDBC
import Database.HDBC.PostgreSQL
import System.IO
import Control.Exception
import Data.ByteString.Base64
import qualified Crypto.Hash.SHA3 as SHA3
main :: IO ()
main = do
putStrLn "Enter database host"
dbHost <- getLine
putStrLn "Enter database port"
dbPort <- getLine
putStrLn "Enter database user"
dbUser <- getLine
putStrLn "Enter database name"
dbName <- getLine
putStrLn "Enter database password"
dbPasswd <- getPasswd
let dbString = "host=" ++ dbHost ++ " port=" ++ dbPort ++ " user=" ++ dbUser ++ " dbname=" ++ dbName ++ " password=" ++ dbPasswd
conn <- connectPostgreSQL dbString
stmt1 <- prepare conn "select * from avatar where hash = 'fill_me!'"
_ <- execute stmt1 []
rows <- fetchAllRowsAL stmt1
tups <- return $ map (\entry ->
case entry of
[("id", theId), ("ident", _), ("data", SqlByteString theData), ("hash", _)] ->
[SqlByteString $ encode $ SHA3.hash 8 theData, theId]
_ ->
error "malformed entry"
) rows
stmt2 <- prepare conn "update avatar set hash = ? where id = ?"
executeMany stmt2 tups
commit conn
disconnect conn
putStrLn "Migration successfull!!"
getPasswd :: IO String
getPasswd = do
putStr "Password: "
hFlush stdout
pass <- withEcho False getLine
putChar '\n'
return pass
withEcho :: Bool -> IO a -> IO a
withEcho echo action = do
old <- hGetEcho stdin
bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action

View File

@ -113,6 +113,18 @@ executable yammat
ghc-options: -threaded -O2 -rtsopts -with-rtsopts=-N
executable Migrate1
main-is: Migration.hs
hs-source-dirs: Migration/0.0.0-0.0.1
ghc-options: -Wall
build-depends: base
, HDBC
, HDBC-postgresql
, bytestring
, cryptohash
, base64-bytestring
test-suite test
type: exitcode-stdio-1.0
main-is: Spec.hs