Migrate and setup database automatically

.guix/modules/datarekisteri-package.scm

@@ -1,10 +1,13 @@
 (define-module (datarekisteri-package)
   #:use-module (guix)
+  #:use-module (guix build-system go)
   #:use-module (guix build-system haskell)
   #:use-module (guix download)
   #:use-module (guix git-download)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
+  #:use-module (gnu packages golang)
+  #:use-module (gnu packages syncthing)
   #:use-module (gnu packages haskell)
   #:use-module (gnu packages haskell-check)
   #:use-module (gnu packages haskell-crypto)
@@ -23,7 +26,8 @@
                         #:recursive? #t
                         #:select? vcs-file?))
     (build-system haskell-build-system)
-    (inputs (list ghc-base64
+    (inputs (list dbmate
+                  ghc-base64
                   ghc-cryptonite
                   ghc-email-validate
                   ghc-esqueleto
@@ -39,6 +43,15 @@
                   ghc-yesod
                   ghc-yesod-static
                   ghc-yesod-auth))
+    (arguments
+     (list
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'install 'wrap-binaries
+            (lambda _
+              (wrap-program
+                (string-append #$output "/bin/datarekisteri")
+                `("PATH" prefix (,(string-append #$(this-package-input "dbmate") "/bin")))))))))
     (home-page "")
     (synopsis "")
     (description "")
@@ -691,4 +704,233 @@ please see: <http://www.stackage.org/package/mime-mail>.")
 README for more information.")
     (license license:bsd-3)))
 
+(define-public go-github-com-jmoiron-sqlx
+  (package
+    (name "go-github-com-jmoiron-sqlx")
+    (version "1.3.5")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/jmoiron/sqlx")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "09snd3gfi3sm3gib7jdc6p8zxpn2ah0isqnibbag6f63k473yj14"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/jmoiron/sqlx"))
+    (propagated-inputs
+     (list go-github-com-mattn-go-sqlite3
+           go-github-com-lib-pq
+           go-github-com-go-sql-driver-mysql))
+    (home-page "https://github.com/jmoiron/sqlx")
+    (synopsis "sqlx")
+    (description
+     "Package sqlx provides general purpose extensions to database/sql.")
+    (license license:expat)))
+
+(define-public go-github-com-pierrec-lz4
+  (package
+    (name "go-github-com-pierrec-lz4")
+    (version "v2.0.5+incompatible")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/pierrec/lz4")
+                    (commit (go-version->git-ref version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0y5rh7z01zycd59nnjpkqq0ydyjmcg9j1xw15q1i600l9j9g617p"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/pierrec/lz4"))
+    (home-page "https://github.com/pierrec/lz4")
+    (synopsis "lz4 : LZ4 compression in pure Go")
+    (description
+     "Package lz4 implements reading and writing lz4 compressed data (a frame), as
+specified in
+@url{http://fastcompression.blogspot.fr/2013/04/lz4-streaming-format-final.html,http://fastcompression.blogspot.fr/2013/04/lz4-streaming-format-final.html}.")
+    (license license:bsd-3)))
+
+(define-public go-github-com-clickhouse-clickhouse-go
+  (package
+    (name "go-github-com-clickhouse-clickhouse-go")
+    (version "1.5.4")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/ClickHouse/clickhouse-go")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "15yf96mx3fkjyyasb8gjw6ml476k9qacp54bdjrb14pafz3p3rgf"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/ClickHouse/clickhouse-go"
+       #:tests? #f))
+    (propagated-inputs
+     (list go-github-com-stretchr-testify
+           go-github-com-pierrec-lz4
+           go-github-com-jmoiron-sqlx
+           go-github-com-cloudflare-golz4
+           go-github-com-bkaradzic-go-lz4))
+    (home-page "https://github.com/ClickHouse/clickhouse-go")
+    (synopsis "ClickHouse")
+    (description
+     "Golang SQL database driver for @url{https://clickhouse.yandex/,Yandex
+ClickHouse}")
+    (license license:expat)))
+
+(define-public go-github-com-joho-godotenv
+  (package
+    (name "go-github-com-joho-godotenv")
+    (version "1.4.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/joho/godotenv")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1036h59vyhb58n817az6yg0zw5wa87yb86i7fnbdq8cw46mnjgw8"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/joho/godotenv"))
+    (home-page "https://github.com/joho/godotenv")
+    (synopsis "GoDotEnv")
+    (description
+     "Package godotenv is a go port of the ruby dotenv library
+(@url{https://github.com/bkeepers/dotenv,https://github.com/bkeepers/dotenv})")
+    (license license:expat)))
+
+(define-public go-github-com-kami-zh-go-capturer
+  (package
+    (name "go-github-com-kami-zh-go-capturer")
+    (version "0.0.0-20211219060012-52ea6c8fed04")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/zenizh/go-capturer")
+                    (commit (go-version->git-ref version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0zwz9gr1863z32gz9nyysg66mg124w6nql4m99g2dg6fbq2klda4"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/kami-zh/go-capturer"))
+    (home-page "https://github.com/kami-zh/go-capturer")
+    (synopsis "go-capturer")
+    (description
+     "Capture @code{os.Stdout} and/or @code{os.Stderr} in Go.  This package is useful
+for writing tests which print some outputs using @code{fmt} package.")
+    (license license:expat)))
+
+(define-public go-github-com-cloudflare-golz4
+  (package
+    (name "go-github-com-cloudflare-golz4")
+    (version "0.0.0-20150217214814-ef862a3cdc58")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/cloudflare/golz4")
+                    (commit (go-version->git-ref version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0ckiwp3aa010sdnki6vd32f0n08768ppnggc8d7syzh3kkn9zvn1"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/cloudflare/golz4"
+       #:tests? #f))
+    (home-page "https://github.com/cloudflare/golz4")
+    (synopsis "golz4")
+    (description "Package lz4 implements compression using lz4.c and lz4hc.c")
+    (license license:bsd-3)))
+
+(define-public go-github-com-cpuguy83-go-md2man-v2
+  (package
+    (name "go-github-com-cpuguy83-go-md2man-v2")
+    (version "2.0.2")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/cpuguy83/go-md2man")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "19qri18cinpzxblkid6ngz2vcxslv73s1aid900q0gfzvc71mqqb"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/cpuguy83/go-md2man/v2"))
+    (propagated-inputs (list go-github-com-russross-blackfriday-v2))
+    (home-page "https://github.com/cpuguy83/go-md2man")
+    (synopsis "go-md2man")
+    (description "Converts markdown into roff (man pages).")
+    (license license:expat)))
+
+(define-public go-github-com-russross-blackfriday-v2
+  (package
+    (name "go-github-com-russross-blackfriday-v2")
+    (version "2.1.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/russross/blackfriday")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "0d1rg1drrfmabilqjjayklsz5d0n3hkf979sr3wsrw92bfbkivs7"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/russross/blackfriday/v2"))
+    (home-page "https://github.com/russross/blackfriday")
+    (synopsis "Blackfriday")
+    (description "Package blackfriday is a markdown processor.")
+    (license license:bsd-2)))
+
+(define-public dbmate
+  (package
+    (name "dbmate")
+    (version "1.15.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/amacneil/dbmate")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1dbhm2aqppn4m55xnx18017shsy109hqv2nhksxb4ix83bjaq5vq"))))
+    (build-system go-build-system)
+    (arguments
+     '(#:import-path "github.com/amacneil/dbmate"))
+    (propagated-inputs
+     (list go-gopkg-in-yaml-v3
+           go-github-com-russross-blackfriday-v2
+           go-github-com-pmezard-go-difflib
+           go-github-com-davecgh-go-spew
+           go-github-com-cpuguy83-go-md2man-v2
+           go-github-com-cloudflare-golz4
+           go-github-com-urfave-cli-v2
+           go-github-com-stretchr-testify
+           go-github-com-mattn-go-sqlite3
+           go-github-com-lib-pq
+           go-github-com-kami-zh-go-capturer
+           go-github-com-joho-godotenv
+           go-github-com-go-sql-driver-mysql
+           go-github-com-clickhouse-clickhouse-go))
+    (home-page "https://github.com/amacneil/dbmate")
+    (synopsis "Sql database migration tool")
+    (description
+     "Dbmate is a database migration tool, to keep your database schema in sync across
+multiple developers and your production servers.")
+    (license license:expat)))
+
 datarekisteri

datarekisteri.cabal

@@ -6,6 +6,8 @@ license: AGPL-3.0-or-later
 license-file: COPYING.md
 build-type: Simple
 stability: alpha
+data-files:
+  db/migrations/*.sql
 
 executable datarekisteri
   build-depends:
@@ -26,6 +28,7 @@ executable datarekisteri
     mtl,
     persistent,
     persistent-postgresql,
+    process,
     relude,
     scotty,
     smtp-mail,
@@ -58,6 +61,9 @@ executable datarekisteri
     Server.DB.Queries,
     Server.Email,
     Server.Types,
-    Server.Utils
+    Server.Utils,
+    Paths_datarekisteri
+  autogen-modules:
+    Paths_datarekisteri
   hs-source-dirs: src
   default-language: Haskell2010

src/Client.hs

@@ -19,12 +19,13 @@ import Client.Types
 import Client.Handlers
 import Client.Auth ()
 import Yesod.Static (static, Static)
+import Server (runMigrations)
 import System.Directory (createDirectoryIfMissing)
 
 mkYesodDispatch "DataIdClient" resourcesDataIdClient
 
 main :: IO ()
-main = getStaticDir "/tmp/data-id" >>= warp 3000 . DataIdClient
+main = runMigrations >> getStaticDir "/tmp/data-id" >>= warp 3000 . DataIdClient
 
 getStaticDir :: FilePath -> IO Static
 getStaticDir dir = createDirectoryIfMissing True dir >> static dir

src/Server.hs

@@ -25,12 +25,22 @@ import Server.DB
 import Server.DB.Queries (getUserByEmail, getPermissions, getToken)
 import Server.Types
 import Server.Utils (checkPassword)
+import System.Process (callProcess)
 import Web.Scotty.Trans hiding (readEither)
 import qualified "base64" Data.ByteString.Base64 as B64 (decodeBase64)
+import Paths_datarekisteri
 
 main :: IO ()
 main = run 3100 =<< serverApp
 
+dbUrl :: IsString a => a
+dbUrl = "postgres:///id.rekisteri"
+
+runMigrations :: IO ()
+runMigrations = do
+    migrationsPath <- getDataFileName "db/migrations"
+    callProcess "dbmate" ["--url", dbUrl, "--migrations-dir", migrationsPath, "up"]
+
 serverApp :: IO Application
 serverApp = scottyAppT runAPIM $ do
     middleware $ gzip def
@@ -119,7 +129,7 @@ instance MonadTime APIM where
     currentTime = liftIO currentTime
 
 instance MonadDB APIM where
-    runQuery = liftIO . runStderrLoggingT . withPostgresqlConn "postgres:///id.rekisteri" . runSqlConn
+    runQuery = liftIO . runStderrLoggingT . withPostgresqlConn dbUrl . runSqlConn
 
 instance MonadEmail APIM where
     sendEmail = liftIO . renderSendMail