From 2e5e64feae9beef7f75b06a9738f1a281f3449e3 Mon Sep 17 00:00:00 2001
From: Mats Rauhala <mats.rauhala@iki.fi>
Date: Thu, 2 Aug 2018 23:33:47 +0300
Subject: [PATCH] Migrations

---
 ebook-manager.cabal                |  5 +++++
 migrations/V1__Initial_databas.sql |  5 +++++
 src/Main.hs                        | 21 ++++++++++++++++++++-
 3 files changed, 30 insertions(+), 1 deletion(-)
 create mode 100644 migrations/V1__Initial_databas.sql

diff --git a/ebook-manager.cabal b/ebook-manager.cabal
index 5b09cf9..695868d 100644
--- a/ebook-manager.cabal
+++ b/ebook-manager.cabal
@@ -40,6 +40,7 @@ executable ebook-manager
                      , bytestring
                      , text
                      , pandoc
+                     , pandoc-types
                      , foreign-store
                      , warp
                      , wai
@@ -48,5 +49,9 @@ executable ebook-manager
                      , servant-lucid
                      , lens
                      , generic-lens
+                     , resource-pool
+                     , selda
+                     , selda-postgresql
+                     , process
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/migrations/V1__Initial_databas.sql b/migrations/V1__Initial_databas.sql
new file mode 100644
index 0000000..bfbc1f4
--- /dev/null
+++ b/migrations/V1__Initial_databas.sql
@@ -0,0 +1,5 @@
+create table users (
+  email varchar(64) primary key,
+  username varchar(64),
+  password varchar(64)
+);
diff --git a/src/Main.hs b/src/Main.hs
index 68be11e..edee1ba 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,16 +1,35 @@
 {-# Language OverloadedStrings #-}
+{-# Language RecordWildCards #-}
+{-# Language DuplicateRecordFields #-}
+{-# Language TypeApplications #-}
+{-# Language DataKinds #-}
 module Main where
 
 import Server (server)
 import Network.Wai.Handler.Warp (run)
 import Types
-import Configuration (Config)
+import Configuration
 import Dhall (input, auto)
+import System.Process (callProcess)
+import ClassyPrelude
+import Control.Lens (view)
+import Data.Generics.Product
 
 defaultMain :: Config -> IO ()
 defaultMain c = run 8080 (server (App c))
 
+migrate :: Pg -> IO ()
+migrate Pg{..} = do
+  -- Credentials visible on ps
+  -- XXX: Modify this to write the credentials to a temporary file or something
+  callProcess "flyway" $ fmap unpack [ "migrate"
+                                     , "-locations=filesystem:migrations/"
+                                     , "-url=jdbc:postgresql://" <> host <> "/" <> database
+                                     , "-user=" <> username
+                                     , "-password=" <> password]
+
 main :: IO ()
 main = do
   c <- input auto "./config/config.dhall"
+  migrate (view (field @"database") c)
   defaultMain c