Add CLI for admin operations

.guix-authorizations

@@ -0,0 +1,4 @@
+(authorizations
+ (version 0)
+ (("A0C9 1947 734F 076F 5F08 E9FF 257D 284A 2A1D 3A32"
+   (name "Saku Laesvuori"))))

.guix-channel

@@ -0,0 +1,4 @@
+(channel
+  (version 0)
+  (url "https://git.datat.fi/ry/datarekisteri.git")
+  (directory ".guix/modules"))

.guix/modules/datarekisteri-package.scm

@@ -0,0 +1,986 @@
+(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)
+  #:use-module (gnu packages haskell-web)
+  #:use-module (gnu packages haskell-xyz))
+
+(define vcs-file?
+  (or (git-predicate (string-append (current-source-directory) "/../.."))
+      (const #t)))
+
+(define-public datarekisteri-backend
+  (package
+    (name "datarekisteri-backend")
+    (version "0.0.1")
+    (source (local-file "../../backend" "datarekisteri-backend-checkout"
+                        #:recursive? #t
+                        #:select? vcs-file?))
+    (build-system haskell-build-system)
+    (inputs (list dbmate
+                  ghc-base64
+                  ghc-cryptonite
+                  ghc-datarekisteri-core
+                  ghc-echo
+                  ghc-email-validate
+                  ghc-esqueleto
+                  ghc-mime-mail
+                  ghc-morpheus-graphql
+                  ghc-optparse-applicative
+                  ghc-persistent
+                  ghc-persistent-postgresql
+                  ghc-scotty
+                  ghc-smtp-mail
+                  ghc-wai-cors
+                  ghc-wai-extra))
+    (arguments
+     (list
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'install 'wrap-binaries
+            (lambda _
+              (wrap-program
+                (string-append #$output "/bin/datarekisteri-backend")
+                `("PATH" prefix (,(string-append #$(this-package-input "dbmate") "/bin")))))))))
+    (home-page "")
+    (synopsis "")
+    (description "")
+    (license license:agpl3+)))
+
+(define-public datarekisteri-frontend
+  (package
+    (name "datarekisteri-frontend")
+    (version "0.0.1")
+    (source (local-file "../../frontend" "datarekisteri-frontend-checkout"
+                        #:recursive? #t
+                        #:select? vcs-file?))
+    (build-system haskell-build-system)
+    (inputs (list dbmate
+                  ghc-base64
+                  ghc-cryptonite
+                  ghc-datarekisteri-core
+                  ghc-email-validate
+                  ghc-esqueleto
+                  ghc-mime-mail
+                  ghc-morpheus-graphql
+                  ghc-morpheus-graphql-client
+                  ghc-optparse-applicative
+                  ghc-persistent
+                  ghc-persistent-postgresql
+                  ghc-wai-extra
+                  ghc-yesod
+                  ghc-yesod-static
+                  ghc-yesod-auth))
+    (home-page "")
+    (synopsis "")
+    (description "")
+    (license license:agpl3+)))
+
+(define-public ghc-datarekisteri-core
+  (package
+    (name "datarekisteri-core")
+    (version "0.0.1")
+    (source (local-file "../../core" "datarekisteri-core-checkout"
+                        #:recursive? #t
+                        #:select? vcs-file?))
+    (build-system haskell-build-system)
+    (inputs (list ghc-base64
+                  ghc-cryptonite
+                  ghc-email-validate
+                  ghc-mime-mail
+                  ghc-morpheus-graphql
+                  ghc-morpheus-graphql-client
+                  ghc-persistent
+                  ghc-persistent-postgresql))
+    (home-page "")
+    (synopsis "")
+    (description "")
+    (license license:agpl3+)))
+
+
+(define ghc-authenticate
+  (package
+    (name "ghc-authenticate")
+    (version "1.3.5.1")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "authenticate" version))
+              (sha256
+               (base32
+                "1rhbvdgwdr68gp13p5piddfdqf3l9lmx4w7k249lc98y23780c3x"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-http-conduit
+                  ghc-case-insensitive
+                  ghc-http-types
+                  ghc-xml-conduit
+                  ghc-blaze-builder
+                  ghc-attoparsec
+                  ghc-unordered-containers
+                  ghc-conduit
+                  ghc-html-conduit
+                  ghc-resourcet
+                  ghc-network-uri))
+    (home-page "http://github.com/yesodweb/authenticate")
+    (synopsis "Authentication methods for Haskell web applications.")
+    (description "API docs and the README are available at
+<http://www.stackage.org/package/authenticate>.")
+    (license license:expat)))
+
+(define ghc-yesod-auth
+  (package
+    (name "ghc-yesod-auth")
+    (version "1.6.11")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "yesod-auth" version))
+              (sha256
+               (base32
+                "0fdahk5mc63g0zsafk8axry01qaxahmclpmmwygp2lhfsjy8mby2"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-authenticate
+                  ghc-base16-bytestring
+                  ghc-base64-bytestring
+                  ghc-blaze-builder
+                  ghc-blaze-html
+                  ghc-blaze-markup
+                  ghc-conduit
+                  ghc-conduit-extra
+                  ghc-cryptonite
+                  ghc-data-default
+                  ghc-email-validate
+                  ghc-file-embed
+                  ghc-http-client
+                  ghc-http-client-tls
+                  ghc-http-conduit
+                  ghc-http-types
+                  ghc-memory
+                  ghc-nonce
+                  ghc-persistent
+                  ghc-random
+                  ghc-safe
+                  ghc-shakespeare
+                  ghc-unliftio
+                  ghc-unliftio-core
+                  ghc-unordered-containers
+                  ghc-wai
+                  ghc-yesod-core
+                  ghc-yesod-form
+                  ghc-yesod-persistent
+                  ghc-network-uri))
+    (home-page "http://www.yesodweb.com/")
+    (synopsis "Authentication for Yesod.")
+    (description "API docs and the README are available at
+<http://www.stackage.org/package/yesod-auth>")
+    (license license:expat)))
+
+(define ghc-scotty
+  (package
+    (name "ghc-scotty")
+    (version "0.12")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "scotty" version))
+              (sha256
+               (base32
+                "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-base-compat-batteries
+                  ghc-blaze-builder
+                  ghc-case-insensitive
+                  ghc-data-default-class
+                  ghc-fail
+                  ghc-http-types
+                  ghc-monad-control
+                  ghc-nats
+                  ghc-network
+                  ghc-regex-compat
+                  ghc-transformers-base
+                  ghc-transformers-compat
+                  ghc-wai
+                  ghc-wai-extra
+                  ghc-warp))
+    (native-inputs (list ghc-async ghc-hspec ghc-hspec-wai ghc-lifted-base hspec-discover))
+    (arguments
+     `(#:cabal-revision ("7"
+                         "1i8icc612w4dbmqmnf99drqpmjvhjnkmqgk9xr63amj8jkz5lp4m")))
+    (home-page "https://github.com/scotty-web/scotty")
+    (synopsis
+     "Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp")
+    (description
+     "This package provides a Haskell web framework inspired by Ruby's Sinatra, using
+WAI and Warp. . @ &#123;-&#35; LANGUAGE OverloadedStrings &#35;-&#125; .  import
+Web.Scotty .  import Data.Monoid (mconcat) .  main = scotty 3000 $ &#32;&#32;get
+&#34;/:word&#34; $ do &#32;&#32;&#32;&#32;beam <- param &#34;word&#34;
+&#32;&#32;&#32;&#32;html $ mconcat [&#34;&#60;h1&#62;Scotty, &#34;, beam, &#34;
+me up!&#60;/h1&#62;&#34;] @ . .  Scotty is the cheap and cheerful way to write
+RESTful, declarative web applications. . * A page is as simple as defining the
+verb, url pattern, and Text content. . * It is template-language agnostic.
+Anything that returns a Text value will do. . * Conforms to WAI Application
+interface. . * Uses very fast Warp webserver by default. .  As for the name:
+Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
+[Warp] <http://hackage.haskell.org/package/warp>")
+    (license license:bsd-3)))
+
+(define ghc-hspec-wai
+  (package
+    (name "ghc-hspec-wai")
+    (version "0.11.1")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "hspec-wai" version))
+              (sha256
+               (base32
+                "03wiksic5y9a2g6a86nsxrnajdgdvpv17w02h5qla0zp9zs6pa1j"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-quickcheck
+                  ghc-base-compat
+                  ghc-case-insensitive
+                  ghc-hspec-core
+                  ghc-hspec-expectations
+                  ghc-http-types
+                  ghc-wai
+                  ghc-wai-extra))
+    (native-inputs (list ghc-hspec hspec-discover))
+    (home-page "https://github.com/hspec/hspec-wai#readme")
+    (synopsis "Experimental Hspec support for testing WAI applications")
+    (description "Experimental Hspec support for testing WAI applications")
+    (license license:expat)))
+
+(define ghc-morpheus-graphql
+  (package
+    (name "ghc-morpheus-graphql")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql" version))
+              (sha256
+               (base32
+                "04qah7565dzq7v4q43zjz8778pdn5jwnway5rvz4kkibcrscfagn"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-morpheus-graphql-app
+                  ghc-morpheus-graphql-code-gen
+                  ghc-morpheus-graphql-core
+                  ghc-morpheus-graphql-server
+                  ghc-relude
+                  ghc-unordered-containers
+                  ghc-vector))
+    (native-inputs (list ghc-morpheus-graphql-subscriptions
+                         ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL")
+    (description "Build GraphQL APIs with your favourite functional language!")
+    (license license:expat)))
+
+(define ghc-morpheus-graphql-code-gen
+  (package
+    (name "ghc-morpheus-graphql-code-gen")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-code-gen" version))
+              (sha256
+               (base32
+                "1rmxcr17xjx99aam048a4sqlwlnxjk41hx8fnb363ljid74vrcrb"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-file-embed
+                  ghc-morpheus-graphql-code-gen-utils
+                  ghc-morpheus-graphql-core
+                  ghc-morpheus-graphql-server
+                  ghc-prettyprinter
+                  ghc-relude
+                  ghc-unordered-containers
+                  ghc-glob
+                  ghc-morpheus-graphql-client
+                  ghc-optparse-applicative
+                  ghc-yaml))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL CLI")
+    (description "code generator for Morpheus GraphQL")
+    (license license:bsd-3)))
+
+
+(define ghc-morpheus-graphql-core
+  (package
+    (name "ghc-morpheus-graphql-core")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-core" version))
+              (sha256
+               (base32
+                "0dd8bifn6qwpss06hbb0r730fqfkbd4nhwsr2bsrgxc7hvzv9wi7"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-hashable
+                  ghc-megaparsec
+                  ghc-relude
+                  ghc-scientific
+                  ghc-th-lift-instances
+                  ghc-unordered-containers
+                  ghc-vector))
+    (native-inputs (list ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL Core")
+    (description "Build GraphQL APIs with your favorite functional language!")
+    (license license:expat)))
+
+
+(define ghc-morpheus-graphql-app
+  (package
+    (name "ghc-morpheus-graphql-app")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-app" version))
+              (sha256
+               (base32
+                "0dicajcqgxpv1jhnywjjs0g4p5ryv0xlrywib1xwxrb04wy9aa3f"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-hashable
+                  ghc-megaparsec
+                  ghc-morpheus-graphql-core
+                  ghc-relude
+                  ghc-scientific
+                  ghc-th-lift-instances
+                  ghc-unordered-containers
+                  ghc-vector))
+    (native-inputs (list ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL App")
+    (description "Build GraphQL APIs with your favourite functional language!")
+    (license license:expat)))
+
+
+(define ghc-morpheus-graphql-subscriptions
+  (package
+    (name "ghc-morpheus-graphql-subscriptions")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-subscriptions" version))
+              (sha256
+               (base32
+                "0gynrshv858g36jwvmh3q2asc6ppkr7hv9w9lx1qfjqfwm7r0140"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-morpheus-graphql-app
+                  ghc-morpheus-graphql-core
+                  ghc-relude
+                  ghc-unliftio-core
+                  ghc-unordered-containers
+                  ghc-uuid
+                  ghc-websockets))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL Subscriptions")
+    (description "Build GraphQL APIs with your favourite functional language!")
+    (license license:expat)))
+
+
+(define ghc-morpheus-graphql-client
+  (package
+    (name "ghc-morpheus-graphql-client")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-client" version))
+              (sha256
+               (base32
+                "1j4r6ar6l462aq8qvxikmwyxd2f8i60gd3j0qf5pxsslgjwmjbi9"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-file-embed
+                  ghc-modern-uri
+                  ghc-morpheus-graphql-code-gen-utils
+                  ghc-morpheus-graphql-core
+                  ghc-morpheus-graphql-subscriptions
+                  ghc-prettyprinter
+                  ghc-relude
+                  ghc-req
+                  ghc-unliftio-core
+                  ghc-unordered-containers
+                  ghc-websockets
+                  ghc-wuss))
+    (native-inputs (list ghc-tasty ghc-tasty-hunit))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL Client")
+    (description "Build GraphQL APIs with your favorite functional language!")
+    (license license:expat)))
+
+
+(define ghc-morpheus-graphql-tests
+  (package
+    (name "ghc-morpheus-graphql-tests")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-tests" version))
+              (sha256
+               (base32
+                "1s9x4gcqd36gqf5w2wxiqhf7k9y44b7g7zm90y2kbclxqirs9rqf"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson ghc-relude ghc-tasty ghc-tasty-hunit
+                  ghc-unordered-containers))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL Test")
+    (description "")
+    (license license:expat)))
+
+
+(define ghc-morpheus-graphql-server
+  (package
+    (name "ghc-morpheus-graphql-server")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-server" version))
+              (sha256
+               (base32
+                "1hl2c78pnx2rxx869p6ixvnyhzm46f1hzalqz2vbwrflshpmjv91"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-morpheus-graphql-app
+                  ghc-morpheus-graphql-core
+                  ghc-relude
+                  ghc-unordered-containers
+                  ghc-vector))
+    (native-inputs (list ghc-file-embed ghc-morpheus-graphql-subscriptions
+                         ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL")
+    (description "Build GraphQL APIs with your favourite functional language!")
+    (license license:expat)))
+
+(define ghc-relude
+  (package
+    (name "ghc-relude")
+    (version "1.1.0.0")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "relude" version))
+              (sha256
+               (base32
+                "02dn99v2qmykj0l1qmn15k36hyxccy71b7iqavfk24zgjf5g07dm"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-hashable ghc-unordered-containers))
+    (native-inputs (list ghc-hedgehog ghc-doctest ghc-glob))
+    (home-page "https://github.com/kowainik/relude")
+    (synopsis
+     "Safe, performant, user-friendly and lightweight Haskell Standard Library")
+    (description
+     "@__relude__@ is an alternative prelude library.  If you find the default
+@Prelude@ unsatisfying, despite its advantages, consider using @relude@ instead.
+== Relude goals and design principles * __Productivity.__ You can be more
+productive with a \"non-standard\" standard library, and @relude@ helps you with
+writing safer and more efficient code faster. * __Total programming__.  Usage of
+[/partial
+functions/](https://www.reddit.com/r/haskell/comments/5n51u3/why_are_partial_functions_as_in_head_tail_bad/)
+can lead to unexpected bugs and runtime exceptions in pure code.  The types of
+partial functions lie about their behaviour.  And even if it is not always
+possible to rely only on total functions, @relude@ strives to encourage
+best-practices and reduce the chances of introducing a bug.
++---------------------------------+--------------------------------------------+
+| __Partial__                     | __Total__                                  |
++=================================+============================================+
+| @head :: [a] -> a@              | @head :: NonEmpty a -> a@                  |
++---------------------------------+--------------------------------------------+
+| @tail :: [a] -> [a]@            | @tail :: NonEmpty a -> [a]@                |
++---------------------------------+--------------------------------------------+
+| @read :: Read a => String -> a@ | @readMaybe :: Read a => String -> Maybe a@ |
++---------------------------------+--------------------------------------------+
+| @fromJust :: Maybe a -> a@      | @fromMaybe :: a -> Maybe a -> a@           |
++---------------------------------+--------------------------------------------+
+* __Type-safety__.  We use the /\"make invalid states unrepresentable\"/ motto as
+one of our guiding principles.  If it is possible, we express this concept
+through the types. /Example:/ @ whenNotNull :: Applicative f => [a] -> (NonEmpty
+a -> f ()) -> f () @ * __Performance.__ We prefer @Text@ over
+@[String](https://www.reddit.com/r/haskell/comments/29jw0s/whats_wrong_with_string/)@,
+use space-leaks-free functions (e.g.  our custom performant @sum@ and
+@product@), introduce @\\{\\-\\# INLINE \\#\\-\\}@ and @\\{\\-\\# SPECIALIZE \\#\\-\\}@
+pragmas where appropriate, and make efficient container types (e.g. @Map@,
+@HashMap@, @Set@) more accessible. * __Minimalism__ (low number of
+dependencies).  We do not force users of @relude@ to stick to any specific lens
+or text formatting or logging library.  Where possible, @relude@ depends only on
+boot libraries.  The [Dependency
+graph](https://raw.githubusercontent.com/kowainik/relude/main/relude-dependency-graph.png)
+of @relude@ can give you a clearer picture. * __Convenience__.  Despite
+minimalism, we want to bring commonly used types and functions into scope, and
+make available functions easier to use.  Some examples of conveniences: 1.  No
+need to add @containers@, @unordered-containers@, @text@ and @bytestring@ to
+dependencies in your @.cabal@ file to use the main API of these libraries 2.  No
+need to import types like @NonEmpty@, @Text@, @Set@, @Reader[T]@, @MVar@, @STM@
+3.  Functions like @liftIO@, @fromMaybe@, @sortWith@ are available by default as
+well 4. @IO@ actions are lifted to @MonadIO@ * __Excellent documentation.__ 1.
+Tutorial 2.  Migration guide from @Prelude@ 3.  Haddock for every function with
+examples tested by [doctest](http://hackage.haskell.org/package/doctest).  4.
+Documentation regarding [internal module
+structure](http://hackage.haskell.org/package/relude/docs/Relude.html) 5.
+@relude@-specific [HLint](http://hackage.haskell.org/package/hlint) rules:
+@[.hlint.yaml](https://github.com/kowainik/relude/blob/main/.hlint.yaml)@ *
+__User-friendliness.__ Anyone should be able to quickly migrate to @relude@.
+Only some basic familiarity with the common libraries like @text@ and
+@containers@ should be enough (but not necessary). * __Exploration.__ We have
+space to experiment with new ideas and proposals without introducing breaking
+changes. @relude@ uses the approach with @Extra.*@ modules which are not
+exported by default.  The chosen approach makes it quite easy for us to provide
+new functionality without breaking anything and let the users decide to use it
+or not.")
+    (license license:expat)))
+
+(define ghc-morpheus-graphql-code-gen-utils
+  (package
+    (name "ghc-morpheus-graphql-code-gen-utils")
+    (version "0.27.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "morpheus-graphql-code-gen-utils" version))
+              (sha256
+               (base32
+                "11dfnyd9wbrwjfjz1qkc188x6l4b149jsyzjwh1gqji0skzsk3f6"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-morpheus-graphql-core ghc-prettyprinter ghc-relude
+                  ghc-unordered-containers))
+    (home-page "https://morpheusgraphql.com")
+    (synopsis "Morpheus GraphQL CLI")
+    (description "code generator for Morpheus GraphQL")
+    (license license:bsd-3)))
+
+(define ghc-wuss
+  (package
+    (name "ghc-wuss")
+    (version "2.0.1.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "wuss" version))
+              (sha256
+               (base32
+                "037dsx4mrp5mz2fif9zqlsp1n35g7v8749wmji281ing8jfiyl37"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-connection ghc-network ghc-websockets))
+    (home-page "http://hackage.haskell.org/package/wuss")
+    (synopsis "Secure WebSocket (WSS) clients")
+    (description
+     "Wuss is a library that lets you easily create secure WebSocket clients over the
+WSS protocol.  It is a small addition to
+<https://hackage.haskell.org/package/websockets the websockets package> and is
+adapted from existing solutions by <https://gist.github.com/jaspervdj/7198388
+@@jaspervdj>, <https://gist.github.com/mpickering/f1b7ba3190a4bb5884f3
+@@mpickering>, and <https://gist.github.com/elfenlaid/7b5c28065e67e4cf0767
+@@elfenlaid>.")
+    (license license:expat)))
+
+(define ghc-rsa
+  (package
+    (name "ghc-rsa")
+    (version "2.4.1")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "RSA" version))
+              (sha256
+               (base32
+                "0hchsqrxpfw7mqrqwscfy8ig1w2di6w3nxpzi873w0gibv2diibj"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-crypto-api ghc-crypto-pubkey-types ghc-sha))
+    (native-inputs (list ghc-quickcheck ghc-tagged ghc-test-framework
+                         ghc-test-framework-quickcheck2))
+    (home-page "http://hackage.haskell.org/package/RSA")
+    (synopsis
+     "Implementation of RSA, using the padding schemes of PKCS#1 v2.1.")
+    (description
+     "This library implements the RSA encryption and signature algorithms for
+arbitrarily-sized ByteStrings.  While the implementations work, they are not
+necessarily the fastest ones on the planet.  Particularly key generation.  The
+algorithms included are based of RFC 3447, or the Public-Key Cryptography
+Standard for RSA, version 2.1 (a.k.a, PKCS#1 v2.1).")
+    (license license:bsd-3)))
+
+(define ghc-crypto-pubkey-types
+  (package
+    (name "ghc-crypto-pubkey-types")
+    (version "0.4.3")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "crypto-pubkey-types" version))
+              (sha256
+               (base32
+                "0q0wlzjmpx536h1zcdzrpxjkvqw8abj8z0ci38138kpch4igbnby"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-asn1-types ghc-asn1-encoding))
+    (home-page "http://github.com/vincenthz/hs-crypto-pubkey-types")
+    (synopsis "Generic cryptography Public keys algorithm types")
+    (description "Generic cryptography public keys algorithm types")
+    (license license:bsd-3)))
+
+(define ghc-authenticate-oauth
+  (package
+    (name "ghc-authenticate-oauth")
+    (version "1.7")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "authenticate-oauth" version))
+              (sha256
+               (base32
+                "0y4v46rn0cvm0sr1v8qq1zgzllrlrr3ji5gij1xprgf1zsazcvvl"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-http-client
+                  ghc-crypto-pubkey-types
+                  ghc-rsa
+                  ghc-data-default
+                  ghc-sha
+                  ghc-random
+                  ghc-http-types
+                  ghc-blaze-builder
+                  ghc-transformers-compat))
+    (home-page "http://github.com/yesodweb/authenticate")
+    (synopsis
+     "Library to authenticate with OAuth for Haskell web applications.")
+    (description "API docs and the README are available at
+<http://www.stackage.org/package/authenticate-oauth>.")
+    (license license:bsd-3)))
+
+(define ghc-req
+  (package
+    (name "ghc-req")
+    (version "3.13.0")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "req" version))
+              (sha256
+               (base32
+                "1igs75bj57vs1fwpxj1765l6zkqd4r3p2gbwp6cv2l37drfxjck4"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-aeson
+                  ghc-authenticate-oauth
+                  ghc-blaze-builder
+                  ghc-case-insensitive
+                  ghc-connection
+                  ghc-http-api-data
+                  ghc-http-client
+                  ghc-http-client-tls
+                  ghc-http-types
+                  ghc-modern-uri
+                  ghc-monad-control
+                  ghc-retry
+                  ghc-transformers-base
+                  ghc-unliftio-core))
+    (native-inputs (list ghc-quickcheck ghc-hspec hspec-discover ghc-hspec-core
+                         ghc-quickcheck ghc-hspec))
+    (arguments '(#:tests? #f))
+    (home-page "https://github.com/mrkkrp/req")
+    (synopsis "HTTP client library")
+    (description "HTTP client library.")
+    (license license:bsd-3)))
+
+(define ghc-modern-uri
+  (package
+    (name "ghc-modern-uri")
+    (version "0.3.6.0")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "modern-uri" version))
+              (sha256
+               (base32
+                "1lj3il9wg7v88l1hj08k07g3f76xas0gz20l2wy8z6xbpcn5ng6g"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-quickcheck
+                  ghc-contravariant
+                  ghc-hashable
+                  ghc-megaparsec
+                  ghc-profunctors
+                  ghc-reflection
+                  ghc-tagged))
+    (native-inputs (list ghc-hspec hspec-discover ghc-hspec-megaparsec))
+    (home-page "https://github.com/mrkkrp/modern-uri")
+    (synopsis "Modern library for working with URIs")
+    (description "Modern library for working with URIs.")
+    (license license:bsd-3)))
+
+(define ghc-mime-mail
+  (package
+    (name "ghc-mime-mail")
+    (version "0.5.1")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "mime-mail" version))
+              (sha256
+               (base32
+                "1s1wp8v1xlvw3r4qk1lv9zpm99ihka7a785zjl6i3fq1maqq955g"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-base64-bytestring ghc-random ghc-blaze-builder))
+    (native-inputs (list ghc-hspec hspec-discover))
+    (home-page "http://github.com/snoyberg/mime-mail")
+    (synopsis "Compose MIME email messages.")
+    (description
+     "Hackage documentation generation is not reliable.  For up to date documentation,
+please see: <http://www.stackage.org/package/mime-mail>.")
+    (license license:expat)))
+
+(define ghc-smtp-mail
+  (package
+    (name "ghc-smtp-mail")
+    (version "0.3.0.0")
+    (source (origin
+              (method url-fetch)
+              (uri (hackage-uri "smtp-mail" version))
+              (sha256
+               (base32
+                "0q81m4mi43cd0f1azm6984xw3qw2s6ygszdn86j5z3g5sjj5dax4"))))
+    (build-system haskell-build-system)
+    (inputs (list ghc-base16-bytestring
+                  ghc-base64-bytestring
+                  ghc-connection
+                  ghc-mime-mail
+                  ghc-network
+                  ghc-network-bsd
+                  ghc-cryptonite
+                  ghc-memory))
+    (home-page "http://github.com/jhickner/smtp-mail")
+    (synopsis "Simple email sending via SMTP")
+    (description
+     "This packages provides a simple interface for mail over SMTP.  PLease see the
+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)))
+
+(list datarekisteri-backend datarekisteri-frontend ghc-datarekisteri-core)

.guix/modules/datarekisteri-service.scm

@@ -0,0 +1,177 @@
+(define-module (datarekisteri-service)
+  #:use-module (datarekisteri-package)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services)
+  #:use-module (gnu services certbot)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services databases)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu services web)
+  #:use-module (gnu system shadow)
+
+  #:export (plain-datarekisteri-frontend-service-type
+            plain-datarekisteri-frontend-configuration
+
+            plain-datarekisteri-backend-service-type
+            plain-datarekisteri-backend-configuration))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization plain-datarekisteri-frontend-configuration
+  (datarekisteri-frontend
+   (file-like datarekisteri-frontend)
+   "The datarekisteri-frontend package to use.")
+  (backend-url
+   (string)
+   "The URL for the datarekisteri backend server.")
+  (port
+   (integer 3000)
+   "The TCP port to listen on.")
+  (root-url
+   (string)
+   "The root URL for this server."))
+
+(define (frontend-shepherd-service config)
+  (match-record config <plain-datarekisteri-frontend-configuration>
+    (backend-url port root-url datarekisteri-frontend)
+    (list (shepherd-service
+           (documentation "Run the datarekisteri frontend HTTP server")
+           (requirement '(networking))
+           (provision '(datarekisteri-frontend))
+           (start
+            #~(make-forkexec-constructor
+               (list #$(file-append datarekisteri-frontend "/bin/datarekisteri-frontend")
+                     "--server-url" #$backend-url
+                     "--port" #$(number->string port)
+                     "--approot" #$root-url)
+               #:user "datarekisteri-frontend"
+               #:group "datarekisteri-frontend"
+               #:directory "/var/lib/datarekisteri-frontend"))
+           (stop #~(make-kill-destructor))))))
+
+(define (frontend-accounts _)
+  (list (user-group
+         (name "datarekisteri-frontend")
+         (system? #t))
+        (user-account
+         (name "datarekisteri-frontend")
+         (system? #t)
+         (group "datarekisteri-frontend")
+         (home-directory "/var/lib/datarekisteri-frontend")
+         (shell (file-append shadow "/bin/nologin")))))
+
+(define plain-datarekisteri-frontend-service-type
+  (service-type
+   (name 'plain-datarekisteri-frontend)
+   (extensions
+     (list (service-extension shepherd-root-service-type frontend-shepherd-service)
+           (service-extension account-service-type frontend-accounts)))
+   (description "Run the datarekisteri HTTP frontend server")))
+
+(define-configuration/no-serialization plain-datarekisteri-backend-configuration
+  (datarekisteri-backend
+   (file-like datarekisteri-backend)
+   "The datarekisteri-backend package to use.")
+  (email-address
+   (string)
+   "The email address to send emails from.")
+  (email-sender
+   (maybe-string)
+   "The display name for sending emails.")
+  (port
+   (integer 3100)
+   "The TCP port to listen on.")
+  (sendmail
+   (file-like)
+   "Path to the sendmail program to send emails with."))
+
+(define (backend-shepherd-service config)
+  (match-record config <plain-datarekisteri-backend-configuration>
+    (email-address email-sender sendmail port datarekisteri-backend)
+    (list (shepherd-service
+           (documentation "Run the datarekisteri backend HTTP server")
+           (requirement '(networking postgres))
+           (provision '(datarekisteri-backend))
+           (start
+            #~(make-forkexec-constructor
+               (list #$(file-append datarekisteri-backend "/bin/datarekisteri-backend")
+                     "--address" #$email-address
+                     #$@(if (maybe-value-set? email-sender) (list "--display-name" email-sender) '())
+                     "--port" #$(number->string port)
+                     "--sendmail" #$sendmail)
+               #:user "datarekisteri-backend"
+               #:group "datarekisteri-backend"
+               #:directory "/var/lib/datarekisteri-backend"))
+           (stop #~(make-kill-destructor))))))
+
+(define (backend-accounts _)
+  (list (user-group
+         (name "datarekisteri-backend")
+         (system? #t))
+        (user-account
+         (name "datarekisteri-backend")
+         (system? #t)
+         (group "datarekisteri-backend")
+         (home-directory "/var/lib/datarekisteri-backend")
+         (shell (file-append shadow "/bin/nologin")))))
+
+(define (backend-postgresql-roles _)
+  (list (postgresql-role
+          (name "datarekisteri-backend")
+          (create-database? #t))))
+
+(define (backend-profile config)
+  (match-record config <plain-datarekisteri-backend-configuration>
+    (datarekisteri-backend)
+    (list datarekisteri-backend)))
+
+(define plain-datarekisteri-backend-service-type
+  (service-type
+   (name 'plain-datarekisteri-backend)
+   (extensions
+     (list (service-extension postgresql-role-service-type backend-postgresql-roles)
+           (service-extension account-service-type backend-accounts)
+           (service-extension profile-service-type backend-profile)
+           (service-extension shepherd-root-service-type backend-shepherd-service)))
+   (description "Run the datarekisteri backend HTTP server")))
+
+; (define datarekisteri-client-service-type
+;   (service-type
+;    (name 'datarekisteri-client)
+;    (extensions
+;      (list (service-extension certbot-service-type client-certbot)
+;            (service-extension nginx-service-type client-nginx)
+;            (service-extension shepherd-root-service-type client-shepherd-service)))
+;    (description "Run the datarekisteri HTTP client server")
+;    (default-value (datarekisteri-client-configuration))))
+
+; (define datarekisteri-api-service-type
+;   (service-type
+;    (name 'datarekisteri-api)
+;    (extensions
+;      (list (service-extension certbot-service-type api-certbot)
+;            (service-extension nginx-service-type api-nginx)
+;            (service-extension postgresql-role-service-type api-postgresql-roles)
+;            (service-extension shepherd-root-service-type api-shepherd-service)))
+;    (description "Run the datarekisteri HTTP api server")
+;    (default-value (datarekisteri-api-configuration))))
+
+; (define-configuration datarekisteri-client-configuration
+;   (https?
+;    (boolean #t)
+;    "Whether to configure HTTPS with certbot.")
+;   (nginx?
+;    (boolean #t)
+;    "Whether to configure nginx as a reverse proxy.")
+;   (api-url
+;    (string)
+;    "The URL for the graphql API server.")
+;   (port
+;    (integer 3000)
+;    "The TCP port to listen on.")
+;   (root-url
+;    (string)
+;    ""))
+

Client.hs

@@ -1,30 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ViewPatterns #-}
-
-{-# LANGUAGE NoImplicitPrelude #-}
-
-import Relude hiding (get)
-
-import Yesod
-import Yesod.Auth
-import Client.Types
-import Client.Handlers
-import Client.Auth ()
-import Yesod.Static (static, Static)
-import System.Directory (createDirectoryIfMissing)
-
-mkYesodDispatch "DataIdClient" resourcesDataIdClient
-
-main :: IO ()
-main = getStaticDir "/tmp/data-id" >>= warp 3000 . DataIdClient
-
-getStaticDir :: FilePath -> IO Static
-getStaticDir dir = createDirectoryIfMissing True dir >> static dir

Client/Handlers.hs

@@ -1,34 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE DisambiguateRecordFields #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeApplications #-}
-
-{-# LANGUAGE NoImplicitPrelude #-}
-
-module Client.Handlers
-    ( module Client.Handlers.Profile
-    , module Client.Handlers.Apply
-    , module Client.Handlers.Applications
-    , module Client.Handlers.VerifyEmail
-    , getHomeR
-    , postApiR
-    ) where
-
-import Relude
-
-import Client.Handlers.Profile
-import Client.Handlers.Apply
-import Client.Handlers.Applications
-import Client.Handlers.VerifyEmail
-import Client.Types
-import Yesod
-import Yesod.Auth
-import Server (serverApp)
-
-getHomeR :: Handler Html
-getHomeR = ifM (isJust <$> maybeAuthId) (redirect OwnProfileR) (redirect $ AuthR LoginR)
-
-postApiR :: Handler ()
-postApiR = sendWaiApplication =<< liftIO serverApp

README.md

@@ -4,6 +4,21 @@ Datayhdistyksen jäsenrekisterin lähdekoodi. Tavoitteena on saada mahdollisimma
 paljon toiminnallisuudesta abstraktoitua ja siirrettyä
 [`rekisteri`](https://hub.sr.ht/~slaesvuo/rekisteri):iin.
 
+Datarekisterin voit asentaa helposti lisäämällä alla olevan pätkän guix:in
+[kanavalistaan](https://guix.gnu.org/manual/en/guix.html#Specifying-Additional-Channels).
+
+```lisp
+(channel
+ (name 'datarekisteri)
+ (url "https://git.datat.fi/ry/datarekisteri.git")
+ (branch "main")
+ (introduction
+  (make-channel-introduction
+   "e93c797eefb1538e7defe04786e0bb5adb039799"
+   (openpgp-fingerprint
+    "A0C9 1947 734F 076F 5F08 E9FF 257D 284A 2A1D 3A32"))))
+```
+
 ## Käänteisen välityspalvelimen asetukset
 
 Käänteisen välityspalvelimen pitäisi määritellä CSP estämään kaikkien skriptien

backend/COPYING.md

@@ -0,0 +1,660 @@
+### GNU AFFERO GENERAL PUBLIC LICENSE
+
+Version 3, 19 November 2007
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+<https://fsf.org/>
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+### Preamble
+
+The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains
+free software for all its users.
+
+When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing
+under this license.
+
+The precise terms and conditions for copying, distribution and
+modification follow.
+
+### TERMS AND CONDITIONS
+
+#### 0. Definitions.
+
+"This License" refers to version 3 of the GNU Affero General Public
+License.
+
+"Copyright" also means copyright-like laws that apply to other kinds
+of works, such as semiconductor masks.
+
+"The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of
+an exact copy. The resulting work is called a "modified version" of
+the earlier work or a work "based on" the earlier work.
+
+A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user
+through a computer network, with no transfer of a copy, is not
+conveying.
+
+An interactive user interface displays "Appropriate Legal Notices" to
+the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+#### 1. Source Code.
+
+The "source code" for a work means the preferred form of the work for
+making modifications to it. "Object code" means any non-source form of
+a work.
+
+A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+The Corresponding Source need not include anything that users can
+regenerate automatically from other parts of the Corresponding Source.
+
+The Corresponding Source for a work in source code form is that same
+work.
+
+#### 2. Basic Permissions.
+
+All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+You may make, run and propagate covered works that you do not convey,
+without conditions so long as your license otherwise remains in force.
+You may convey covered works to others for the sole purpose of having
+them make modifications exclusively for you, or provide you with
+facilities for running those works, provided that you comply with the
+terms of this License in conveying all material for which you do not
+control copyright. Those thus making or running the covered works for
+you must do so exclusively on your behalf, under your direction and
+control, on terms that prohibit them from making any copies of your
+copyrighted material outside their relationship with you.
+
+Conveying under any other circumstances is permitted solely under the
+conditions stated below. Sublicensing is not allowed; section 10 makes
+it unnecessary.
+
+#### 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such
+circumvention is effected by exercising rights under this License with
+respect to the covered work, and you disclaim any intention to limit
+operation or modification of the work as a means of enforcing, against
+the work's users, your or third parties' legal rights to forbid
+circumvention of technological measures.
+
+#### 4. Conveying Verbatim Copies.
+
+You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+#### 5. Conveying Modified Source Versions.
+
+You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these
+conditions:
+
+-   a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+-   b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under
+    section 7. This requirement modifies the requirement in section 4
+    to "keep intact all notices".
+-   c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy. This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged. This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+-   d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+#### 6. Conveying Non-Source Forms.
+
+You may convey a covered work in object code form under the terms of
+sections 4 and 5, provided that you also convey the machine-readable
+Corresponding Source under the terms of this License, in one of these
+ways:
+
+-   a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+-   b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the Corresponding
+    Source from a network server at no charge.
+-   c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source. This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+-   d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge. You need not require recipients to copy the
+    Corresponding Source along with the object code. If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source. Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+-   e) Convey the object code using peer-to-peer transmission,
+    provided you inform other peers where the object code and
+    Corresponding Source of the work are being offered to the general
+    public at no charge under subsection 6d.
+
+A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal,
+family, or household purposes, or (2) anything designed or sold for
+incorporation into a dwelling. In determining whether a product is a
+consumer product, doubtful cases shall be resolved in favor of
+coverage. For a particular product received by a particular user,
+"normally used" refers to a typical or common use of that class of
+product, regardless of the status of the particular user or of the way
+in which the particular user actually uses, or expects or is expected
+to use, the product. A product is a consumer product regardless of
+whether the product has substantial commercial, industrial or
+non-consumer uses, unless such uses represent the only significant
+mode of use of the product.
+
+"Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to
+install and execute modified versions of a covered work in that User
+Product from a modified version of its Corresponding Source. The
+information must suffice to ensure that the continued functioning of
+the modified object code is in no case prevented or interfered with
+solely because modification has been made.
+
+If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or
+updates for a work that has been modified or installed by the
+recipient, or for the User Product in which it has been modified or
+installed. Access to a network may be denied when the modification
+itself materially and adversely affects the operation of the network
+or violates the rules and protocols for communication across the
+network.
+
+Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+#### 7. Additional Terms.
+
+"Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders
+of that material) supplement the terms of this License with terms:
+
+-   a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+-   b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+-   c) Prohibiting misrepresentation of the origin of that material,
+    or requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+-   d) Limiting the use for publicity purposes of names of licensors
+    or authors of the material; or
+-   e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+-   f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions
+    of it) with contractual assumptions of liability to the recipient,
+    for any liability that these contractual assumptions directly
+    impose on those licensors and authors.
+
+All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions; the
+above requirements apply either way.
+
+#### 8. Termination.
+
+You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+However, if you cease all violation of this License, then your license
+from a particular copyright holder is reinstated (a) provisionally,
+unless and until the copyright holder explicitly and finally
+terminates your license, and (b) permanently, if the copyright holder
+fails to notify you of the violation by some reasonable means prior to
+60 days after the cessation.
+
+Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+#### 9. Acceptance Not Required for Having Copies.
+
+You are not required to accept this License in order to receive or run
+a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+#### 10. Automatic Licensing of Downstream Recipients.
+
+Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+#### 11. Patents.
+
+A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+A contributor's "essential patent claims" are all patent claims owned
+or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+A patent license is "discriminatory" if it does not include within the
+scope of its coverage, prohibits the exercise of, or is conditioned on
+the non-exercise of one or more of the rights that are specifically
+granted under this License. You may not convey a covered work if you
+are a party to an arrangement with a third party that is in the
+business of distributing software, under which you make payment to the
+third party based on the extent of your activity of conveying the
+work, and under which the third party grants, to any of the parties
+who would receive the covered work from you, a discriminatory patent
+license (a) in connection with copies of the covered work conveyed by
+you (or copies made from those copies), or (b) primarily for and in
+connection with specific products or compilations that contain the
+covered work, unless you entered into that arrangement, or that patent
+license was granted, prior to 28 March 2007.
+
+Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+#### 12. No Surrender of Others' Freedom.
+
+If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under
+this License and any other pertinent obligations, then as a
+consequence you may not convey it at all. For example, if you agree to
+terms that obligate you to collect a royalty for further conveying
+from those to whom you convey the Program, the only way you could
+satisfy both those terms and this License would be to refrain entirely
+from conveying the Program.
+
+#### 13. Remote Network Interaction; Use with the GNU General Public License.
+
+Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your
+version supports such interaction) an opportunity to receive the
+Corresponding Source of your version by providing access to the
+Corresponding Source from a network server at no charge, through some
+standard or customary means of facilitating copying of software. This
+Corresponding Source shall include the Corresponding Source for any
+work covered by version 3 of the GNU General Public License that is
+incorporated pursuant to the following paragraph.
+
+Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+#### 14. Revised Versions of this License.
+
+The Free Software Foundation may publish revised and/or new versions
+of the GNU Affero General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever
+published by the Free Software Foundation.
+
+If the Program specifies that a proxy can decide which future versions
+of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+#### 15. Disclaimer of Warranty.
+
+THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT
+WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
+PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE
+DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
+CORRECTION.
+
+#### 16. Limitation of Liability.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR
+CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT
+NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR
+LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM
+TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER
+PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+#### 17. Interpretation of Sections 15 and 16.
+
+If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+END OF TERMS AND CONDITIONS
+
+### How to Apply These Terms to Your New Programs
+
+If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively state
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+        <one line to give the program's name and a brief idea of what it does.>
+        Copyright (C) <year>  <name of author>
+
+        This program is free software: you can redistribute it and/or modify
+        it under the terms of the GNU Affero General Public License as
+        published by the Free Software Foundation, either version 3 of the
+        License, or (at your option) any later version.
+
+        This program is distributed in the hope that it will be useful,
+        but WITHOUT ANY WARRANTY; without even the implied warranty of
+        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        GNU Affero General Public License for more details.
+
+        You should have received a copy of the GNU Affero General Public License
+        along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper
+mail.
+
+If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for
+the specific requirements.
+
+You should also get your employer (if you work as a programmer) or
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. For more information on this, and how to apply and follow
+the GNU AGPL, see <https://www.gnu.org/licenses/>.

backend/datarekisteri-backend.cabal

@@ -0,0 +1,90 @@
+cabal-version: 3.6
+name: datarekisteri-backend
+version: 0.0.1
+author: Saku Laesvuori
+license: AGPL-3.0-or-later
+license-file: COPYING.md
+build-type: Simple
+stability: alpha
+data-files:
+  db/migrations/*.sql
+
+executable datarekisteri-backend
+  build-depends:
+    aeson,
+    base,
+    base64,
+    cryptonite,
+    datarekisteri-core,
+    email-validate,
+    esqueleto,
+    memory,
+    mime-mail,
+    monad-logger,
+    morpheus-graphql,
+    morpheus-graphql-app,
+    morpheus-graphql-core,
+    morpheus-graphql-server,
+    mtl,
+    optparse-applicative,
+    persistent,
+    persistent-postgresql,
+    process,
+    relude,
+    scotty,
+    smtp-mail,
+    text,
+    time,
+    containers,
+    wai,
+    warp,
+    wai-cors,
+    wai-extra,
+    directory
+  main-is: Datarekisteri/Backend.hs
+  other-modules:
+    Datarekisteri.Backend.API,
+    Datarekisteri.Backend.DB,
+    Datarekisteri.Backend.DB.Queries,
+    Datarekisteri.Backend.Email,
+    Datarekisteri.Backend.Types,
+    Datarekisteri.Backend.Utils,
+    Paths_datarekisteri_backend
+  autogen-modules:
+    Paths_datarekisteri_backend
+  hs-source-dirs: src
+  default-language: Haskell2010
+
+executable datarekisteri-cli
+  build-depends:
+    aeson,
+    base,
+    base64,
+    containers,
+    cryptonite,
+    datarekisteri-core,
+    echo,
+    email-validate,
+    esqueleto,
+    memory,
+    mime-mail,
+    monad-logger,
+    morpheus-graphql,
+    morpheus-graphql-app,
+    morpheus-graphql-core,
+    morpheus-graphql-server,
+    mtl,
+    optparse-applicative,
+    persistent,
+    persistent-postgresql,
+    relude,
+    text,
+    time
+  main-is: Datarekisteri/CLI.hs
+  other-modules:
+    Datarekisteri.Backend.DB,
+    Datarekisteri.Backend.DB.Queries,
+    Datarekisteri.Backend.Types,
+    Datarekisteri.Backend.Utils,
+  hs-source-dirs: src
+  default-language: Haskell2010

backend/db/migrations/20230917064352_split-emails-from-users.sql

@@ -0,0 +1,40 @@
+-- migrate:up
+
+create table "emails" (
+    "id" serial primary key,
+    "uid" integer not null references "users" on delete cascade,
+    "email" varchar(320) unique not null, -- local 64 + domain 255 + '@' 1 per RFC5321
+    "verificationSecret" varchar(255) unique
+);
+
+create unique index "emails_uid_verified" on "emails" ("uid", ("verificationSecret" is not null));
+-- at most one verified and one pending email per user
+
+insert into "emails" ("uid", "email", "verificationSecret")
+    select "id", "email", null as "verificationSecret" from "users" where "email" is not null;
+
+insert into "emails" ("uid", "email", "verificationSecret")
+    select "id", "pendingEmail", "emailVerificationSecret" from "users" where "pendingEmail" is not null;
+
+alter table "users"
+    drop "email" cascade,
+    drop "pendingEmail" cascade,
+    drop "emailVerificationSecret" cascade;
+
+-- migrate:down
+
+alter table "users"
+    add "email" varchar(320) unique,
+    add "pendingEmail" varchar(320) unique,
+    add "emailVerificationSecret" varchar(255) unique;
+
+update "users" set "email" = "emails"."email"
+    from "emails"
+    where "users"."id" = "emails"."uid" and "emails"."verificationSecret" is null;
+
+update "users" set "pendingEmail" = "emails"."email",
+    "emailVerificationSecret" = "emails"."verificationSecret"
+    from "emails"
+    where "users"."id" = "emails"."uid" and "emails"."verificationSecret" is not null;
+
+drop table "emails";

backend/db/schema.sql

@@ -13,6 +13,38 @@ SET default_tablespace = '';
 
 SET default_table_access_method = heap;
 
+--
+-- Name: emails; Type: TABLE; Schema: public; Owner: -
+--
+
+CREATE TABLE public.emails (
+    id integer NOT NULL,
+    uid integer NOT NULL,
+    email character varying(320) NOT NULL,
+    "verificationSecret" character varying(255)
+);
+
+
+--
+-- Name: emails_id_seq; Type: SEQUENCE; Schema: public; Owner: -
+--
+
+CREATE SEQUENCE public.emails_id_seq
+    AS integer
+    START WITH 1
+    INCREMENT BY 1
+    NO MINVALUE
+    NO MAXVALUE
+    CACHE 1;
+
+
+--
+-- Name: emails_id_seq; Type: SEQUENCE OWNED BY; Schema: public; Owner: -
+--
+
+ALTER SEQUENCE public.emails_id_seq OWNED BY public.emails.id;
+
+
 --
 -- Name: keys; Type: TABLE; Schema: public; Owner: -
 --
@@ -99,9 +131,6 @@ ALTER SEQUENCE public.tokens_id_seq OWNED BY public.tokens.id;
 
 CREATE TABLE public.users (
     id integer NOT NULL,
-    email character varying(255),
-    "pendingEmail" character varying(255),
-    "emailVerificationSecret" character varying(255),
     registered timestamp without time zone NOT NULL,
     "passwordCrypt" bytea NOT NULL,
     permissions text NOT NULL,
@@ -133,6 +162,13 @@ CREATE SEQUENCE public.users_id_seq
 ALTER SEQUENCE public.users_id_seq OWNED BY public.users.id;
 
 
+--
+-- Name: emails id; Type: DEFAULT; Schema: public; Owner: -
+--
+
+ALTER TABLE ONLY public.emails ALTER COLUMN id SET DEFAULT nextval('public.emails_id_seq'::regclass);
+
+
 --
 -- Name: keys id; Type: DEFAULT; Schema: public; Owner: -
 --
@@ -154,6 +190,30 @@ ALTER TABLE ONLY public.tokens ALTER COLUMN id SET DEFAULT nextval('public.token
 ALTER TABLE ONLY public.users ALTER COLUMN id SET DEFAULT nextval('public.users_id_seq'::regclass);
 
 
+--
+-- Name: emails emails_email_key; Type: CONSTRAINT; Schema: public; Owner: -
+--
+
+ALTER TABLE ONLY public.emails
+    ADD CONSTRAINT emails_email_key UNIQUE (email);
+
+
+--
+-- Name: emails emails_pkey; Type: CONSTRAINT; Schema: public; Owner: -
+--
+
+ALTER TABLE ONLY public.emails
+    ADD CONSTRAINT emails_pkey PRIMARY KEY (id);
+
+
+--
+-- Name: emails emails_verificationSecret_key; Type: CONSTRAINT; Schema: public; Owner: -
+--
+
+ALTER TABLE ONLY public.emails
+    ADD CONSTRAINT "emails_verificationSecret_key" UNIQUE ("verificationSecret");
+
+
 --
 -- Name: keys keys_pkey; Type: CONSTRAINT; Schema: public; Owner: -
 --
@@ -194,30 +254,6 @@ ALTER TABLE ONLY public.tokens
     ADD CONSTRAINT tokens_pkey PRIMARY KEY (id);
 
 
---
--- Name: users users_emailVerificationSecret_key; Type: CONSTRAINT; Schema: public; Owner: -
---
-
-ALTER TABLE ONLY public.users
-    ADD CONSTRAINT "users_emailVerificationSecret_key" UNIQUE ("emailVerificationSecret");
-
-
---
--- Name: users users_email_key; Type: CONSTRAINT; Schema: public; Owner: -
---
-
-ALTER TABLE ONLY public.users
-    ADD CONSTRAINT users_email_key UNIQUE (email);
-
-
---
--- Name: users users_pendingEmail_key; Type: CONSTRAINT; Schema: public; Owner: -
---
-
-ALTER TABLE ONLY public.users
-    ADD CONSTRAINT "users_pendingEmail_key" UNIQUE ("pendingEmail");
-
-
 --
 -- Name: users users_pkey; Type: CONSTRAINT; Schema: public; Owner: -
 --
@@ -226,6 +262,13 @@ ALTER TABLE ONLY public.users
     ADD CONSTRAINT users_pkey PRIMARY KEY (id);
 
 
+--
+-- Name: emails_uid_verified; Type: INDEX; Schema: public; Owner: -
+--
+
+CREATE UNIQUE INDEX emails_uid_verified ON public.emails USING btree (uid, (("verificationSecret" IS NOT NULL)));
+
+
 --
 -- Name: keys_isPrimaryEncryptionKey_constraint; Type: INDEX; Schema: public; Owner: -
 --
@@ -254,6 +297,14 @@ CREATE INDEX tokens_data_index ON public.tokens USING btree (data);
 CREATE INDEX "users_memberData_index" ON public.users USING gin ("memberData");
 
 
+--
+-- Name: emails emails_uid_fkey; Type: FK CONSTRAINT; Schema: public; Owner: -
+--
+
+ALTER TABLE ONLY public.emails
+    ADD CONSTRAINT emails_uid_fkey FOREIGN KEY (uid) REFERENCES public.users(id) ON DELETE CASCADE;
+
+
 --
 -- Name: keys keys_uid_fkey; Type: FK CONSTRAINT; Schema: public; Owner: -
 --
@@ -280,4 +331,5 @@ ALTER TABLE ONLY public.tokens
 --
 
 INSERT INTO public.schema_migrations (version) VALUES
-    ('20221208114323');
+    ('20221208114323'),
+    ('20230917064352');

backend/src/Datarekisteri/Backend.hs

@@ -5,8 +5,6 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Server where
-
 import Relude
 
 import "cryptonite" Crypto.Random (MonadRandom(..))
@@ -15,24 +13,59 @@ import Data.Map (findWithDefault)
 import Data.Text (toLower, breakOn, stripPrefix)
 import Database.Persist (entityVal)
 import Database.Persist.Postgresql (withPostgresqlConn, runSqlConn)
-import Network.Mail.Mime (renderSendMail, Address(..))
+import Datarekisteri.Core.Types
+import Network.Mail.Mime (renderSendMailCustom, Address(..))
 import Network.Wai (Application)
-import Network.Wai.Handler.Warp (run)
+import Network.Wai.Handler.Warp (Port, run)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.Gzip
-import Server.API
-import Server.DB
-import Server.DB.Queries (getUserByEmail, getPermissions, getToken)
-import Server.Types
-import Server.Utils (checkPassword)
+import Datarekisteri.Backend.API
+import Datarekisteri.Backend.DB
+import Datarekisteri.Backend.DB.Queries (getUserByEmail, getPermissions, getToken)
+import Datarekisteri.Backend.Types
+import Datarekisteri.Backend.Utils (checkPassword)
+import System.Directory (findExecutable)
+import System.Process (callProcess)
+import Options.Applicative hiding (header)
+import qualified Options.Applicative as O
 import Web.Scotty.Trans hiding (readEither)
-import qualified Data.ByteString.Base64 as B64 (decode)
+import qualified "base64" Data.ByteString.Base64 as B64 (decodeBase64)
+import Paths_datarekisteri_backend
 
 main :: IO ()
-main = run 3100 =<< serverApp
+main = do
+    config <- readConfig >>= checkSendmailPath
+    runMigrations (configDbUrl config)
+    serverApp config >>= run 3100
 
-serverApp :: IO Application
-serverApp = scottyAppT runAPIM $ do
+readConfig :: IO Config
+readConfig = do
+    execParser $ info (configOpts <**> helper)
+            (fullDesc <> progDesc "Serve a GraphQL API for datarekisteri"
+            <> O.header "Backend API server for datarekisteri")
+
+checkSendmailPath :: Config -> IO Config
+checkSendmailPath config = do
+    sendmailPath <- maybe (error "Sendmail command or file not found!") pure =<<
+        findExecutable (configSendmail config)
+    pure $ config {configSendmail = sendmailPath}
+
+configOpts :: Parser Config
+configOpts = Config
+    <$> strOption (long "sendmail" <> short 'm' <> metavar "COMMAND" <> value "sendmail" <> help "Sendmail command")
+    <*> (Address
+        <$> optional (strOption (long "sender-name" <> short 'n' <> metavar "NAME" <> help "Display name for email address"))
+        <*> strOption (long "address" <> short 'a' <> metavar "EMAIL" <> help "Email address to send mail"))
+    <*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3100 <> help "Port to listen on")
+    <*> strOption (long "db-url" <> short 'u' <> metavar "URL" <> value "postgres:///datarekisteri-backend" <> help "Postgresql database url")
+
+runMigrations :: Text -> IO ()
+runMigrations dbUrl = do
+    migrationsPath <- getDataFileName "db/migrations"
+    callProcess "dbmate" ["--url", toString dbUrl, "--migrations-dir", migrationsPath, "up"]
+
+serverApp :: Config -> IO Application
+serverApp config = scottyAppT (runAPIM config) $ do
     middleware $ gzip def
     middleware $ cors $ const $ Just CorsResourcePolicy
         { corsOrigins = Nothing -- all
@@ -44,7 +77,7 @@ serverApp = scottyAppT runAPIM $ do
         , corsRequireOrigin = False
         , corsIgnoreFailures = False
         }
-    post "/api" $ do
+    post "/" $ do
         maybeAuthorization <- fmap toText <$> header "Authorization"
         let maybeBasic = parseBasic maybeAuthorization
             maybeBearer = parseBearer maybeAuthorization
@@ -80,7 +113,7 @@ parseBasic txt = do
     [authType, authData] <- words <$> txt
     guard $ toLower authType == "basic"
     (email, password) <- rightToMaybe $
-        breakOn' ":" . decodeUtf8 <$> B64.decode (encodeUtf8 authData)
+        breakOn' ":" . decodeUtf8 <$> B64.decodeBase64 (encodeUtf8 authData)
     emailAddress <- toEmail email
     pure $ BasicAuth {..}
         where breakOn' x xs = let (fst, snd) = breakOn x xs
@@ -112,18 +145,29 @@ newtype APIM a = APIM (ReaderT RequestState IO a)
 data RequestState = RequestState
     { stateCurrentUser :: Maybe UserID
     , statePermissions :: Map Scope Permission
+    , stateConfig :: Config
     }
 
+data Config = Config
+    { configSendmail :: FilePath
+    , configEmailAddress :: Address
+    , configPort :: Port
+    , configDbUrl :: Text
+    }
 
 instance MonadTime APIM where
     currentTime = liftIO currentTime
 
 instance MonadDB APIM where
-    runQuery = liftIO . runStderrLoggingT . withPostgresqlConn "postgres:///id.rekisteri" . runSqlConn
+    runQuery query = do
+        dbUrl <- asks $ configDbUrl . stateConfig
+        liftIO $ runStderrLoggingT $ withPostgresqlConn (encodeUtf8 dbUrl) $ runSqlConn query
 
 instance MonadEmail APIM where
-    sendEmail = liftIO . renderSendMail
-    fromAddress = pure $ Address Nothing "id@datat.fi"
+    sendEmail email = do
+        sendmailPath <- asks $ configSendmail . stateConfig
+        liftIO $ renderSendMailCustom sendmailPath ["-t"] email
+    fromAddress = asks $ configEmailAddress . stateConfig
 
 instance MonadRequest APIM where
     currentUser = asks stateCurrentUser
@@ -150,8 +194,9 @@ instance MonadPermissions APIM where
 
                   f <$> asks statePermissions
 
-readPermission :: Text -> Maybe (Map Scope Permission)
-readPermission = rightToMaybe . readEither . toString 
-
-runAPIM :: APIM a -> IO a
-runAPIM (APIM m) = runReaderT m RequestState { stateCurrentUser = Nothing, statePermissions = fromList [] }
+runAPIM :: Config -> APIM a -> IO a
+runAPIM config (APIM m) = runReaderT m RequestState
+    { stateCurrentUser = Nothing
+    , statePermissions = fromList []
+    , stateConfig = config
+    }

backend/src/Datarekisteri/Backend/API.hs

@@ -12,11 +12,13 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
+
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Server.API (coreApp, runApp, resolver) where
+module Datarekisteri.Backend.API (coreApp, runApp, resolver) where
 
-import Relude hiding (Undefined, void, when)
+import Relude hiding (Undefined, void, when, get)
 
 import "cryptonite" Crypto.Random (getRandomBytes, MonadRandom)
 import Control.Monad.Except (MonadError, throwError)
@@ -25,13 +27,14 @@ import Data.Morpheus.Server (deriveApp, runApp)
 import Data.Morpheus.Server.Types (defaultRootResolver, RootResolver(..), Undefined)
 import Data.Morpheus.Types (Arg(..), GQLType, GQLError, App)
 import Data.Time (nominalDay)
-import Database.Persist (Entity, entityVal, (=.))
-import Server.DB
-import Server.DB.Queries
-import Server.Email (sendVerificationEmail)
-import Server.Types
-import Server.Utils
-import qualified Data.ByteString.Base64 as B64 (encode)
+import Database.Persist (Entity, entityVal, entityKey, get, (=.))
+import Datarekisteri.Core.Types
+import Datarekisteri.Backend.DB
+import Datarekisteri.Backend.DB.Queries
+import Datarekisteri.Backend.Email (sendVerificationEmail)
+import Datarekisteri.Backend.Types
+import Datarekisteri.Backend.Utils
+import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64)
 import qualified Data.Text as T (null, chunksOf, intercalate)
 
 -- General functions, maybe migrate to Utils or API.Utils
@@ -48,15 +51,16 @@ void m = m >> pure Unit
 when :: Monad m => Bool -> m a -> m Unit
 when b m = if b then void m else pure Unit
 
-dbUserToUser :: Monad m => Entity DBUser -> User m
+dbUserToUser :: MonadDB m => Entity DBUser -> User m
 dbUserToUser user = let id = entityToID user
                         DBUser {..} = entityVal user
                         Success (MemberData {..}) = fromJSON dBUserMemberData
-                        -- Explodes if database doesn't contain needed data
+                        -- XXX: Explodes if database doesn't contain needed data
                     in User
                         { id = pure id
-                        , email = pure dBUserEmail
-                        , pendingEmail = pure dBUserPendingEmail
+                        , email = fmap (dBEmailEmail . entityVal) <$> getUserEmail id
+                        , pendingEmail = fmap (dBEmailEmail . entityVal) <$> getUserPendingEmail id
+                        , phoneNumber = pure phoneNumber
                         , name = pure name
                         , nickname = pure $ fromMaybe (error "db contains empty name") $
                             maybe (viaNonEmpty head $ words $ name) Just nickname
@@ -111,9 +115,7 @@ newUser (ApplicationData {..}) = do
     when (T.null homeplace) $ throwError "Homeplace must not be empty"
     let memberData = MemberData { nickname = nickname >>= \x -> if T.null x then Nothing else Just x, ..}
     user <- addUser $ DBUser
-        { dBUserEmail = Nothing
-        , dBUserPendingEmail = Just email
-        , dBUserRegistered = time
+        { dBUserRegistered = time
         , dBUserToBeDeleted = Just $ verificationExpires
         , dBUserPasswordCrypt = passwordHash
         , dBUserPermissions = permissions
@@ -121,9 +123,13 @@ newUser (ApplicationData {..}) = do
         , dBUserSeceded = Nothing
         , dBUserRejected = Nothing
         , dBUserMemberData = toJSON memberData
-        , dBUserEmailVerificationSecret = Just secret
         }
-    sendVerificationSecret user
+    email <- addEmail $ DBEmail
+        { dBEmailUid = toDBKey user
+        , dBEmailEmail = email
+        , dBEmailVerificationSecret = Just secret
+        }
+    sendVerificationSecret email
     return user
 
 verificationExpireTime :: MonadTime m => m Time
@@ -132,11 +138,11 @@ verificationExpireTime = addTime (7 * nominalDay) <$> currentTime
 genVerificationSecret :: MonadRandom m => m Text
 genVerificationSecret = T.intercalate "-" . T.chunksOf 4 . base32 <$> getRandomBytes 10
 
-sendVerificationSecret :: (MonadEmail m, MonadDB m, MonadError GQLError m) => UserID -> m Unit
-sendVerificationSecret user = void $ do
-    maybeDBUser <- fmap entityVal <$> getByID user
-    let email = dBUserPendingEmail =<< maybeDBUser
-        secret = dBUserEmailVerificationSecret =<< maybeDBUser
+sendVerificationSecret :: (MonadEmail m, MonadDB m, MonadError GQLError m) => Key DBEmail -> m Unit
+sendVerificationSecret email = void $ do
+    maybeDBEmail <- runQuery $ get email
+    let email = dBEmailEmail <$> maybeDBEmail
+        secret = dBEmailVerificationSecret =<< maybeDBEmail
         args = (,) <$> email <*> secret
     maybe (pure ()) (uncurry sendVerificationEmail) args
 
@@ -144,20 +150,23 @@ updateUser :: (MonadRandom m, MonadDB m, MonadEmail m, MonadError GQLError m) =>
     UserID -> UpdateData -> m UserID
 updateUser user (UpdateData {..}) = do
     hash <- sequence $ hashPassword <$> password
-    -- assert stuff valid
-    verificationSecretUpdate <- maybe (pure Nothing)
-        (const $ Just . (DBUserEmailVerificationSecret =. ) . Just <$> genVerificationSecret) email
+    -- TODO: assert stuff valid
     user <- updateUserData user
-        (catMaybes [(DBUserPendingEmail =. ) . Just <$> email, verificationSecretUpdate,
-            (DBUserPasswordCrypt =.) <$> hash])
-        (catMaybes [SetUserName <$> name, SetUserNickname . Just <$> nickname, SetUserHomeplace <$> homeplace])
-    when (isJust email) $ sendVerificationSecret user
+        (catMaybes [(DBUserPasswordCrypt =.) <$> hash])
+        (catMaybes [SetUserName <$> name, SetUserNickname . Just <$> nickname,
+            SetUserHomeplace <$> homeplace, SetUserPhoneNumber <$> phoneNumber])
+    case email of
+      Nothing -> pure Unit
+      Just email' -> do
+          verificationSecret <- genVerificationSecret
+          emailKey <- updateEmail user email' verificationSecret
+          sendVerificationSecret emailKey
     return user
 
 makeNewToken :: (MonadError GQLError m, MonadDB m, MonadTime m, MonadRandom m, MonadPermissions m) =>
     NewTokenArgs -> UserID -> m TokenID
 makeNewToken (NewTokenArgs {..}) user = do
-    tokenData <- decodeUtf8 . B64.encode <$> getRandomBytes 128
+    tokenData <- B64.encodeBase64 <$> getRandomBytes 128
     time <- currentTime
     permissions <- maybe currentPermissions pure =<< maybe (pure Nothing) toPermissions permissions
     addToken $ DBToken
@@ -220,7 +229,8 @@ resolveMutation = Mutation
         user <- fromMaybeFail "" maybeUser
         pure $ dbUserToUser user
     , verifyEmail = \(Arg secret) -> void $ verifyEmailSecret secret >>= \x -> when (x < 1) $ throwError "Invalid verification secret"
-    , resendVerificationEmail = \(Arg id) -> targetUser id >>= sendVerificationSecret
+    , resendVerificationEmail = \(Arg id) -> targetUser id >>= getUserPendingEmail >>=
+        maybe (pure Unit) (sendVerificationSecret . entityKey)
     , update = \updateData (Arg id) -> targetUser id >>= \user ->
         requirePermission (Profile user) ReadWrite >>
             updateUser user updateData >> getByID user >>= fmap dbUserToUser . fromMaybeFail ""
@@ -249,6 +259,7 @@ data User m = User
     , pendingEmail :: m (Maybe Email)
     , name :: m Text
     , nickname :: m Text
+    , phoneNumber :: m PhoneNumber
     , birthdate :: m Date
     , homeplace :: m Text
     , registered :: m Time
@@ -281,6 +292,7 @@ data Token m = Token
 
 data ApplicationData = ApplicationData
     { email :: Email
+    , phoneNumber :: PhoneNumber
     , password :: Text
     , name :: Text
     , nickname :: Maybe Text
@@ -291,6 +303,7 @@ data ApplicationData = ApplicationData
 
 data UpdateData = UpdateData
     { email :: Maybe Email
+    , phoneNumber :: Maybe PhoneNumber
     , password :: Maybe Text
     , name :: Maybe Text
     , nickname :: Maybe Text

backend/src/Datarekisteri/Backend/DB.hs

@@ -12,7 +12,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 
-module Server.DB where
+module Datarekisteri.Backend.DB where
 
 import Data.ByteString (ByteString)
 import Data.Text (Text)
@@ -20,13 +20,11 @@ import Database.Persist.TH (persistUpperCase, mkPersist, sqlSettings)
 import Database.Persist (Entity, Key, entityKey, PersistEntity)
 import Database.Persist.Sql (fromSqlKey, toSqlKey)
 import Database.Persist.Postgresql.JSON (Value)
-import Server.Types
+import Datarekisteri.Core.Types
+import Datarekisteri.Backend.Types
 
 mkPersist sqlSettings [persistUpperCase|
 DBUser sql=users
-  email (Maybe Email) sqltype=varchar(255)
-  pendingEmail (Maybe Email) sqltype=varchar(255)
-  emailVerificationSecret (Maybe Text)
   registered Time
   passwordCrypt PasswordHash
   permissions Text
@@ -36,12 +34,21 @@ DBUser sql=users
   toBeDeleted (Maybe Time)
   memberData Value sqltype=jsonb
 
-  UniqueEmail email
-  UniquePendingEmail pendingEmail
-  UniqueVerification emailVerificationSecret
-
   deriving (Show)
 
+DBEmail sql=emails
+  uid DBUserId
+  email Email sqltype=varchar(320)
+  verificationSecret (Maybe Text)
+
+  UniqueUserVerified uid verificationSecret
+  -- This enables using persistent functions to get unique verified emails. The real
+  -- constraint is stricter and doesn't allow having more than one null and one non-null
+  -- verification secret but it's too complicated for persistent to understand.
+
+  UniqueEmail email
+  UniqueVerification verificationSecret
+
 DBKey sql=keys
   uid DBUserId
   data ByteString
@@ -72,24 +79,24 @@ class PersistEntity (DB a) =>  FromDBKey a where
 
 instance FromDBKey UserID where
     type DB UserID = DBUser
-    fromDBKey = UserID . fromSqlKey
+    fromDBKey = UserID . fromIntegral . fromSqlKey
 
 instance FromDBKey TokenID where
     type DB TokenID = DBToken
-    fromDBKey = TokenID . fromSqlKey
+    fromDBKey = TokenID . fromIntegral . fromSqlKey
 
 instance FromDBKey KeyID where
     type DB KeyID = DBKey
-    fromDBKey = KeyID . fromSqlKey
+    fromDBKey = KeyID . fromIntegral . fromSqlKey
 
 class FromDBKey a => ToDBKey a where
     toDBKey :: a -> Key (DB a)
 
 instance ToDBKey UserID where
-    toDBKey (UserID x) = toSqlKey x
+    toDBKey (UserID x) = toSqlKey $ fromIntegral x
 
 instance ToDBKey KeyID where
-    toDBKey (KeyID x) = toSqlKey x
+    toDBKey (KeyID x) = toSqlKey $ fromIntegral x
 
 instance ToDBKey TokenID where
-    toDBKey (TokenID x) = toSqlKey x
+    toDBKey (TokenID x) = toSqlKey $ fromIntegral x

backend/src/Datarekisteri/Backend/DB/Queries.hs

@@ -4,27 +4,29 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Server.DB.Queries where
+module Datarekisteri.Backend.DB.Queries where
 
-import Server.DB as DB
-import Server.Types
+import Datarekisteri.Backend.DB as DB
+import Datarekisteri.Backend.Types
+import Datarekisteri.Core.Types
 import Data.Text (Text)
 import Database.Esqueleto.Experimental
-import qualified Database.Persist as Persist (update, (=.))
+import qualified Database.Persist as Persist (update, (=.), (==.))
 import qualified Database.Persist.Types as Persist (Update)
-import Data.Maybe (listToMaybe, isJust)
+import Data.Maybe (listToMaybe)
 import Data.Aeson (fromJSON, toJSON, Result(..))
-import GHC.Int (Int64)
 
 getByID :: (MonadDB m, ToDBKey k, PersistEntityBackend (DB k) ~ SqlBackend) => k -> m (Maybe (Entity (DB k)))
 getByID id = let key = toDBKey id in runQuery $ fmap (Entity key) <$> get key
 
 getUserByEmail :: MonadDB m => Email -> m (Maybe (Entity DBUser))
-getUserByEmail email = runQuery $ getBy (UniqueEmail $ Just email) >>=
-    maybe ((>>= guardUnconfirmed) <$> getBy (UniquePendingEmail $ Just email)) (pure . Just)
-        where guardUnconfirmed user
-                | isJust (dBUserEmail $ entityVal user) = Nothing
-                | otherwise = Just user
+getUserByEmail email = fmap listToMaybe $ runQuery $ select $ do
+    (dbUser :& dbEmail) <- from $ table @DBUser `crossJoin` table @DBEmail
+    where_ $ dbEmail ^. DBEmailEmail ==. val email &&. dbUser ^. DBUserId ==. dbEmail ^. DBEmailUid
+    -- There is only one row in DBEmail with a given email (unique constraint) and a DBEmail only
+    -- has one user id and there is only row in DBUser with a given user id (primary key). Thus
+    -- there is at most one combination of rows from DBEmail and DBUser that satisfy this query.
+    pure dbUser
 
 addUser :: MonadDB m => DBUser -> m UserID
 addUser = fmap fromDBKey . runQuery . insert
@@ -74,19 +76,61 @@ applicants = runQuery $ select $ do
     where_ $ isApplicant users
     pure $ users
 
+isVerified :: SqlExpr (Entity DBEmail) -> SqlExpr (Value Bool)
+isVerified email = isNothing (email ^. DBEmailVerificationSecret)
+
+hasVerifiedEmail :: SqlExpr (Value DBUserId) -> SqlExpr (Value Bool)
+hasVerifiedEmail userId = not_ $ isNothing $ subSelect $ do
+    emails <- from $ table @DBEmail
+    where_ $ emails ^. DBEmailUid ==. userId &&. isVerified emails
+    pure $ val True -- This is not used anywhere, there just isn't a PersistField instance for ()
+
 isApplicant :: SqlExpr (Entity DBUser) -> SqlExpr (Value Bool)
-isApplicant user = isNothing (user ^. DBUserAccepted) &&. not_ (isNothing (user ^. DBUserEmail)) &&. isNothing (user ^. DBUserRejected)
+isApplicant user = isNothing (user ^. DBUserAccepted)
+    &&. hasVerifiedEmail (user ^. DBUserId)
+    &&. isNothing (user ^. DBUserRejected)
 
 isMember :: SqlExpr (Entity DBUser) -> SqlExpr (Value Bool)
 isMember user = not_ (isNothing (user ^. DBUserAccepted)) &&. isNothing (user ^. DBUserSeceded)
 
-verifyEmailSecret :: MonadDB m => Text -> m Int64
-verifyEmailSecret secret = runQuery $ updateCount $ \user -> do
-    set user [ DBUserEmailVerificationSecret =. val Nothing
-             , DBUserEmail =. user ^. DBUserPendingEmail
-             , DBUserPendingEmail =. val Nothing
-             ]
-    where_ $ user ^. DBUserEmailVerificationSecret ==. just (val secret)
+verifyEmailSecret :: MonadDB m => Text -> m Integer
+verifyEmailSecret secret = fmap fromIntegral $ runQuery $ updateCount $ \email -> do
+    set email [DBEmailVerificationSecret =. val Nothing]
+    where_ $ email ^. DBEmailVerificationSecret ==. val (Just secret)
+
+getUserEmail' :: MonadDB m => UserID -> Bool -> m (Maybe (Entity DBEmail))
+getUserEmail' user verified = fmap listToMaybe $ runQuery $ select $ do
+    email <- from $ table @DBEmail
+    where_ $ email ^. DBEmailUid ==. val (toDBKey user)
+        &&. isNothing (email ^. DBEmailVerificationSecret) ==. val verified
+    pure email
+
+getUserEmail :: MonadDB m => UserID -> m (Maybe (Entity DBEmail))
+getUserEmail user = getUserEmail' user True
+
+getUserPendingEmail :: MonadDB m => UserID -> m (Maybe (Entity DBEmail))
+getUserPendingEmail user = getUserEmail' user False
+
+addEmail :: MonadDB m => DBEmail -> m (Key DBEmail)
+addEmail = runQuery . insert
+
+updateEmail :: MonadDB m => UserID -> Email -> Text -> m (Key DBEmail)
+updateEmail user email secret = runQuery $ do
+    delete $ do
+        dbEmail <- from $ table @DBEmail
+        where_ $ dbEmail ^. DBEmailUid ==. val (toDBKey user) &&. not_ (isVerified dbEmail)
+    verifiedEmail <- fmap listToMaybe $ select $ do
+        dbEmail <- from $ table @DBEmail
+        where_ $ dbEmail ^. DBEmailUid ==. val (toDBKey user)
+            &&. dbEmail ^. DBEmailEmail ==. val email
+        pure dbEmail
+    case verifiedEmail of
+      Just (Entity key _) -> pure key
+      Nothing -> insert DBEmail
+          { dBEmailUid = toDBKey user
+          , dBEmailEmail = email
+          , dBEmailVerificationSecret = Just secret
+          }
 
 markAsAccepted :: MonadDB m => UserID -> Time -> m ()
 markAsAccepted userID time = runQuery $ update $ \user -> do
@@ -107,9 +151,11 @@ updateUserData user updates memberDataUpdates = runQuery $ do
         updateData (SetUserName x) memberData = memberData { name = x }
         updateData (SetUserNickname x) memberData = memberData { nickname = x }
         updateData (SetUserHomeplace x) memberData = memberData { homeplace = x }
+        updateData (SetUserPhoneNumber x) memberData = memberData { phoneNumber = x }
     Persist.update key (userUpdates <> updates)
     pure user
 
 data UserUpdate = SetUserName Text
                 | SetUserNickname (Maybe Text)
                 | SetUserHomeplace Text
+                | SetUserPhoneNumber PhoneNumber

backend/src/Datarekisteri/Backend/Email.hs

@@ -1,10 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Server.Email where
+module Datarekisteri.Backend.Email where
 
-import Server.Types
+import Datarekisteri.Backend.Types
 import Data.Text (Text)
 import Data.Text.Lazy (fromStrict)
+import Datarekisteri.Core.Types
 import Network.Mail.Mime
 
 sendVerificationEmail :: MonadEmail m => Email -> Text -> m ()

backend/src/Datarekisteri/Backend/Types.hs

@@ -0,0 +1,107 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PackageImports #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Datarekisteri.Backend.Types where
+
+import Relude
+
+import Control.Monad.Except (throwError)
+import Control.Monad.Logger (LoggingT)
+import Datarekisteri.Core.Types
+import Data.Aeson (ToJSON(..), FromJSON(..))
+import Data.ByteArray (ByteArray, ByteArrayAccess)
+import Data.Morpheus.App.Internal.Resolving (Resolver, LiftOperation)
+import Data.Morpheus.Server.Types (SCALAR)
+import Data.Morpheus.Types (GQLType, DecodeScalar(..), KIND, EncodeScalar(..),
+    ScalarValue(..), MonadError, GQLError)
+import Data.Morpheus.Types.GQLScalar (scalarToJSON, scalarFromJSON)
+import Data.Time (UTCTime, getCurrentTime, NominalDiffTime, addUTCTime, Day)
+import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
+import qualified Data.Text as T
+import Data.Char (isSpace)
+import Database.Persist.Class (PersistField(..))
+import Database.Persist.PersistValue (PersistValue(..))
+import Database.Persist.Sql (PersistFieldSql(..), SqlBackend)
+import Network.Mail.Mime (Mail, Address(..))
+import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress)
+import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64, decodeBase64)
+import "cryptonite" Crypto.Random (MonadRandom(..))
+
+forward :: Monad m => [a] -> m [Maybe a]
+forward = pure . map Just
+
+requirePermission :: (MonadPermissions m, MonadError GQLError m) => Scope -> Permission -> m ()
+requirePermission scope permission = unlessM (hasPermission scope permission) $
+    throwError $ "Insufficient permissions, " <> show permission <> " for "
+        <> show scope <> " required."
+
+data MemberData = MemberData
+    { name :: Text
+    , nickname :: Maybe Text
+    , birthdate :: Date
+    , homeplace :: Text
+    , application :: Text
+    , phoneNumber :: PhoneNumber
+    } deriving (Show, Eq, Generic)
+
+instance FromJSON MemberData
+instance ToJSON MemberData
+
+newtype PasswordHash = PasswordHash ByteString
+    deriving (Eq, Show, Ord, Semigroup, Monoid, ByteArrayAccess, ByteArray,
+        PersistField, PersistFieldSql)
+
+class Monad m => MonadTime m where
+    currentTime :: m Time
+
+instance MonadTime IO where
+    currentTime = Time <$> getCurrentTime
+
+class Monad m => MonadDB m where
+    runQuery :: ReaderT SqlBackend (LoggingT IO) a -> m a
+    -- TODO refactor so that it is possible to define a IO-less db, for safety and testability.
+    --      Is there a way to do this that doesn't require moving all db calls to the class?
+    --      Probably not :(
+
+class Monad m => MonadEmail m where
+    sendEmail :: Mail -> m ()
+    fromAddress :: m Address
+
+class Monad m => MonadRequest m where
+    currentUser :: m (Maybe UserID)
+
+class Monad m => MonadPermissions m where
+    hasPermission :: Scope -> Permission -> m Bool
+    currentPermissions :: m Text
+    defaultPermissions :: m Text
+    toPermissions :: Text -> m (Maybe Text)
+
+instance (MonadDB m, LiftOperation o) => MonadDB (Resolver o () m) where
+    runQuery = lift . runQuery
+
+instance (MonadRequest m, LiftOperation o) => MonadRequest (Resolver o () m) where
+    currentUser = lift currentUser
+
+instance (MonadPermissions m, LiftOperation o) => MonadPermissions (Resolver o () m) where
+    hasPermission scope permission = lift $ hasPermission scope permission
+    defaultPermissions = lift defaultPermissions
+    currentPermissions = lift currentPermissions
+    toPermissions = lift . toPermissions
+
+instance (MonadEmail m, LiftOperation o) => MonadEmail (Resolver o () m) where
+    sendEmail = lift . sendEmail
+    fromAddress = lift fromAddress
+
+instance (MonadRandom m, LiftOperation o) => MonadRandom (Resolver o () m) where
+    getRandomBytes = lift . getRandomBytes
+
+instance (MonadTime m, LiftOperation o) => MonadTime (Resolver o () m) where
+    currentTime = lift currentTime

backend/src/Datarekisteri/Backend/Utils.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE PackageImports #-}
 
-module Server.Utils where
+module Datarekisteri.Backend.Utils where
 
 import Data.ByteArray.Encoding (convertToBase, Base(..))
 import Data.ByteString (ByteString)
@@ -8,7 +8,7 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Text (Text)
 import qualified Crypto.KDF.BCrypt as Crypt (hashPassword, validatePassword)
 import "cryptonite" Crypto.Random (MonadRandom)
-import Server.Types
+import Datarekisteri.Backend.Types
 
 base32 :: ByteString -> Text
 base32 = decodeUtf8 . convertToBase Base32

backend/src/Datarekisteri/CLI.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+import Relude
+
+import "cryptonite" Crypto.Random (MonadRandom(..))
+
+import Control.Monad.Logger (runStderrLoggingT)
+import Data.Aeson (toJSON)
+import Database.Persist.Postgresql (withPostgresqlConn, runSqlConn)
+import Datarekisteri.Backend.DB
+import Datarekisteri.Backend.DB.Queries
+import Datarekisteri.Backend.Types
+import Datarekisteri.Backend.Utils
+import Datarekisteri.Core.Types
+import Options.Applicative
+import System.IO.Echo (withoutInputEcho)
+
+main :: IO ()
+main = do
+    CLIOptions {..} <- execParser $ info (cliOptions <**> helper) mempty
+    runCLIM optionsDBUrl $ case optionsSubCommand of
+      AddUser {..} -> do
+          time <- currentTime
+          passwordHash <- putStr "Password: " >> liftIO (withoutInputEcho getLine) >>= hashPassword
+          userID <- addUser $ DBUser
+              { dBUserRegistered = time
+              , dBUserToBeDeleted = Nothing
+              , dBUserPasswordCrypt = passwordHash
+              , dBUserPermissions = show addUserPermissions
+              , dBUserAccepted = Just time
+              , dBUserSeceded = Nothing
+              , dBUserRejected = Nothing
+              , dBUserMemberData = toJSON $ MemberData
+                  { nickname = addUserNickname
+                  , name = addUserName
+                  , birthdate = addUserBirthdate
+                  , homeplace = addUserHomeplace
+                  , application = addUserApplication
+                  , phoneNumber = addUserPhoneNumber
+                  }
+              }
+          _ <- addEmail $ DBEmail
+              { dBEmailUid = toDBKey userID
+              , dBEmailEmail = addUserEmail
+              , dBEmailVerificationSecret = Nothing
+              }
+          pure ()
+
+cliOptions :: Parser CLIOptions
+cliOptions = CLIOptions
+    <$> strOption (short 'u' <> long "db-url" <> metavar "URL" <> value "postgres:///datarekisteri-backend")
+    <*> cliCommandParser
+
+cliCommandParser :: Parser CLISubCommand
+cliCommandParser = hsubparser
+    $ command "add-user" (info addUserCommand (progDesc "Add a user to datarekisteri"))
+
+addUserCommand :: Parser CLISubCommand
+addUserCommand = AddUser
+    <$> optional (strOption (long "nickname" <> metavar "NAME"))
+    <*> strOption (long "name" <> metavar "NAME")
+    <*> option (maybeReader $ toDate . toText) (long "birthdate" <> metavar "DATE" <> help "The user's birthdate, YYYY-MM-DD")
+    <*> strOption (long "homeplace" <> metavar "NAME" <> help "The user's homeplace, usually a city")
+    <*> option (maybeReader $ toPhoneNumber . toText) (long "phone-number" <> metavar "PHONE" <> help "The user's phone number. Only numbers, spaces and the plus-sign are allowed")
+    <*> option (maybeReader $ toEmail . toText) (long "email" <> metavar "EMAIL" <> help "The user's email address.")
+    <*> (fromList <$> many permissionParser)
+    <*> strOption (long "application" <> metavar "TEXT" <> value "Added by the admin.")
+
+permissionParser :: Parser (Scope, Permission)
+permissionParser = (,)
+    <$> option auto (long "scope")
+    <*> option auto (long "permission")
+
+data CLIOptions = CLIOptions 
+    { optionsDBUrl :: String
+    , optionsSubCommand :: CLISubCommand
+    }
+
+data CLISubCommand = AddUser
+    { addUserNickname :: Maybe Text
+    , addUserName :: Text
+    , addUserBirthdate :: Date
+    , addUserHomeplace :: Text
+    , addUserPhoneNumber :: PhoneNumber
+    , addUserEmail :: Email
+    , addUserPermissions :: Map Scope Permission
+    , addUserApplication :: Text
+    }
+
+newtype CLIM a = CLIM (ReaderT String IO a)
+    deriving (Functor, Applicative, Monad, MonadIO, MonadReader String)
+
+instance MonadTime CLIM where
+    currentTime = liftIO currentTime
+
+instance MonadDB CLIM where
+    runQuery query = do
+        dbUrl <- ask
+        liftIO $ runStderrLoggingT $ withPostgresqlConn (encodeUtf8 dbUrl) $ runSqlConn query
+
+instance MonadRandom CLIM where
+    getRandomBytes = liftIO . getRandomBytes
+
+runCLIM :: String -> CLIM a -> IO a
+runCLIM dbUrl (CLIM m) = runReaderT m dbUrl

channels.scm

@@ -0,0 +1,11 @@
+(list (channel
+        (name 'guix)
+        (url "https://git.savannah.gnu.org/git/guix.git")
+        (branch "master")
+        (commit
+          "7309da3ba64a191f074807275d8c5661a25c035c")
+        (introduction
+          (make-channel-introduction
+            "9edb3f66fd807b096b48283debdcddccfea34bad"
+            (openpgp-fingerprint
+              "BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA")))))

core/COPYING.md

@@ -0,0 +1,660 @@
+### GNU AFFERO GENERAL PUBLIC LICENSE
+
+Version 3, 19 November 2007
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+<https://fsf.org/>
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+### Preamble
+
+The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains
+free software for all its users.
+
+When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing
+under this license.
+
+The precise terms and conditions for copying, distribution and
+modification follow.
+
+### TERMS AND CONDITIONS
+
+#### 0. Definitions.
+
+"This License" refers to version 3 of the GNU Affero General Public
+License.
+
+"Copyright" also means copyright-like laws that apply to other kinds
+of works, such as semiconductor masks.
+
+"The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of
+an exact copy. The resulting work is called a "modified version" of
+the earlier work or a work "based on" the earlier work.
+
+A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user
+through a computer network, with no transfer of a copy, is not
+conveying.
+
+An interactive user interface displays "Appropriate Legal Notices" to
+the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+#### 1. Source Code.
+
+The "source code" for a work means the preferred form of the work for
+making modifications to it. "Object code" means any non-source form of
+a work.
+
+A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+The Corresponding Source need not include anything that users can
+regenerate automatically from other parts of the Corresponding Source.
+
+The Corresponding Source for a work in source code form is that same
+work.
+
+#### 2. Basic Permissions.
+
+All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+You may make, run and propagate covered works that you do not convey,
+without conditions so long as your license otherwise remains in force.
+You may convey covered works to others for the sole purpose of having
+them make modifications exclusively for you, or provide you with
+facilities for running those works, provided that you comply with the
+terms of this License in conveying all material for which you do not
+control copyright. Those thus making or running the covered works for
+you must do so exclusively on your behalf, under your direction and
+control, on terms that prohibit them from making any copies of your
+copyrighted material outside their relationship with you.
+
+Conveying under any other circumstances is permitted solely under the
+conditions stated below. Sublicensing is not allowed; section 10 makes
+it unnecessary.
+
+#### 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such
+circumvention is effected by exercising rights under this License with
+respect to the covered work, and you disclaim any intention to limit
+operation or modification of the work as a means of enforcing, against
+the work's users, your or third parties' legal rights to forbid
+circumvention of technological measures.
+
+#### 4. Conveying Verbatim Copies.
+
+You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+#### 5. Conveying Modified Source Versions.
+
+You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these
+conditions:
+
+-   a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+-   b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under
+    section 7. This requirement modifies the requirement in section 4
+    to "keep intact all notices".
+-   c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy. This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged. This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+-   d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+#### 6. Conveying Non-Source Forms.
+
+You may convey a covered work in object code form under the terms of
+sections 4 and 5, provided that you also convey the machine-readable
+Corresponding Source under the terms of this License, in one of these
+ways:
+
+-   a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+-   b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the Corresponding
+    Source from a network server at no charge.
+-   c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source. This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+-   d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge. You need not require recipients to copy the
+    Corresponding Source along with the object code. If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source. Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+-   e) Convey the object code using peer-to-peer transmission,
+    provided you inform other peers where the object code and
+    Corresponding Source of the work are being offered to the general
+    public at no charge under subsection 6d.
+
+A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal,
+family, or household purposes, or (2) anything designed or sold for
+incorporation into a dwelling. In determining whether a product is a
+consumer product, doubtful cases shall be resolved in favor of
+coverage. For a particular product received by a particular user,
+"normally used" refers to a typical or common use of that class of
+product, regardless of the status of the particular user or of the way
+in which the particular user actually uses, or expects or is expected
+to use, the product. A product is a consumer product regardless of
+whether the product has substantial commercial, industrial or
+non-consumer uses, unless such uses represent the only significant
+mode of use of the product.
+
+"Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to
+install and execute modified versions of a covered work in that User
+Product from a modified version of its Corresponding Source. The
+information must suffice to ensure that the continued functioning of
+the modified object code is in no case prevented or interfered with
+solely because modification has been made.
+
+If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or
+updates for a work that has been modified or installed by the
+recipient, or for the User Product in which it has been modified or
+installed. Access to a network may be denied when the modification
+itself materially and adversely affects the operation of the network
+or violates the rules and protocols for communication across the
+network.
+
+Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+#### 7. Additional Terms.
+
+"Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders
+of that material) supplement the terms of this License with terms:
+
+-   a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+-   b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+-   c) Prohibiting misrepresentation of the origin of that material,
+    or requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+-   d) Limiting the use for publicity purposes of names of licensors
+    or authors of the material; or
+-   e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+-   f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions
+    of it) with contractual assumptions of liability to the recipient,
+    for any liability that these contractual assumptions directly
+    impose on those licensors and authors.
+
+All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions; the
+above requirements apply either way.
+
+#### 8. Termination.
+
+You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+However, if you cease all violation of this License, then your license
+from a particular copyright holder is reinstated (a) provisionally,
+unless and until the copyright holder explicitly and finally
+terminates your license, and (b) permanently, if the copyright holder
+fails to notify you of the violation by some reasonable means prior to
+60 days after the cessation.
+
+Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+#### 9. Acceptance Not Required for Having Copies.
+
+You are not required to accept this License in order to receive or run
+a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+#### 10. Automatic Licensing of Downstream Recipients.
+
+Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+#### 11. Patents.
+
+A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+A contributor's "essential patent claims" are all patent claims owned
+or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+A patent license is "discriminatory" if it does not include within the
+scope of its coverage, prohibits the exercise of, or is conditioned on
+the non-exercise of one or more of the rights that are specifically
+granted under this License. You may not convey a covered work if you
+are a party to an arrangement with a third party that is in the
+business of distributing software, under which you make payment to the
+third party based on the extent of your activity of conveying the
+work, and under which the third party grants, to any of the parties
+who would receive the covered work from you, a discriminatory patent
+license (a) in connection with copies of the covered work conveyed by
+you (or copies made from those copies), or (b) primarily for and in
+connection with specific products or compilations that contain the
+covered work, unless you entered into that arrangement, or that patent
+license was granted, prior to 28 March 2007.
+
+Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+#### 12. No Surrender of Others' Freedom.
+
+If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under
+this License and any other pertinent obligations, then as a
+consequence you may not convey it at all. For example, if you agree to
+terms that obligate you to collect a royalty for further conveying
+from those to whom you convey the Program, the only way you could
+satisfy both those terms and this License would be to refrain entirely
+from conveying the Program.
+
+#### 13. Remote Network Interaction; Use with the GNU General Public License.
+
+Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your
+version supports such interaction) an opportunity to receive the
+Corresponding Source of your version by providing access to the
+Corresponding Source from a network server at no charge, through some
+standard or customary means of facilitating copying of software. This
+Corresponding Source shall include the Corresponding Source for any
+work covered by version 3 of the GNU General Public License that is
+incorporated pursuant to the following paragraph.
+
+Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+#### 14. Revised Versions of this License.
+
+The Free Software Foundation may publish revised and/or new versions
+of the GNU Affero General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever
+published by the Free Software Foundation.
+
+If the Program specifies that a proxy can decide which future versions
+of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+#### 15. Disclaimer of Warranty.
+
+THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT
+WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
+PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE
+DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
+CORRECTION.
+
+#### 16. Limitation of Liability.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR
+CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT
+NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR
+LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM
+TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER
+PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+#### 17. Interpretation of Sections 15 and 16.
+
+If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+END OF TERMS AND CONDITIONS
+
+### How to Apply These Terms to Your New Programs
+
+If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively state
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+        <one line to give the program's name and a brief idea of what it does.>
+        Copyright (C) <year>  <name of author>
+
+        This program is free software: you can redistribute it and/or modify
+        it under the terms of the GNU Affero General Public License as
+        published by the Free Software Foundation, either version 3 of the
+        License, or (at your option) any later version.
+
+        This program is distributed in the hope that it will be useful,
+        but WITHOUT ANY WARRANTY; without even the implied warranty of
+        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        GNU Affero General Public License for more details.
+
+        You should have received a copy of the GNU Affero General Public License
+        along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper
+mail.
+
+If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for
+the specific requirements.
+
+You should also get your employer (if you work as a programmer) or
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. For more information on this, and how to apply and follow
+the GNU AGPL, see <https://www.gnu.org/licenses/>.

core/Setup.hs

@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain

core/datarekisteri-core.cabal

@@ -0,0 +1,30 @@
+cabal-version: 3.6
+name: datarekisteri-core
+version: 0.0.1
+author: Saku Laesvuori
+license: AGPL-3.0-or-later
+license-file: COPYING.md
+build-type: Simple
+stability: alpha
+
+library
+  build-depends:
+    aeson,
+    base,
+    base64,
+    cryptonite,
+    email-validate,
+    memory,
+    morpheus-graphql,
+    morpheus-graphql-app,
+    morpheus-graphql-core,
+    morpheus-graphql-server,
+    persistent,
+    relude,
+    text,
+    time,
+    containers,
+  exposed-modules:
+    Datarekisteri.Core.Types
+  hs-source-dirs: src
+  default-language: Haskell2010

core/src/Datarekisteri/Core/Types.hs

@@ -1,42 +1,34 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE PackageImports #-}
-
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE TypeFamilies #-}
 
-module Server.Types where
+module Datarekisteri.Core.Types where
 
 import Relude
 
-import Control.Monad.Except (throwError)
-import Control.Monad.Logger (LoggingT)
 import Data.Aeson (ToJSON(..), FromJSON(..))
-import Data.ByteArray (ByteArray, ByteArrayAccess)
-import Data.Morpheus.App.Internal.Resolving (Resolver, LiftOperation)
+import Data.Char (isSpace)
 import Data.Morpheus.Server.Types (SCALAR)
-import Data.Morpheus.Types (GQLType, DecodeScalar(..), KIND, EncodeScalar(..),
-    ScalarValue(..), MonadError, GQLError)
+import Data.Morpheus.Types (GQLType, DecodeScalar(..), KIND, EncodeScalar(..), ScalarValue(..))
 import Data.Morpheus.Types.GQLScalar (scalarToJSON, scalarFromJSON)
-import Data.Time (UTCTime, getCurrentTime, NominalDiffTime, addUTCTime, Day)
+import Data.Time (UTCTime, NominalDiffTime, addUTCTime, Day)
 import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
 import Database.Persist.Class (PersistField(..))
 import Database.Persist.PersistValue (PersistValue(..))
-import Database.Persist.Sql (PersistFieldSql(..), SqlBackend)
-import Network.Mail.Mime (Mail, Address(..))
+import Database.Persist.Sql (PersistFieldSql(..))
 import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress)
-import qualified Data.ByteString.Base64 as B64 (encode, decode)
-import "cryptonite" Crypto.Random (MonadRandom(..))
+
+import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64, decodeBase64)
+import qualified Data.Text as T
 
 base64Encode :: ByteString -> Base64
-base64Encode = Base64 . decodeUtf8 . B64.encode
+base64Encode = Base64 . B64.encodeBase64
 
 base64Decode :: Base64 -> Maybe ByteString
-base64Decode (Base64 x) = either (const Nothing) Just $ B64.decode $ encodeUtf8 x
+base64Decode (Base64 x) = either (const Nothing) Just $ B64.decodeBase64 $ encodeUtf8 x
 
 toEmail :: Text -> Maybe Email
 toEmail = fmap Email . emailAddress . encodeUtf8
@@ -59,14 +51,6 @@ renderDate (Date x) = toText $ iso8601Show x
 addTime :: NominalDiffTime -> Time -> Time
 addTime diff (Time time) = Time $ addUTCTime diff time
 
-forward :: Monad m => [a] -> m [Maybe a]
-forward = pure . map Just
-
-requirePermission :: (MonadPermissions m, MonadError GQLError m) => Scope -> Permission -> m ()
-requirePermission scope permission = unlessM (hasPermission scope permission) $
-    throwError $ "Insufficient permissions, " <> show permission <> " for "
-        <> show scope <> " required."
-
 data Scope = OwnProfile
            | OwnTokens
            | Profile UserID
@@ -80,18 +64,40 @@ data Permission = None
                 | ReadWrite
                 deriving (Show, Eq, Ord, Read)
 
-data MemberData = MemberData
-    { name :: Text
-    , nickname :: Maybe Text
-    , birthdate :: Date
-    , homeplace :: Text
-    , application :: Text
-    } deriving (Show, Eq, Generic)
+readPermission :: Text -> Maybe (Map Scope Permission)
+readPermission = rightToMaybe . readEither . toString 
 
-instance FromJSON MemberData
-instance ToJSON MemberData
+newtype PhoneNumber = PhoneNumber Text deriving (Show, Generic)
 
-newtype UserID = UserID Int64 deriving (Eq, Show, Generic, Ord, Read)
+renderPhoneNumber :: PhoneNumber -> Text
+renderPhoneNumber (PhoneNumber txt) = txt
+
+toPhoneNumber :: Text -> Maybe PhoneNumber
+toPhoneNumber txt = do
+    guard $ not $ T.null txt
+    guard $ T.all (`elem` ("+ 0123456789" :: [Char])) txt
+    pure $ PhoneNumber txt
+
+instance Eq PhoneNumber where
+    a == b = normalize a == normalize b
+        where normalize (PhoneNumber txt) = case T.uncons txt of
+                                            Just ('0', rest) -> "+358" <> T.filter (not . isSpace) rest
+                                            Just x -> T.filter (not . isSpace) (uncurry T.cons x)
+                                            Nothing -> error "PhoneNumber must not be empty"
+
+instance DecodeScalar PhoneNumber where
+    decodeScalar (String s) =
+        maybe (Left $ "Couldn't parse \"" <> s <> "\" as a PhoneNumber") Right $ toPhoneNumber s
+    decodeScalar _ = Left "Invalid type for PhoneNumber, should be string"
+
+instance EncodeScalar PhoneNumber where
+    encodeScalar = String . renderPhoneNumber
+
+instance GQLType PhoneNumber where type KIND PhoneNumber = SCALAR
+instance ToJSON PhoneNumber where toJSON = scalarToJSON
+instance FromJSON PhoneNumber where parseJSON = scalarFromJSON <=< parseJSON
+
+newtype UserID = UserID Integer deriving (Eq, Show, Generic, Ord, Read)
 
 instance DecodeScalar UserID where
     decodeScalar (String s) = first (const $ "invalid UserID: \"" <> s <> "\"") $
@@ -105,7 +111,7 @@ instance GQLType UserID where type KIND UserID = SCALAR
 instance ToJSON UserID where toJSON = scalarToJSON
 instance FromJSON UserID where parseJSON = scalarFromJSON <=< parseJSON
 
-newtype KeyID = KeyID Int64 deriving (Eq, Show, Generic)
+newtype KeyID = KeyID Integer deriving (Eq, Show, Generic)
 
 instance DecodeScalar KeyID where
     decodeScalar (String s) = first (const $ "invalid KeyID: \"" <> s <> "\"") $
@@ -119,7 +125,7 @@ instance GQLType KeyID where type KIND KeyID = SCALAR
 instance ToJSON KeyID where toJSON = scalarToJSON
 instance FromJSON KeyID where parseJSON = scalarFromJSON <=< parseJSON
 
-newtype TokenID = TokenID Int64 deriving (Eq, Show, Generic)
+newtype TokenID = TokenID Integer deriving (Eq, Show, Generic)
 
 instance DecodeScalar TokenID where
     decodeScalar (String s) = first (const $ "invalid TokenID: \"" <> s <> "\"") $
@@ -187,58 +193,7 @@ instance GQLType Date where type KIND Date = SCALAR
 instance ToJSON Date where toJSON = scalarToJSON
 instance FromJSON Date where parseJSON = scalarFromJSON <=< parseJSON
 
-newtype PasswordHash = PasswordHash ByteString
-    deriving (Eq, Show, Ord, Semigroup, Monoid, ByteArrayAccess, ByteArray,
-        PersistField, PersistFieldSql)
-
-class Monad m => MonadTime m where
-    currentTime :: m Time
-
-instance MonadTime IO where
-    currentTime = Time <$> getCurrentTime
-
-class Monad m => MonadDB m where
-    runQuery :: ReaderT SqlBackend (LoggingT IO) a -> m a
-    -- TODO refactor so that it is possible to define a IO-less db, for safety and testability.
-    --      Is there a way to do this that doesn't require moving all db calls to the class?
-    --      Probably not :(
-
-class Monad m => MonadEmail m where
-    sendEmail :: Mail -> m ()
-    fromAddress :: m Address
-
-class Monad m => MonadRequest m where
-    currentUser :: m (Maybe UserID)
-
-class Monad m => MonadPermissions m where
-    hasPermission :: Scope -> Permission -> m Bool
-    currentPermissions :: m Text
-    defaultPermissions :: m Text
-    toPermissions :: Text -> m (Maybe Text)
-
-instance (MonadDB m, LiftOperation o) => MonadDB (Resolver o () m) where
-    runQuery = lift . runQuery
-
-instance (MonadRequest m, LiftOperation o) => MonadRequest (Resolver o () m) where
-    currentUser = lift currentUser
-
-instance (MonadPermissions m, LiftOperation o) => MonadPermissions (Resolver o () m) where
-    hasPermission scope permission = lift $ hasPermission scope permission
-    defaultPermissions = lift defaultPermissions
-    currentPermissions = lift currentPermissions
-    toPermissions = lift . toPermissions
-
-instance (MonadEmail m, LiftOperation o) => MonadEmail (Resolver o () m) where
-    sendEmail = lift . sendEmail
-    fromAddress = lift fromAddress
-
-instance (MonadRandom m, LiftOperation o) => MonadRandom (Resolver o () m) where
-    getRandomBytes = lift . getRandomBytes
-
-instance (MonadTime m, LiftOperation o) => MonadTime (Resolver o () m) where
-    currentTime = lift currentTime
-
-data Unit = Unit | Unit2 deriving (Eq, Generic, Show)
+data Unit = Unit | Unit2 deriving (Eq, Generic, Show) -- XXX: why not just Unit
 
 instance GQLType Unit
 instance ToJSON Unit

datarekisteri.cabal

@@ -1,14 +0,0 @@
-cabal-version: 2.4
-name: datarekisteri
-version: 0.0.1
-author: Saku Laesvuori
-license: AGPL-3.0-or-later
-license-file: COPYING.md
-build-type: Simple
-stability: alpha
-
-executable datarekisteri
-  build-depends: aeson, base, base64-bytestring, cryptonite, email-validate, esqueleto, memory, mime-mail, monad-logger, morpheus-graphql, morpheus-graphql-app, morpheus-graphql-client, morpheus-graphql-core, morpheus-graphql-server, mtl, persistent, persistent-postgresql, relude, scotty, smtp-mail, text, time, yesod, yesod-auth
-  main-is: Client.hs
-  hs-source-dirs: .
-  default-language: Haskell2010

frontend/COPYING.md

@@ -0,0 +1,660 @@
+### GNU AFFERO GENERAL PUBLIC LICENSE
+
+Version 3, 19 November 2007
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+<https://fsf.org/>
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+### Preamble
+
+The GNU Affero General Public License is a free, copyleft license for
+software and other kinds of works, specifically designed to ensure
+cooperation with the community in the case of network server software.
+
+The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+our General Public Licenses are intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains
+free software for all its users.
+
+When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+Developers that use our General Public Licenses protect your rights
+with two steps: (1) assert copyright on the software, and (2) offer
+you this License which gives you legal permission to copy, distribute
+and/or modify the software.
+
+A secondary benefit of defending all users' freedom is that
+improvements made in alternate versions of the program, if they
+receive widespread use, become available for other developers to
+incorporate. Many developers of free software are heartened and
+encouraged by the resulting cooperation. However, in the case of
+software used on network servers, this result may fail to come about.
+The GNU General Public License permits making a modified version and
+letting the public access it on a server without ever releasing its
+source code to the public.
+
+The GNU Affero General Public License is designed specifically to
+ensure that, in such cases, the modified source code becomes available
+to the community. It requires the operator of a network server to
+provide the source code of the modified version running there to the
+users of that server. Therefore, public use of a modified version, on
+a publicly accessible server, gives the public access to the source
+code of the modified version.
+
+An older license, called the Affero General Public License and
+published by Affero, was designed to accomplish similar goals. This is
+a different license, not a version of the Affero GPL, but Affero has
+released a new version of the Affero GPL which permits relicensing
+under this license.
+
+The precise terms and conditions for copying, distribution and
+modification follow.
+
+### TERMS AND CONDITIONS
+
+#### 0. Definitions.
+
+"This License" refers to version 3 of the GNU Affero General Public
+License.
+
+"Copyright" also means copyright-like laws that apply to other kinds
+of works, such as semiconductor masks.
+
+"The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of
+an exact copy. The resulting work is called a "modified version" of
+the earlier work or a work "based on" the earlier work.
+
+A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user
+through a computer network, with no transfer of a copy, is not
+conveying.
+
+An interactive user interface displays "Appropriate Legal Notices" to
+the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+#### 1. Source Code.
+
+The "source code" for a work means the preferred form of the work for
+making modifications to it. "Object code" means any non-source form of
+a work.
+
+A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+The Corresponding Source need not include anything that users can
+regenerate automatically from other parts of the Corresponding Source.
+
+The Corresponding Source for a work in source code form is that same
+work.
+
+#### 2. Basic Permissions.
+
+All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+You may make, run and propagate covered works that you do not convey,
+without conditions so long as your license otherwise remains in force.
+You may convey covered works to others for the sole purpose of having
+them make modifications exclusively for you, or provide you with
+facilities for running those works, provided that you comply with the
+terms of this License in conveying all material for which you do not
+control copyright. Those thus making or running the covered works for
+you must do so exclusively on your behalf, under your direction and
+control, on terms that prohibit them from making any copies of your
+copyrighted material outside their relationship with you.
+
+Conveying under any other circumstances is permitted solely under the
+conditions stated below. Sublicensing is not allowed; section 10 makes
+it unnecessary.
+
+#### 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such
+circumvention is effected by exercising rights under this License with
+respect to the covered work, and you disclaim any intention to limit
+operation or modification of the work as a means of enforcing, against
+the work's users, your or third parties' legal rights to forbid
+circumvention of technological measures.
+
+#### 4. Conveying Verbatim Copies.
+
+You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+#### 5. Conveying Modified Source Versions.
+
+You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these
+conditions:
+
+-   a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+-   b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under
+    section 7. This requirement modifies the requirement in section 4
+    to "keep intact all notices".
+-   c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy. This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged. This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+-   d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+#### 6. Conveying Non-Source Forms.
+
+You may convey a covered work in object code form under the terms of
+sections 4 and 5, provided that you also convey the machine-readable
+Corresponding Source under the terms of this License, in one of these
+ways:
+
+-   a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+-   b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the Corresponding
+    Source from a network server at no charge.
+-   c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source. This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+-   d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge. You need not require recipients to copy the
+    Corresponding Source along with the object code. If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source. Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+-   e) Convey the object code using peer-to-peer transmission,
+    provided you inform other peers where the object code and
+    Corresponding Source of the work are being offered to the general
+    public at no charge under subsection 6d.
+
+A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal,
+family, or household purposes, or (2) anything designed or sold for
+incorporation into a dwelling. In determining whether a product is a
+consumer product, doubtful cases shall be resolved in favor of
+coverage. For a particular product received by a particular user,
+"normally used" refers to a typical or common use of that class of
+product, regardless of the status of the particular user or of the way
+in which the particular user actually uses, or expects or is expected
+to use, the product. A product is a consumer product regardless of
+whether the product has substantial commercial, industrial or
+non-consumer uses, unless such uses represent the only significant
+mode of use of the product.
+
+"Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to
+install and execute modified versions of a covered work in that User
+Product from a modified version of its Corresponding Source. The
+information must suffice to ensure that the continued functioning of
+the modified object code is in no case prevented or interfered with
+solely because modification has been made.
+
+If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or
+updates for a work that has been modified or installed by the
+recipient, or for the User Product in which it has been modified or
+installed. Access to a network may be denied when the modification
+itself materially and adversely affects the operation of the network
+or violates the rules and protocols for communication across the
+network.
+
+Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+#### 7. Additional Terms.
+
+"Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders
+of that material) supplement the terms of this License with terms:
+
+-   a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+-   b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+-   c) Prohibiting misrepresentation of the origin of that material,
+    or requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+-   d) Limiting the use for publicity purposes of names of licensors
+    or authors of the material; or
+-   e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+-   f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions
+    of it) with contractual assumptions of liability to the recipient,
+    for any liability that these contractual assumptions directly
+    impose on those licensors and authors.
+
+All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions; the
+above requirements apply either way.
+
+#### 8. Termination.
+
+You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+However, if you cease all violation of this License, then your license
+from a particular copyright holder is reinstated (a) provisionally,
+unless and until the copyright holder explicitly and finally
+terminates your license, and (b) permanently, if the copyright holder
+fails to notify you of the violation by some reasonable means prior to
+60 days after the cessation.
+
+Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+#### 9. Acceptance Not Required for Having Copies.
+
+You are not required to accept this License in order to receive or run
+a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+#### 10. Automatic Licensing of Downstream Recipients.
+
+Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+#### 11. Patents.
+
+A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+A contributor's "essential patent claims" are all patent claims owned
+or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+A patent license is "discriminatory" if it does not include within the
+scope of its coverage, prohibits the exercise of, or is conditioned on
+the non-exercise of one or more of the rights that are specifically
+granted under this License. You may not convey a covered work if you
+are a party to an arrangement with a third party that is in the
+business of distributing software, under which you make payment to the
+third party based on the extent of your activity of conveying the
+work, and under which the third party grants, to any of the parties
+who would receive the covered work from you, a discriminatory patent
+license (a) in connection with copies of the covered work conveyed by
+you (or copies made from those copies), or (b) primarily for and in
+connection with specific products or compilations that contain the
+covered work, unless you entered into that arrangement, or that patent
+license was granted, prior to 28 March 2007.
+
+Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+#### 12. No Surrender of Others' Freedom.
+
+If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under
+this License and any other pertinent obligations, then as a
+consequence you may not convey it at all. For example, if you agree to
+terms that obligate you to collect a royalty for further conveying
+from those to whom you convey the Program, the only way you could
+satisfy both those terms and this License would be to refrain entirely
+from conveying the Program.
+
+#### 13. Remote Network Interaction; Use with the GNU General Public License.
+
+Notwithstanding any other provision of this License, if you modify the
+Program, your modified version must prominently offer all users
+interacting with it remotely through a computer network (if your
+version supports such interaction) an opportunity to receive the
+Corresponding Source of your version by providing access to the
+Corresponding Source from a network server at no charge, through some
+standard or customary means of facilitating copying of software. This
+Corresponding Source shall include the Corresponding Source for any
+work covered by version 3 of the GNU General Public License that is
+incorporated pursuant to the following paragraph.
+
+Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the work with which it is combined will remain governed by version
+3 of the GNU General Public License.
+
+#### 14. Revised Versions of this License.
+
+The Free Software Foundation may publish revised and/or new versions
+of the GNU Affero General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies that a certain numbered version of the GNU Affero General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU Affero General Public License, you may choose any version ever
+published by the Free Software Foundation.
+
+If the Program specifies that a proxy can decide which future versions
+of the GNU Affero General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+#### 15. Disclaimer of Warranty.
+
+THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT
+WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
+PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE
+DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
+CORRECTION.
+
+#### 16. Limitation of Liability.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR
+CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT
+NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR
+LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM
+TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER
+PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+#### 17. Interpretation of Sections 15 and 16.
+
+If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+END OF TERMS AND CONDITIONS
+
+### How to Apply These Terms to Your New Programs
+
+If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively state
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+        <one line to give the program's name and a brief idea of what it does.>
+        Copyright (C) <year>  <name of author>
+
+        This program is free software: you can redistribute it and/or modify
+        it under the terms of the GNU Affero General Public License as
+        published by the Free Software Foundation, either version 3 of the
+        License, or (at your option) any later version.
+
+        This program is distributed in the hope that it will be useful,
+        but WITHOUT ANY WARRANTY; without even the implied warranty of
+        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+        GNU Affero General Public License for more details.
+
+        You should have received a copy of the GNU Affero General Public License
+        along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper
+mail.
+
+If your software can interact with users remotely through a computer
+network, you should also make sure that it provides a way for users to
+get its source. For example, if your program is a web application, its
+interface could display a "Source" link that leads users to an archive
+of the code. There are many ways you could offer source, and different
+solutions will be better for different programs; see section 13 for
+the specific requirements.
+
+You should also get your employer (if you work as a programmer) or
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. For more information on this, and how to apply and follow
+the GNU AGPL, see <https://www.gnu.org/licenses/>.

frontend/Setup.hs

@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain

frontend/datarekisteri-frontend.cabal

@@ -0,0 +1,51 @@
+cabal-version: 3.6
+name: datarekisteri-frontend
+version: 0.0.1
+author: Saku Laesvuori
+license: AGPL-3.0-or-later
+license-file: COPYING.md
+build-type: Simple
+stability: alpha
+
+executable datarekisteri-frontend
+  build-depends:
+    aeson,
+    base,
+    base64,
+    datarekisteri-core,
+    email-validate,
+    memory,
+    monad-logger,
+    morpheus-graphql,
+    morpheus-graphql-app,
+    morpheus-graphql-client,
+    morpheus-graphql-core,
+    mtl,
+    optparse-applicative,
+    process,
+    relude,
+    text,
+    time,
+    yesod,
+    yesod-auth,
+    containers,
+    wai,
+    warp,
+    wai-extra,
+    yesod-core,
+    yesod-static,
+    directory
+  main-is: Frontend.hs
+  other-modules:
+    Datarekisteri.Frontend.ApiRequests,
+    Datarekisteri.Frontend.Auth,
+    Datarekisteri.Frontend.FormFields,
+    Datarekisteri.Frontend.Handlers,
+    Datarekisteri.Frontend.Handlers.Applications,
+    Datarekisteri.Frontend.Handlers.Apply,
+    Datarekisteri.Frontend.Handlers.Profile,
+    Datarekisteri.Frontend.Handlers.VerifyEmail,
+    Datarekisteri.Frontend.Handlers.Members,
+    Datarekisteri.Frontend.Types
+  hs-source-dirs: src
+  default-language: Haskell2010

frontend/schema.gql

@@ -6,6 +6,8 @@ scalar Email
 
 scalar KeyID
 
+scalar PhoneNumber
+
 scalar Time
 
 scalar TokenID
@@ -43,6 +45,7 @@ type User {
   pendingEmail: Email
   name: String!
   nickname: String!
+  phoneNumber: PhoneNumber!
   birthdate: Date!
   homeplace: String!
   registered: Time!
@@ -64,10 +67,10 @@ type Query {
 }
 
 type Mutation {
-  apply(email: Email!, password: String!, name: String!, nickname: String, birthdate: Date!, homeplace: String!, application: String!): User!
+  apply(email: Email!, phoneNumber: PhoneNumber!, password: String!, name: String!, nickname: String, birthdate: Date!, homeplace: String!, application: String!): User!
   verifyEmail(secret: String!): Unit!
   resendVerificationEmail(user: UserID): Unit!
-  update(email: Email, password: String, name: String, nickname: String, homeplace: String, user: UserID): User!
+  update(email: Email, phoneNumber: PhoneNumber, password: String, name: String, nickname: String, homeplace: String, user: UserID): User!
   newToken(comment: String, name: String, permissions: String): Token!
   newKey(comment: String, keyData: Base64!, expires: Time): PGPKey!
   accept(user: UserID!): Unit!

frontend/src/Datarekisteri/Frontend/ApiRequests.hs

@@ -9,7 +9,7 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.ApiRequests where
+module Datarekisteri.Frontend.ApiRequests where
 
 import Relude
 

frontend/src/Datarekisteri/Frontend/Auth.hs

@@ -6,18 +6,19 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PackageImports #-}
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.Auth where
+module Datarekisteri.Frontend.Auth where
 
 import Relude
 
-import Server.Types
+import Datarekisteri.Core.Types
 import Data.Morpheus.Client
 import Yesod
 import Yesod.Auth
-import qualified Data.ByteString.Base64 as B64 (encode)
+import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64)
 import qualified Yesod.Auth.Message as Msg
 
 pluginName = "externalBasic"
@@ -34,7 +35,7 @@ postLoginR authReq = do
         <$> ireq textField "email" <*> ireq textField "password"
     case res of
       FormSuccess auth -> do
-          maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ decodeUtf8 $ B64.encode $ encodeUtf8 auth
+          maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ B64.encodeBase64 $ encodeUtf8 auth
           case maybeAuth of
             Nothing -> loginErrorMessageI LoginR Msg.NoIdentifierProvided -- invalid creds
             Just txt -> do

frontend/src/Datarekisteri/Frontend/FormFields.hs

@@ -3,13 +3,13 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.FormFields where
+module Datarekisteri.Frontend.FormFields where
 
 import Relude
 
 import Yesod
-import Client.Types
-import Server.Types
+import Datarekisteri.Frontend.Types
+import Datarekisteri.Core.Types
 
 emailField :: Field Handler Email
 emailField = Field
@@ -21,7 +21,22 @@ emailField = Field
     , fieldView = \id name otherAttributes result isRequired ->
         let result' = either (\x -> x) renderEmail result
         in [whamlet|
-               <input type="email" id="#{id}" name="#{name}" value="#{result'}" *{otherAttributes} :isRequired:required="">
+               <input type="email" id="#{id}" name="#{name}" value="#{result'}" *{otherAttributes} :isRequired:required="true">
+           |]
+    , fieldEnctype = UrlEncoded
+    }
+
+telephoneField :: Field Handler PhoneNumber
+telephoneField = Field
+    { fieldParse = \rawValues _ ->
+        case rawValues of
+          [] -> pure $ Right Nothing
+          [x] -> pure $ maybe (Left "could not parse as a phone number") (Right . Just) $ toPhoneNumber x
+          _ -> pure $ Left $ "Expected one value"
+    , fieldView = \id name otherAttributes result isRequired ->
+        let result' = either (\x -> x) renderPhoneNumber result
+        in [whamlet|
+               <input type="tel" id="#{id}" name="#{name}" value="#{result'}" *{otherAttributes} :isRequired:required="true">
            |]
     , fieldEnctype = UrlEncoded
     }

frontend/src/Datarekisteri/Frontend/Handlers.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Datarekisteri.Frontend.Handlers
+    ( module Datarekisteri.Frontend.Handlers.Profile
+    , module Datarekisteri.Frontend.Handlers.Apply
+    , module Datarekisteri.Frontend.Handlers.Applications
+    , module Datarekisteri.Frontend.Handlers.VerifyEmail
+    , module Datarekisteri.Frontend.Handlers.Members
+    , getHomeR
+    ) where
+
+import Relude
+
+import Datarekisteri.Frontend.Handlers.Profile
+import Datarekisteri.Frontend.Handlers.Apply
+import Datarekisteri.Frontend.Handlers.Applications
+import Datarekisteri.Frontend.Handlers.VerifyEmail
+import Datarekisteri.Frontend.Handlers.Members
+import Datarekisteri.Frontend.Types
+import Yesod
+import Yesod.Auth
+
+getHomeR :: Handler Html
+getHomeR = ifM (isJust <$> maybeAuthId) (redirect OwnProfileR) (redirect $ AuthR LoginR)

frontend/src/Datarekisteri/Frontend/Handlers/Applications.hs

@@ -10,17 +10,17 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.Handlers.Applications where
+module Datarekisteri.Frontend.Handlers.Applications where
 
 import Relude hiding (id)
 
-import Client.ApiRequests
-import Client.Types
+import Datarekisteri.Frontend.ApiRequests
+import Datarekisteri.Frontend.Types
 import Data.Morpheus.Client
-import Server.Types hiding (Applications)
+import Datarekisteri.Core.Types hiding (Applications)
 import Yesod hiding (emailField)
 import Yesod.Auth
-import Client.FormFields
+import Datarekisteri.Frontend.FormFields
 import Data.Time (Day)
 import Data.Maybe (fromJust)
 
@@ -31,6 +31,7 @@ query Applications {
     name
     nickname
     email
+    phoneNumber
     homeplace
     birthdate
     application
@@ -85,6 +86,9 @@ applicationsW applications = do
             <tr>
                 <th scope="row">Sähköposti
                 <td>#{renderEmail $ fromJust $ email}
+            <tr>
+                <th scope="row">Puhelinnumero
+                <td>#{renderPhoneNumber $ phoneNumber}
     $maybe route <- acceptRoute
         <form action="@{route}" method="post" enctype="#{enctype}">
             ^{widget}

frontend/src/Datarekisteri/Frontend/Handlers/Apply.hs

@@ -10,31 +10,25 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.Handlers.Apply where
+module Datarekisteri.Frontend.Handlers.Apply where
 
 import Relude hiding (id)
 
-import Client.ApiRequests
-import Client.Types
+import Datarekisteri.Frontend.ApiRequests
+import Datarekisteri.Frontend.Types
 import Data.Morpheus.Client
-import Server.Types
+import Datarekisteri.Core.Types
 import Yesod hiding (emailField)
 import Yesod.Auth
-import Client.FormFields
+import Datarekisteri.Frontend.FormFields
 import Data.Time (Day)
 
 declareLocalTypesInline "schema.gql" [raw|
 mutation Apply($name: String!, $nickname: String, $homeplace: String!,
-    $birthdate: Date!, $email: Email!, $password: String!, $application: String!) {
+    $birthdate: Date!, $email: Email!, $phoneNumber: PhoneNumber!, $password: String!, $application: String!) {
   apply(email: $email, password: $password, name: $name, nickname: $nickname,
-      birthdate: $birthdate, homeplace: $homeplace, application: $application) {
+      birthdate: $birthdate, homeplace: $homeplace, application: $application, phoneNumber: $phoneNumber) {
     id
-    name
-    nickname
-    email
-    pendingEmail
-    homeplace
-    birthdate
   }
 }
 |]
@@ -46,6 +40,7 @@ applyForm = renderDivs $ ApplyArgs
     <*> areq textField homeplaceSettings Nothing
     <*> areq dayField' birthdateSettings Nothing
     <*> areq emailField emailSettings Nothing
+    <*> areq telephoneField phoneSettings Nothing
     <*> areq verifiedPasswordField "Salasana" Nothing
     <*> areq textareaField' applicationSettings Nothing
         where dayField' :: Field Handler Date
@@ -58,6 +53,7 @@ applyForm = renderDivs $ ApplyArgs
               homeplaceSettings = "Kotipaikka" {fsAttrs = [("placeholder","Espoo")]}
               birthdateSettings = "Syntymäaika" {fsAttrs = [("placeholder","2000-01-01")]}
               emailSettings = "Sähköposti" {fsAttrs = [("placeholder","erkki.juhani@esimerkki.fi")]}
+              phoneSettings = "Puhelinnumero" {fsAttrs = [("placeholder","+358 12 34567890")]}
               applicationSettings = "Hakemus (eli miksi olet data)"
                   {fsAttrs = [("placeholder","Aloitin opiskelun Otaniemen datalla vuonna 2020.")]}
 
@@ -84,6 +80,7 @@ postApplyR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Ht
 postApplyR = do
     ((result, widget), enctype) <- runFormPost applyForm
     case result of
-      FormSuccess application -> apiRequest @Apply False application >>= \x -> redirect $ ProfileR $ id (apply x :: ApplyApply)
+      FormSuccess application -> apiRequest @Apply False application >>= \x ->
+          redirect $ ProfileR $ let ApplyApply {..} = apply x in id
       _ -> do
           defaultLayout $ applyW (widget, enctype)

frontend/src/Datarekisteri/Frontend/Handlers/Members.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Datarekisteri.Frontend.Handlers.Members where
+
+import Relude hiding (id)
+
+import Data.Morpheus.Client
+import Datarekisteri.Frontend.Types
+import Datarekisteri.Frontend.ApiRequests
+import Datarekisteri.Core.Types
+import Yesod
+import Yesod.Auth
+
+declareLocalTypesInline "schema.gql" [raw|
+query MembersPage {
+  users {
+    id
+    name
+    nickname
+    homeplace
+  }
+}
+|]
+
+getMembersR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
+getMembersR = do
+    MembersPage {..} <- apiRequest True ()
+    defaultLayout $ do
+        setTitle "Jäsenet"
+        let memberNickname member = let MembersPageUsers {..} = member in nickname
+            memberName member = let MembersPageUsers {..} = member in name
+            memberHomeplace member = let MembersPageUsers {..} = member in homeplace
+            memberId member = let MembersPageUsers {..} = member in id
+        [whamlet|
+        <h1>
+          Jäsenet
+        $if null users
+          <p>
+            Ei jäseniä.
+        $else
+          <table>
+            <thead>
+              <tr>
+                <th scope="col">
+                  Nimi
+                <th scope="col">
+                  Kutsumanimi
+                <th scope="col">
+                  Kotipaikka
+            <tbody>
+            $forall member <- users
+              <tr>
+                <td>
+                  #{memberName member}
+                <td>
+                  #{memberNickname member}
+                <td>
+                  #{memberHomeplace member}
+|]

frontend/src/Datarekisteri/Frontend/Handlers/Profile.hs

@@ -10,15 +10,15 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.Handlers.Profile where
+module Datarekisteri.Frontend.Handlers.Profile where
 
 import Relude hiding (id)
 
-import Client.ApiRequests
-import Client.Types
-import Client.FormFields
+import Datarekisteri.Frontend.ApiRequests
+import Datarekisteri.Frontend.Types
+import Datarekisteri.Frontend.FormFields
 import Data.Morpheus.Client
-import Server.Types
+import Datarekisteri.Core.Types
 import Yesod hiding (emailField)
 import Yesod.Auth
 
@@ -32,14 +32,15 @@ query ProfilePage($id: UserID) {
     pendingEmail
     homeplace
     birthdate
+    phoneNumber
   }
   permissions
 }
 |]
 
 declareLocalTypesInline "schema.gql" [raw|
-mutation UpdateProfile($user: UserID, $name: String, $homeplace: String, $nickname: String, $email: Email) {
-  update(user: $user, name: $name, homeplace: $homeplace, nickname: $nickname, email: $email) {
+mutation UpdateProfile($user: UserID, $name: String, $homeplace: String, $nickname: String, $email: Email, $phoneNumber: PhoneNumber) {
+  update(user: $user, name: $name, homeplace: $homeplace, nickname: $nickname, email: $email, phoneNumber: $phoneNumber) {
     id
   }
 }
@@ -58,12 +59,19 @@ passwordForm = renderDivs $ areq verifiedPasswordField "Uusi salasana" Nothing
 
 profileForm :: (Maybe UserID) -> (Maybe ProfilePageUser) -> Form UpdateProfileArgs
 profileForm userID user extraHtml = do
-    (nameRes, nameView) <- mopt textField "Nimi" (Just $ maybe Nothing (\x -> Just $ name (x ::ProfilePageUser)) user)
-    (homeRes, homeView) <- mopt textField "Kotipaikka" (Just $ maybe Nothing (\x -> Just $ homeplace (x :: ProfilePageUser)) user)
-    (nicknameRes, nicknameView) <- mopt textField "Kutsumanimi" (Just $ maybe Nothing (\x -> Just $ nickname (x :: ProfilePageUser)) user)
-    (emailRes, emailView) <- mopt emailField "Sähköposti" (maybe Nothing (\x -> Just $ email (x :: ProfilePageUser)) user)
-    let profileUpdateRes = UpdateProfileArgs userID <$> nameRes <*> homeRes <*> nicknameRes <*> emailRes
-        maybePendingEmail = user >>= \x -> pendingEmail (x :: ProfilePageUser)
+    (nameRes, nameView) <- mopt textField "Nimi"
+        (Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in name) user)
+    (homeRes, homeView) <- mopt textField "Kotipaikka"
+        (Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in homeplace) user)
+    (nicknameRes, nicknameView) <- mopt textField "Kutsumanimi"
+        (Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in nickname) user)
+    (emailRes, emailView) <- mopt emailField "Sähköposti"
+        (maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in email) user)
+    (phoneNumberRes, phoneNumberView) <- mopt telephoneField "Puhelinnumero"
+        (Just $ maybe Nothing (\x -> Just $ let ProfilePageUser {..} = x in phoneNumber) user)
+    let profileUpdateRes = UpdateProfileArgs userID <$>
+            nameRes <*> homeRes <*> nicknameRes <*> emailRes <*> phoneNumberRes
+        maybePendingEmail = user >>= \x -> let ProfilePageUser {..} = x in pendingEmail
         inputField FieldView {..} = [whamlet|
             <label for="#{fvId}">
                 ^{fvLabel}
@@ -74,6 +82,7 @@ profileForm userID user extraHtml = do
             ^{inputField nameView}
             ^{inputField homeView}
             ^{inputField nicknameView}
+            ^{inputField phoneNumberView}
             ^{inputField emailView}
             $maybe pendingEmail <- maybePendingEmail
                 <p>Päivitys osoitteeseen #
@@ -104,8 +113,9 @@ getProfile userID = do
     ProfilePage {..} <- apiRequest True (ProfilePageArgs {id = userID})
     passwordForm <- liftHandler $ generateFormPost passwordForm
     profileForm <- liftHandler $ generateFormPost $
-        profileForm ((\x -> id (x :: ProfilePageUser)) <$> user) user
-    defaultLayout $ profile ((\x -> id (x :: ProfilePageUser)) $ fromJust user) profileForm passwordForm
+        profileForm ((\x -> let ProfilePageUser {..} = x in id) <$> user) user
+    defaultLayout $ profile ((\x -> let ProfilePageUser {..} = x in id) $ fromJust user)
+        profileForm passwordForm
         where fromJust = fromMaybe $ error "Tried to access the profile of an inexistent user"
 
 getOwnProfileR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html

frontend/src/Datarekisteri/Frontend/Handlers/VerifyEmail.hs

@@ -9,13 +9,13 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.Handlers.VerifyEmail where
+module Datarekisteri.Frontend.Handlers.VerifyEmail where
 
 import Relude
 
-import Client.ApiRequests
-import Client.Types
-import Server.Types
+import Datarekisteri.Frontend.ApiRequests
+import Datarekisteri.Frontend.Types
+import Datarekisteri.Core.Types
 import Data.Morpheus.Client
 import Yesod
 import Yesod.Auth

frontend/src/Datarekisteri/Frontend/Types.hs

@@ -13,7 +13,7 @@
 
 {-# LANGUAGE NoImplicitPrelude #-}
 
-module Client.Types where
+module Datarekisteri.Frontend.Types where
 
 import Relude hiding (id)
 import Relude.Extra.Foldable1 (maximum1)
@@ -23,16 +23,28 @@ import Yesod.Core.Handler (getCurrentRoute)
 import Yesod.Default.Util (addStaticContentExternal)
 import Yesod.Auth
 import Yesod.Static
-import Server.Types (UserID(..), Scope(..), Permission(..))
+import Datarekisteri.Core.Types (UserID(..), Scope(..), Permission(..), readPermission)
 import Data.Time (getCurrentTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
-import Client.Auth
-import Client.ApiRequests
+import Datarekisteri.Frontend.Auth
+import Datarekisteri.Frontend.ApiRequests
 import Data.Morpheus.Client
-import Server (readPermission)
 import Data.Map (findWithDefault)
 
-data DataIdClient = DataIdClient { getStatic :: Static }
+data DataIdClient = DataIdClient
+    { getStatic :: Static
+    , getConfig :: Config
+    }
+
+data Config = Config
+    { configPort :: Int
+    , configApproot :: Text
+    , configServerUrl :: Text
+    }
+
+instance PathPiece UserID where
+    toPathPiece (UserID id) = show id
+    fromPathPiece s = UserID <$> readMaybe (toString s)
 
 mkYesodData "DataIdClient" [parseRoutes|
 / HomeR GET
@@ -42,13 +54,14 @@ mkYesodData "DataIdClient" [parseRoutes|
 /update-password/#UserID UpdatePasswordR POST
 /verify-email VerifyEmailR GET POST
 
+/members MembersR GET
+
 /applications ApplicationsR GET
 /accept AcceptR POST
 /reject RejectR POST
 
 /apply ApplyR GET POST
 
-/api ApiR POST
 /auth AuthR Auth getAuth
 /static StaticR Static getStatic
 |]
@@ -62,6 +75,26 @@ query GetPermissions {
 }
 |]
 
+declareLocalTypesInline "schema.gql" [raw|
+mutation GetWebUIToken {
+  newToken(comment: "id.datat.fi webui") {
+    tokenData
+  }
+}
+|]
+
+instance YesodAuth DataIdClient where
+    type AuthId DataIdClient = Text
+    maybeAuthId = lookupSession credsKey
+    loginDest = const HomeR
+    logoutDest = const HomeR
+    authPlugins = const $
+        [ authExternalBasic $
+            fmap (fmap (tokenData . newToken) . rightToMaybe) .
+                flip (apiRequestAuth @GetWebUIToken []) () . Just
+        ]
+    authenticate = pure . Authenticated . credsIdent
+
 withAuthenticated :: (AuthId DataIdClient -> Handler AuthResult) -> Handler AuthResult
 withAuthenticated m = maybeAuthId >>= maybe (pure AuthenticationRequired) m
 
@@ -86,9 +119,9 @@ requirePermission scope permission = ifM (hasPermission scope permission)
               renderPermission ReadOnly = "lukuoikeuden"
               renderPermission None = "nollaoikeuden"
               renderScope OwnProfile = "omaan profiliin"
-              renderScope (Profile user) = "käyttäjän '" <> show user <> "' profiliin"
+              renderScope (Profile _) = "käyttäjän profiliin"
               renderScope OwnTokens = "omiin tokeneihin" -- TODO kunnon suomennos
-              renderScope (Tokens user) = "käyttäjän '" <> show user <> "' tokeneihin" -- TODO kunnon suomennos
+              renderScope (Tokens _) = "käyttäjän tokeneihin" -- TODO kunnon suomennos
               renderScope Members = "kaikkiin jäseniin"
               renderScope Applications = "jäsenhakemuksiin"
 
@@ -98,19 +131,19 @@ authorizedHelper scope False = requirePermission scope ReadOnly
 
 instance Yesod DataIdClient where
     authRoute = const $ Just $ AuthR LoginR
-    approot = ApprootStatic "http://localhost:3000"
+    approot = ApprootMaster $ configApproot . getConfig
     makeSessionBackend = const $ sslOnlySessions $ laxSameSiteSessions $
         Just <$> defaultClientSessionBackend (60*24*7) "client_session_key.aes"
     isAuthorized (AuthR _) _ = pure Authorized
     isAuthorized (StaticR _) _ = pure Authorized
     isAuthorized HomeR _ = pure Authorized
-    isAuthorized ApiR _ = pure Authorized
     isAuthorized ApplyR _ = pure Authorized
     isAuthorized VerifyEmailR _ = pure Authorized
     isAuthorized OwnProfileR isWrite = withAuthenticated $ const $ authorizedHelper OwnProfile isWrite
     isAuthorized (ProfileR user) isWrite = withAuthenticated $ const $ authorizedHelper (Profile user) isWrite
     isAuthorized (UpdatePasswordR user) isWrite =
         withAuthenticated $ const $ authorizedHelper (Profile user) isWrite
+    isAuthorized MembersR isWrite = withAuthenticated $ const $ authorizedHelper Members isWrite
     isAuthorized ApplicationsR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
     isAuthorized AcceptR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
     isAuthorized RejectR isWrite = withAuthenticated $ const $ authorizedHelper Applications isWrite
@@ -133,6 +166,7 @@ instance Yesod DataIdClient where
         msgs <- getMessages
         applicationsRoute <- maybeAuthorized ApplicationsR False
         profileRoute <- maybeAuthorized OwnProfileR False
+        membersRoute <- maybeAuthorized MembersR False
         currentRoute <- getCurrentRoute
         loggedIn <- isJust <$> maybeAuthId
         p <- widgetToPageContent $ do
@@ -143,6 +177,9 @@ instance Yesod DataIdClient where
                       $maybe route <- profileRoute
                         <li :Just route == currentRoute:class="active-nav">
                           <a href="@{route}">Profiili
+                      $maybe route <- membersRoute
+                        <li :Just route == currentRoute:class="active-nav">
+                          <a href="@{route}">Jäsenet
                       $maybe route <- applicationsRoute
                         <li :Just route == currentRoute:class="active-nav">
                           <a href="@{route}">Hakemukset
@@ -171,9 +208,12 @@ instance Yesod DataIdClient where
                   font-family: "Fira Sans", sans-serif;
                   height: 100%;
                 }
-                th {
+                th[scope="row"] {
                   text-align: right;
                 }
+                th[scope="col"] {
+                  text-align: center;
+                }
                 body {
                   background-color: #e8eaef;
                   color: var(--fg-colour);
@@ -296,35 +336,11 @@ instance Yesod DataIdClient where
                 ^{pageBody p}
             |]
 
-declareLocalTypesInline "schema.gql" [raw|
-mutation GetWebUIToken {
-  newToken(comment: "id.datat.fi webui") {
-    tokenData
-  }
-}
-|]
-
-instance YesodAuth DataIdClient where
-    type AuthId DataIdClient = Text
-    maybeAuthId = lookupSession credsKey
-    loginDest = const HomeR
-    logoutDest = const HomeR
-    authPlugins = const $
-        [ authExternalBasic $
-            fmap (fmap (tokenData . newToken) . rightToMaybe) .
-                flip (apiRequestAuth @GetWebUIToken []) () . Just
-        ]
-    authenticate = pure . Authenticated . credsIdent
-
 instance ApiRequest DataIdClient where
-    getApiUrl = ($ ApiR) <$> getUrlRender
+    getApiUrl = configServerUrl . getConfig <$> getYesod
     authIdToAuthorization = flip const
 
 instance RenderMessage DataIdClient FormMessage where
     renderMessage _ _ = defaultFormMessage
 
-instance PathPiece UserID where
-    toPathPiece (UserID id) = show id
-    fromPathPiece s = UserID <$> readMaybe (toString s)
-
 type Form a = Html -> MForm Handler (FormResult a, Widget)

frontend/src/Frontend.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ViewPatterns #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+import Relude hiding (get)
+
+import Yesod
+import Yesod.Auth
+import Datarekisteri.Frontend.Types
+import Datarekisteri.Frontend.Handlers
+import Datarekisteri.Frontend.Auth ()
+import Yesod.Static (static, Static)
+import Options.Applicative
+import System.Directory (createDirectoryIfMissing)
+
+mkYesodDispatch "DataIdClient" resourcesDataIdClient
+
+main :: IO ()
+main = do
+    config <- readConfig
+    static <- getStaticDir "/tmp/data-id"
+    warp (configPort config) $ DataIdClient static config
+
+readConfig :: IO Config
+readConfig = execParser $ info (configOpts' <**> helper)
+    (fullDesc <> progDesc "Serve datarekisteri HTTP client"
+    <> header "Client HTTP server for datarekisteri")
+
+configOpts' :: Parser Config
+configOpts' = Config
+    <$> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> help "Port to listen on")
+    <*> strOption (long "approot" <> short 'r' <> metavar "URL" <> value "http://localhost:3000" <> help "External URL of the server path /")
+    <*> strOption (long "server-url" <> short 's' <> metavar "URL" <> value "http://localhost:3100" <> help "Internal URL of the API server")
+    -- TODO make port depend on the --port flag
+
+getStaticDir :: FilePath -> IO Static
+getStaticDir dir = createDirectoryIfMissing True dir >> static dir

guix.scm

@@ -1,728 +0,0 @@
-; also load guix.scm for id-rekisteri
-(use-modules ((guix licenses) #:prefix license:)
-             (guix packages)
-             (guix)
-             (guix download)
-             (guix build-system haskell)
-             (gnu packages haskell)
-             (gnu packages haskell-xyz)
-             (gnu packages haskell-crypto)
-             (gnu packages haskell-check)
-             (gnu packages haskell-web))
-
-(define-public datarekisteri
-  (package
-    (name "datarekisteri")
-    (version "0.0.1")
-    (source (origin
-              (method url-fetch)
-              (uri "file:///home/saku/koodi/rekisteri/datarekisteri")
-              (sha256
-                (base32
-                  "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-base64-bytestring
-                  ghc-cryptonite
-                  ghc-email-validate
-                  ghc-esqueleto
-                  ghc-mime-mail
-                  ghc-morpheus-graphql
-                  ghc-morpheus-graphql-client
-                  ghc-persistent
-                  ghc-persistent-postgresql
-                  ghc-scotty
-                  ghc-smtp-mail
-                  ghc-wai-cors
-                  ghc-wai-extra
-                  ghc-yesod
-                  ghc-yesod-static
-                  ghc-yesod-auth))
-    (home-page "")
-    (synopsis "")
-    (description "")
-    (license license:agpl3+)))
-
-(define-public ghc-authenticate
-  (package
-    (name "ghc-authenticate")
-    (version "1.3.5.1")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "authenticate" version))
-              (sha256
-               (base32
-                "1rhbvdgwdr68gp13p5piddfdqf3l9lmx4w7k249lc98y23780c3x"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-http-conduit
-                  ghc-case-insensitive
-                  ghc-http-types
-                  ghc-xml-conduit
-                  ghc-blaze-builder
-                  ghc-attoparsec
-                  ghc-unordered-containers
-                  ghc-conduit
-                  ghc-html-conduit
-                  ghc-resourcet
-                  ghc-network-uri))
-    (home-page "http://github.com/yesodweb/authenticate")
-    (synopsis "Authentication methods for Haskell web applications.")
-    (description "API docs and the README are available at
-<http://www.stackage.org/package/authenticate>.")
-    (license license:expat)))
-
-(define-public ghc-yesod-auth
-  (package
-    (name "ghc-yesod-auth")
-    (version "1.6.11")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "yesod-auth" version))
-              (sha256
-               (base32
-                "0fdahk5mc63g0zsafk8axry01qaxahmclpmmwygp2lhfsjy8mby2"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-authenticate
-                  ghc-base16-bytestring
-                  ghc-base64-bytestring
-                  ghc-blaze-builder
-                  ghc-blaze-html
-                  ghc-blaze-markup
-                  ghc-conduit
-                  ghc-conduit-extra
-                  ghc-cryptonite
-                  ghc-data-default
-                  ghc-email-validate
-                  ghc-file-embed
-                  ghc-http-client
-                  ghc-http-client-tls
-                  ghc-http-conduit
-                  ghc-http-types
-                  ghc-memory
-                  ghc-nonce
-                  ghc-persistent
-                  ghc-random
-                  ghc-safe
-                  ghc-shakespeare
-                  ghc-unliftio
-                  ghc-unliftio-core
-                  ghc-unordered-containers
-                  ghc-wai
-                  ghc-yesod-core
-                  ghc-yesod-form
-                  ghc-yesod-persistent
-                  ghc-network-uri))
-    (home-page "http://www.yesodweb.com/")
-    (synopsis "Authentication for Yesod.")
-    (description "API docs and the README are available at
-<http://www.stackage.org/package/yesod-auth>")
-    (license license:expat)))
-
-(define-public ghc-scotty
-  (package
-    (name "ghc-scotty")
-    (version "0.12")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "scotty" version))
-              (sha256
-               (base32
-                "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-base-compat-batteries
-                  ghc-blaze-builder
-                  ghc-case-insensitive
-                  ghc-data-default-class
-                  ghc-fail
-                  ghc-http-types
-                  ghc-monad-control
-                  ghc-nats
-                  ghc-network
-                  ghc-regex-compat
-                  ghc-transformers-base
-                  ghc-transformers-compat
-                  ghc-wai
-                  ghc-wai-extra
-                  ghc-warp))
-    (native-inputs (list ghc-async ghc-hspec ghc-hspec-wai ghc-lifted-base hspec-discover))
-    (arguments
-     `(#:cabal-revision ("7"
-                         "1i8icc612w4dbmqmnf99drqpmjvhjnkmqgk9xr63amj8jkz5lp4m")))
-    (home-page "https://github.com/scotty-web/scotty")
-    (synopsis
-     "Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp")
-    (description
-     "This package provides a Haskell web framework inspired by Ruby's Sinatra, using
-WAI and Warp. . @ &#123;-&#35; LANGUAGE OverloadedStrings &#35;-&#125; .  import
-Web.Scotty .  import Data.Monoid (mconcat) .  main = scotty 3000 $ &#32;&#32;get
-&#34;/:word&#34; $ do &#32;&#32;&#32;&#32;beam <- param &#34;word&#34;
-&#32;&#32;&#32;&#32;html $ mconcat [&#34;&#60;h1&#62;Scotty, &#34;, beam, &#34;
-me up!&#60;/h1&#62;&#34;] @ . .  Scotty is the cheap and cheerful way to write
-RESTful, declarative web applications. . * A page is as simple as defining the
-verb, url pattern, and Text content. . * It is template-language agnostic.
-Anything that returns a Text value will do. . * Conforms to WAI Application
-interface. . * Uses very fast Warp webserver by default. .  As for the name:
-Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
-[Warp] <http://hackage.haskell.org/package/warp>")
-    (license license:bsd-3)))
-
-(define-public ghc-hspec-wai
-  (package
-    (name "ghc-hspec-wai")
-    (version "0.11.1")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "hspec-wai" version))
-              (sha256
-               (base32
-                "03wiksic5y9a2g6a86nsxrnajdgdvpv17w02h5qla0zp9zs6pa1j"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-quickcheck
-                  ghc-base-compat
-                  ghc-case-insensitive
-                  ghc-hspec-core
-                  ghc-hspec-expectations
-                  ghc-http-types
-                  ghc-wai
-                  ghc-wai-extra))
-    (native-inputs (list ghc-hspec hspec-discover))
-    (home-page "https://github.com/hspec/hspec-wai#readme")
-    (synopsis "Experimental Hspec support for testing WAI applications")
-    (description "Experimental Hspec support for testing WAI applications")
-    (license license:expat)))
-
-(define-public ghc-morpheus-graphql
-  (package
-    (name "ghc-morpheus-graphql")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql" version))
-              (sha256
-               (base32
-                "1d2wk0zw3qb22skv7g4xagl04las5xnh9f4223c4as9cf39pcrp9"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-morpheus-graphql-app
-                  ghc-morpheus-graphql-code-gen
-                  ghc-morpheus-graphql-core
-                  ghc-morpheus-graphql-server
-                  ghc-relude
-                  ghc-unordered-containers
-                  ghc-vector))
-    (native-inputs (list ghc-morpheus-graphql-subscriptions
-                         ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL")
-    (description "Build GraphQL APIs with your favourite functional language!")
-    (license license:expat)))
-
-(define-public ghc-morpheus-graphql-code-gen
-  (package
-    (name "ghc-morpheus-graphql-code-gen")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-code-gen" version))
-              (sha256
-               (base32
-                "0aw9fl0hzl657w2arybyk0zqxvbdz897kiqwsv52r50dnb5x2izf"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-file-embed
-                  ghc-morpheus-graphql-code-gen-utils
-                  ghc-morpheus-graphql-core
-                  ghc-morpheus-graphql-server
-                  ghc-prettyprinter
-                  ghc-relude
-                  ghc-unordered-containers
-                  ghc-glob
-                  ghc-morpheus-graphql-client
-                  ghc-optparse-applicative
-                  ghc-yaml))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL CLI")
-    (description "code generator for Morpheus GraphQL")
-    (license license:bsd-3)))
-
-
-(define-public ghc-morpheus-graphql-core
-  (package
-    (name "ghc-morpheus-graphql-core")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-core" version))
-              (sha256
-               (base32
-                "0001pq7zj5rpjcg0jasd3vklisan2i8nxyk8d7xa31d4f1grn5ff"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-hashable
-                  ghc-megaparsec
-                  ghc-relude
-                  ghc-scientific
-                  ghc-th-lift-instances
-                  ghc-unordered-containers
-                  ghc-vector))
-    (native-inputs (list ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL Core")
-    (description "Build GraphQL APIs with your favorite functional language!")
-    (license license:expat)))
-
-
-(define-public ghc-morpheus-graphql-app
-  (package
-    (name "ghc-morpheus-graphql-app")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-app" version))
-              (sha256
-               (base32
-                "0mg12a8s2zcxcbm1zm5a4gn6vz8d9d1qdhk930zddxqbll5gq7nq"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-hashable
-                  ghc-megaparsec
-                  ghc-morpheus-graphql-core
-                  ghc-relude
-                  ghc-scientific
-                  ghc-th-lift-instances
-                  ghc-unordered-containers
-                  ghc-vector))
-    (native-inputs (list ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL App")
-    (description "Build GraphQL APIs with your favourite functional language!")
-    (license license:expat)))
-
-
-(define-public ghc-morpheus-graphql-subscriptions
-  (package
-    (name "ghc-morpheus-graphql-subscriptions")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-subscriptions" version))
-              (sha256
-               (base32
-                "138fcganlaj4fyq1aygiyy6f4hhw58n26ldrdkxhd66hr1mqv6j9"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-morpheus-graphql-app
-                  ghc-morpheus-graphql-core
-                  ghc-relude
-                  ghc-unliftio-core
-                  ghc-unordered-containers
-                  ghc-uuid
-                  ghc-websockets))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL Subscriptions")
-    (description "Build GraphQL APIs with your favourite functional language!")
-    (license license:expat)))
-
-
-(define-public ghc-morpheus-graphql-client
-  (package
-    (name "ghc-morpheus-graphql-client")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-client" version))
-              (sha256
-               (base32
-                "120414v0rcvzgm9dc2fx8598d88dqnpvhkc8zh3y2gl3b1bl31jb"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-file-embed
-                  ghc-modern-uri
-                  ghc-morpheus-graphql-code-gen-utils
-                  ghc-morpheus-graphql-core
-                  ghc-morpheus-graphql-subscriptions
-                  ghc-prettyprinter
-                  ghc-relude
-                  ghc-req
-                  ghc-unliftio-core
-                  ghc-unordered-containers
-                  ghc-websockets
-                  ghc-wuss))
-    (native-inputs (list ghc-tasty ghc-tasty-hunit))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL Client")
-    (description "Build GraphQL APIs with your favorite functional language!")
-    (license license:expat)))
-
-
-(define-public ghc-morpheus-graphql-tests
-  (package
-    (name "ghc-morpheus-graphql-tests")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-tests" version))
-              (sha256
-               (base32
-                "1h6nri73s5ibzidhwrkxffldardx6khq9kvhmqklm06cilwr56xi"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson ghc-relude ghc-tasty ghc-tasty-hunit
-                  ghc-unordered-containers))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL Test")
-    (description "")
-    (license license:expat)))
-
-
-(define-public ghc-morpheus-graphql-server
-  (package
-    (name "ghc-morpheus-graphql-server")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-server" version))
-              (sha256
-               (base32
-                "0cd6qczbb5cm12xv181pzq6d62nv7nf4w1yd3gmhzjfrks62lhwy"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-morpheus-graphql-app
-                  ghc-morpheus-graphql-core
-                  ghc-relude
-                  ghc-unordered-containers
-                  ghc-vector))
-    (native-inputs (list ghc-file-embed ghc-morpheus-graphql-subscriptions
-                         ghc-morpheus-graphql-tests ghc-tasty ghc-tasty-hunit))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL")
-    (description "Build GraphQL APIs with your favourite functional language!")
-    (license license:expat)))
-
-(define-public ghc-relude
-  (package
-    (name "ghc-relude")
-    (version "1.1.0.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "relude" version))
-              (sha256
-               (base32
-                "02dn99v2qmykj0l1qmn15k36hyxccy71b7iqavfk24zgjf5g07dm"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-hashable ghc-unordered-containers))
-    (native-inputs (list ghc-hedgehog ghc-doctest-20 ghc-glob))
-    (home-page "https://github.com/kowainik/relude")
-    (synopsis
-     "Safe, performant, user-friendly and lightweight Haskell Standard Library")
-    (description
-     "@__relude__@ is an alternative prelude library.  If you find the default
-@Prelude@ unsatisfying, despite its advantages, consider using @relude@ instead.
-== Relude goals and design principles * __Productivity.__ You can be more
-productive with a \"non-standard\" standard library, and @relude@ helps you with
-writing safer and more efficient code faster. * __Total programming__.  Usage of
-[/partial
-functions/](https://www.reddit.com/r/haskell/comments/5n51u3/why_are_partial_functions_as_in_head_tail_bad/)
-can lead to unexpected bugs and runtime exceptions in pure code.  The types of
-partial functions lie about their behaviour.  And even if it is not always
-possible to rely only on total functions, @relude@ strives to encourage
-best-practices and reduce the chances of introducing a bug.
-+---------------------------------+--------------------------------------------+
-| __Partial__                     | __Total__                                  |
-+=================================+============================================+
-| @head :: [a] -> a@              | @head :: NonEmpty a -> a@                  |
-+---------------------------------+--------------------------------------------+
-| @tail :: [a] -> [a]@            | @tail :: NonEmpty a -> [a]@                |
-+---------------------------------+--------------------------------------------+
-| @read :: Read a => String -> a@ | @readMaybe :: Read a => String -> Maybe a@ |
-+---------------------------------+--------------------------------------------+
-| @fromJust :: Maybe a -> a@      | @fromMaybe :: a -> Maybe a -> a@           |
-+---------------------------------+--------------------------------------------+
-* __Type-safety__.  We use the /\"make invalid states unrepresentable\"/ motto as
-one of our guiding principles.  If it is possible, we express this concept
-through the types. /Example:/ @ whenNotNull :: Applicative f => [a] -> (NonEmpty
-a -> f ()) -> f () @ * __Performance.__ We prefer @Text@ over
-@[String](https://www.reddit.com/r/haskell/comments/29jw0s/whats_wrong_with_string/)@,
-use space-leaks-free functions (e.g.  our custom performant @sum@ and
-@product@), introduce @\\{\\-\\# INLINE \\#\\-\\}@ and @\\{\\-\\# SPECIALIZE \\#\\-\\}@
-pragmas where appropriate, and make efficient container types (e.g. @Map@,
-@HashMap@, @Set@) more accessible. * __Minimalism__ (low number of
-dependencies).  We do not force users of @relude@ to stick to any specific lens
-or text formatting or logging library.  Where possible, @relude@ depends only on
-boot libraries.  The [Dependency
-graph](https://raw.githubusercontent.com/kowainik/relude/main/relude-dependency-graph.png)
-of @relude@ can give you a clearer picture. * __Convenience__.  Despite
-minimalism, we want to bring commonly used types and functions into scope, and
-make available functions easier to use.  Some examples of conveniences: 1.  No
-need to add @containers@, @unordered-containers@, @text@ and @bytestring@ to
-dependencies in your @.cabal@ file to use the main API of these libraries 2.  No
-need to import types like @NonEmpty@, @Text@, @Set@, @Reader[T]@, @MVar@, @STM@
-3.  Functions like @liftIO@, @fromMaybe@, @sortWith@ are available by default as
-well 4. @IO@ actions are lifted to @MonadIO@ * __Excellent documentation.__ 1.
-Tutorial 2.  Migration guide from @Prelude@ 3.  Haddock for every function with
-examples tested by [doctest](http://hackage.haskell.org/package/doctest).  4.
-Documentation regarding [internal module
-structure](http://hackage.haskell.org/package/relude/docs/Relude.html) 5.
-@relude@-specific [HLint](http://hackage.haskell.org/package/hlint) rules:
-@[.hlint.yaml](https://github.com/kowainik/relude/blob/main/.hlint.yaml)@ *
-__User-friendliness.__ Anyone should be able to quickly migrate to @relude@.
-Only some basic familiarity with the common libraries like @text@ and
-@containers@ should be enough (but not necessary). * __Exploration.__ We have
-space to experiment with new ideas and proposals without introducing breaking
-changes. @relude@ uses the approach with @Extra.*@ modules which are not
-exported by default.  The chosen approach makes it quite easy for us to provide
-new functionality without breaking anything and let the users decide to use it
-or not.")
-    (license license:expat)))
-
-(define-public ghc-doctest-20
-  (package
-    (name "ghc-doctest-20")
-    (version "0.20.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "doctest" version))
-              (sha256
-               (base32
-                "0sk50b8zxq4hvc8qphlmfha1lsv3xha7q7ka081jgswf1qpg34y4"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-base-compat ghc-code-page ghc-paths ghc-syb))
-    (native-inputs (list ghc-hunit
-                         ghc-quickcheck
-                         ghc-hspec
-                         hspec-discover
-                         ghc-hspec-core
-                         ghc-mockery
-                         ghc-setenv
-                         ghc-silently
-                         ghc-stringbuilder))
-    (arguments
-     `(#:cabal-revision ("5"
-                         "0d7xgi71zdfbg3an6v2ss4lj6lvlmvq36hy788nd94ja2bgfsmpx")))
-    (home-page "https://github.com/sol/doctest#readme")
-    (synopsis "Test interactive Haskell examples")
-    (description
-     "`doctest` is a tool that checks
-  [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744)
-  and
-  [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856)
-  in Haddock comments.  It is similar in spirit to the [popular Python module with
-  the same name](https://docs.python.org/3/library/doctest.html). .  Documentation
-  is at <https://github.com/sol/doctest#readme>.")
-    (license license:expat)))
-
-(define-public ghc-morpheus-graphql-code-gen-utils
-  (package
-    (name "ghc-morpheus-graphql-code-gen-utils")
-    (version "0.27.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "morpheus-graphql-code-gen-utils" version))
-              (sha256
-               (base32
-                "1d5v3b63v9yf47a5hh2am6v09hwm4sfxls38iwvlxva3km0s1qgn"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-morpheus-graphql-core ghc-prettyprinter ghc-relude
-                  ghc-unordered-containers))
-    (home-page "https://morpheusgraphql.com")
-    (synopsis "Morpheus GraphQL CLI")
-    (description "code generator for Morpheus GraphQL")
-    (license license:bsd-3)))
-
-(define-public ghc-wuss
-  (package
-    (name "ghc-wuss")
-    (version "2.0.0.2")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "wuss" version))
-              (sha256
-               (base32
-                "04jqq3blzyxqyymhcjsm5z89whk5y7cvnd9dw6nlc40vq4w4v802"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-connection ghc-network ghc-websockets))
-    (home-page "http://hackage.haskell.org/package/wuss")
-    (synopsis "Secure WebSocket (WSS) clients")
-    (description
-     "Wuss is a library that lets you easily create secure WebSocket clients over the
-WSS protocol.  It is a small addition to
-<https://hackage.haskell.org/package/websockets the websockets package> and is
-adapted from existing solutions by <https://gist.github.com/jaspervdj/7198388
-@@jaspervdj>, <https://gist.github.com/mpickering/f1b7ba3190a4bb5884f3
-@@mpickering>, and <https://gist.github.com/elfenlaid/7b5c28065e67e4cf0767
-@@elfenlaid>.")
-    (license license:expat)))
-
-(define-public ghc-rsa
-  (package
-    (name "ghc-rsa")
-    (version "2.4.1")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "RSA" version))
-              (sha256
-               (base32
-                "0hchsqrxpfw7mqrqwscfy8ig1w2di6w3nxpzi873w0gibv2diibj"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-crypto-api ghc-crypto-pubkey-types ghc-sha))
-    (native-inputs (list ghc-quickcheck ghc-tagged ghc-test-framework
-                         ghc-test-framework-quickcheck2))
-    (home-page "http://hackage.haskell.org/package/RSA")
-    (synopsis
-     "Implementation of RSA, using the padding schemes of PKCS#1 v2.1.")
-    (description
-     "This library implements the RSA encryption and signature algorithms for
-arbitrarily-sized ByteStrings.  While the implementations work, they are not
-necessarily the fastest ones on the planet.  Particularly key generation.  The
-algorithms included are based of RFC 3447, or the Public-Key Cryptography
-Standard for RSA, version 2.1 (a.k.a, PKCS#1 v2.1).")
-    (license license:bsd-3)))
-
-(define-public ghc-crypto-pubkey-types
-  (package
-    (name "ghc-crypto-pubkey-types")
-    (version "0.4.3")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "crypto-pubkey-types" version))
-              (sha256
-               (base32
-                "0q0wlzjmpx536h1zcdzrpxjkvqw8abj8z0ci38138kpch4igbnby"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-asn1-types ghc-asn1-encoding))
-    (home-page "http://github.com/vincenthz/hs-crypto-pubkey-types")
-    (synopsis "Generic cryptography Public keys algorithm types")
-    (description "Generic cryptography public keys algorithm types")
-    (license license:bsd-3)))
-
-(define-public ghc-authenticate-oauth
-  (package
-    (name "ghc-authenticate-oauth")
-    (version "1.7")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "authenticate-oauth" version))
-              (sha256
-               (base32
-                "0y4v46rn0cvm0sr1v8qq1zgzllrlrr3ji5gij1xprgf1zsazcvvl"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-http-client
-                  ghc-crypto-pubkey-types
-                  ghc-rsa
-                  ghc-data-default
-                  ghc-sha
-                  ghc-random
-                  ghc-http-types
-                  ghc-blaze-builder
-                  ghc-transformers-compat))
-    (home-page "http://github.com/yesodweb/authenticate")
-    (synopsis
-     "Library to authenticate with OAuth for Haskell web applications.")
-    (description "API docs and the README are available at
-<http://www.stackage.org/package/authenticate-oauth>.")
-    (license license:bsd-3)))
-
-(define-public ghc-req
-  (package
-    (name "ghc-req")
-    (version "3.12.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "req" version))
-              (sha256
-               (base32
-                "1gwdqmqmj3acim5r8c4sjzcvr3hvlbcjwkrpcsvq95ckr1wmzpqp"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-aeson
-                  ghc-authenticate-oauth
-                  ghc-blaze-builder
-                  ghc-case-insensitive
-                  ghc-connection
-                  ghc-http-api-data
-                  ghc-http-client
-                  ghc-http-client-tls
-                  ghc-http-types
-                  ghc-modern-uri
-                  ghc-monad-control
-                  ghc-retry
-                  ghc-transformers-base
-                  ghc-unliftio-core))
-    (native-inputs (list ghc-quickcheck ghc-hspec hspec-discover ghc-hspec-core
-                         ghc-quickcheck ghc-hspec))
-    (arguments '(#:tests? #f))
-    (home-page "https://github.com/mrkkrp/req")
-    (synopsis "HTTP client library")
-    (description "HTTP client library.")
-    (license license:bsd-3)))
-
-(define-public ghc-modern-uri
-  (package
-    (name "ghc-modern-uri")
-    (version "0.3.4.4")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "modern-uri" version))
-              (sha256
-               (base32
-                "19fffy7kb7ibajagdryjy872x56045zi6c1div8wvr8aisd55qsz"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-quickcheck
-                  ghc-contravariant
-                  ghc-hashable
-                  ghc-megaparsec
-                  ghc-profunctors
-                  ghc-reflection
-                  ghc-tagged))
-    (native-inputs (list ghc-hspec hspec-discover ghc-hspec-megaparsec))
-    (home-page "https://github.com/mrkkrp/modern-uri")
-    (synopsis "Modern library for working with URIs")
-    (description "Modern library for working with URIs.")
-    (license license:bsd-3)))
-
-(define-public ghc-mime-mail
-  (package
-    (name "ghc-mime-mail")
-    (version "0.5.1")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "mime-mail" version))
-              (sha256
-               (base32
-                "1s1wp8v1xlvw3r4qk1lv9zpm99ihka7a785zjl6i3fq1maqq955g"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-base64-bytestring ghc-random ghc-blaze-builder))
-    (native-inputs (list ghc-hspec hspec-discover))
-    (home-page "http://github.com/snoyberg/mime-mail")
-    (synopsis "Compose MIME email messages.")
-    (description
-     "Hackage documentation generation is not reliable.  For up to date documentation,
-please see: <http://www.stackage.org/package/mime-mail>.")
-    (license license:expat)))
-
-(define-public ghc-smtp-mail
-  (package
-    (name "ghc-smtp-mail")
-    (version "0.3.0.0")
-    (source (origin
-              (method url-fetch)
-              (uri (hackage-uri "smtp-mail" version))
-              (sha256
-               (base32
-                "0q81m4mi43cd0f1azm6984xw3qw2s6ygszdn86j5z3g5sjj5dax4"))))
-    (build-system haskell-build-system)
-    (inputs (list ghc-base16-bytestring
-                  ghc-base64-bytestring
-                  ghc-connection
-                  ghc-mime-mail
-                  ghc-network
-                  ghc-network-bsd
-                  ghc-cryptonite
-                  ghc-memory))
-    (home-page "http://github.com/jhickner/smtp-mail")
-    (synopsis "Simple email sending via SMTP")
-    (description
-     "This packages provides a simple interface for mail over SMTP.  PLease see the
-README for more information.")
-    (license license:bsd-3)))
-
-datarekisteri

guix.scm

@@ -0,0 +1 @@
+.guix/modules/datarekisteri-package.scm