Commits

Daniel Lyons committed 51642cb

initial import

Comments (0)

Files changed (6)

+Copyright (c)2012, Daniel Lyons
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Daniel Lyons nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+import Distribution.Simple
+main = defaultMain
+Name:                diabetoff
+Version:             0.1
+Synopsis:            Weight tracking website for my inlaws
+Homepage:            http://www.bitbucket.org/fusiongyro/diabetoff
+License:             BSD3
+License-file:        LICENSE
+Author:              Daniel Lyons
+Maintainer:          fusion@storytotell.org
+Category:            Web
+Build-type:          Simple
+
+Cabal-version:       >=1.2
+
+Executable diabetoff
+  Hs-Source-Dirs: src
+  Main-is: Main.hs
+  
+  Build-depends:       
+    HDBC >= 2.3.1.1 && < 2.4,
+    HDBC-postgresql >= 2.3.2.1 && < 2.4,
+    resource-pool >= 0.2.1.0 && < 0.3,
+    boomerang >= 1.3.1 && < 1.4,
+    web-routes-boomerang >= 0.26.0 && < 0.27,
+    happstack-server >= 7.0 && < 7.1,
+    web-routes-happstack >= 0.23.1 && < 0.24,
+    web-routes-th >= 0.21.1 && < 0.22,
+    text >= 0.11.1.5 && < 0.12,
+    containers >= 0.4.0.0 && < 0.5,
+    web-routes >= 0.27.1 && < 0.28,
+    blaze-html >= 0.4.3.1 && < 0.5,
+    mtl >= 2.0.1.0 && < 2.1,
+    haskell2010 >= 1.0.0.0 && < 1.1
+module Database where
+
+import Control.Applicative
+
+import Database.HDBC
+import Database.HDBC.PostgreSQL
+
+setupDatabase :: (IConnection c) => c -> IO ()
+setupDatabase dbh = do
+  version <- schemaVersion dbh
+  upgradeSchema version dbh
+  commit dbh
+
+schemaVersion :: (IConnection c) => c -> IO Integer
+schemaVersion dbh = do
+  tables <- getTables dbh
+  version <- if "schema_version" `elem` tables
+    then (fromSql . head . head) <$> quickQuery' dbh versionQuery []
+    else return 0
+  return version
+    where
+      versionQuery = "SELECT version FROM schema_version"
+
+upgradeSchema 0 dbh = do
+  runRaw dbh 
+         "CREATE EXTENSION pgcrypto;\n\
+         \\n\
+         \CREATE TABLE users (\n\
+         \  name VARCHAR PRIMARY KEY,\n\
+         \  password CHAR(60) NOT NULL,\n\
+         \  pwsalt CHAR(29) NOT NULL,\n\
+         \  target_weight INTEGER\n\
+         \);\n\
+         \\n\
+         \CREATE FUNCTION create_user(name VARCHAR, password VARCHAR) \
+         \RETURNS VARCHAR AS $$\n\
+         \  INSERT INTO users (name, password, pwsalt)\n\
+         \  SELECT $1 AS name, crypt($2, salt), salt\n\
+         \  FROM gen_salt('bf') AS salt\n\
+         \  RETURNING name\n\
+         \$$ LANGUAGE SQL;\n\
+         \\n\
+         \CREATE FUNCTION authenticate(name VARCHAR, password VARCHAR) \
+         \RETURNS BOOLEAN AS $$\n\
+         \  SELECT COUNT(*) = 1 FROM\n\
+         \    (SELECT * FROM users WHERE name = $1 AND \
+         \                               password = crypt($2, pwsalt)) t\n\
+         \$$ LANGUAGE SQL;\n\
+         \\n\
+         \CREATE TABLE weighins (\n\
+         \  name VARCHAR REFERENCES users,\n\
+         \  measured_on DATE,\n\
+         \  weight INTEGER NOT NULL,\n\
+         \  PRIMARY KEY (name, measured_on)\n\
+         \);\n\
+         \\n\
+         \CREATE TABLE schema_version (\n\
+         \  lock CHAR(1) PRIMARY KEY DEFAULT('X'),\n\
+         \  version INTEGER NOT NULL\n\
+         \  CHECK(lock = 'X')\n\
+         \);\n\
+         \\n\
+         \INSERT INTO schema_version (version) VALUES (1);"
+
+upgradeSchema 1 dbh = return ()
+
+upgradeSchema _ dbh = fail $ "Schema is too new for this version of the code"
+module Main where
+  
+main = putStrLn "Hello, world!"