added migration script

Migration/0.0.0-0.0.1/Migration.hs

@@ -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

yammat.cabal

@@ -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