diff --git a/.guix/modules/datarekisteri-package.scm b/.guix/modules/datarekisteri-package.scm index 0764e7a..853b811 100644 --- a/.guix/modules/datarekisteri-package.scm +++ b/.guix/modules/datarekisteri-package.scm @@ -15,10 +15,13 @@ #:use-module (gnu packages haskell-check) #:use-module (gnu packages haskell-crypto) #:use-module (gnu packages haskell-web) - #:use-module (gnu packages haskell-xyz)) + #:use-module (gnu packages haskell-xyz) + #:use-module (srfi srfi-26)) (define vcs-file? - (or (git-predicate (string-append (current-source-directory) "/../..")) + (or (and=> (and=> (current-source-directory) + (cut string-append <> "/../..")) + git-predicate) (const #t))) (define-public datarekisteri-backend @@ -44,6 +47,7 @@ ghc-persistent-postgresql ghc-scotty ghc-smtp-mail + ghc-unliftio-core ghc-wai-cors ghc-wai-extra)) (arguments @@ -111,18 +115,130 @@ (license license:agpl3+))) -(define ghc-authenticate +(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) + (properties '((upstream-name . "mime-mail"))) + (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: .") + (license license:expat))) + + +(define-public ghc-smtp-mail + (package + (name "ghc-smtp-mail") + (version "0.5.0.0") + (source + (origin + (method url-fetch) + (uri (hackage-uri "smtp-mail" version)) + (sha256 + (base32 "1slmv6k47aqlnms1gjfvsjs1zw8fymvwb7j8nxpjkm554dxqzbcj")))) + (build-system haskell-build-system) + (properties '((upstream-name . "smtp-mail"))) + (inputs (list ghc-base16-bytestring + ghc-base64-bytestring + ghc-crypton-connection + ghc-data-default-class + ghc-mime-mail + ghc-network + ghc-network-bsd + ghc-crypton + ghc-memory)) + (arguments + `(#:cabal-revision ("1" + "0mjbrjgr7r42a9f45x4zg1zwij1v20d50x1p4g1s17v49s57hyg3"))) + (home-page "http://github.com/haskell-github-trust/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 ghc-scotty + (package + (name "ghc-scotty") + (version "0.22") + (source + (origin + (method url-fetch) + (uri (hackage-uri "scotty" version)) + (sha256 + (base32 "075qnj3s1ddq337qcbrgwsc12rgjm1g5p755iaf67k824p0rifff")))) + (build-system haskell-build-system) + (properties '((upstream-name . "scotty"))) + (inputs (list ghc-aeson + ghc-blaze-builder + ghc-case-insensitive + ghc-cookie + ghc-data-default-class + ghc-http-types + ghc-monad-control + ghc-network + ghc-regex-compat + ghc-resourcet + ghc-transformers-base + ghc-unliftio + ghc-wai + ghc-wai-extra + ghc-warp + ghc-fail + ghc-nats)) + (native-inputs (list ghc-async + ghc-hspec + ghc-hspec-wai + ghc-lifted-base + ghc-doctest + ghc-http-client + hspec-discover)) + (arguments + `(#:cabal-revision ("2" + "1m3qvb5q6yigw6ijxnp6h66rmyqg54619hb240s7cqc9qjrrkixk"))) + (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. . @@ {-# LANGUAGE @code{OverloadedStrings} #-} . + import Web.Scotty . main = scotty 3000 $ get "/:word" $ do + beam <- @code{pathParam} "word" + html $ mconcat ["<h1>Scotty, ", beam, " +me up!</h1>"] @@ . . 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] . +[Warp] .") + (license license:bsd-3))) + +(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")))) + (version "1.3.5.2") + (source + (origin + (method url-fetch) + (uri (hackage-uri "authenticate" version)) + (sha256 + (base32 "1lsa5fgwxrz87l94d7whag2gpg0f3bxfn0244mi0byl6j5zpl0wp")))) (build-system haskell-build-system) + (properties '((upstream-name . "authenticate"))) (inputs (list ghc-aeson + ghc-attoparsec-aeson ghc-http-conduit ghc-case-insensitive ghc-http-types @@ -140,18 +256,20 @@ .") (license license:expat))) -(define ghc-yesod-auth +(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")))) + (version "1.6.11.3") + (source + (origin + (method url-fetch) + (uri (hackage-uri "yesod-auth" version)) + (sha256 + (base32 "1qfzg4khdzrhzq78323648780divjllqrxn9hhzpnis61f0fwni8")))) (build-system haskell-build-system) + (properties '((upstream-name . "yesod-auth"))) (inputs (list ghc-aeson + ghc-attoparsec-aeson ghc-authenticate ghc-base16-bytestring ghc-base64-bytestring @@ -185,226 +303,47 @@ (home-page "http://www.yesodweb.com/") (synopsis "Authentication for Yesod.") (description "API docs and the README are available at -") +.") (license license:expat))) -(define ghc-scotty +(define-public ghc-wuss (package - (name "ghc-scotty") - (version "0.12") - (source (origin - (method url-fetch) - (uri (hackage-uri "scotty" version)) - (sha256 - (base32 - "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1")))) + (name "ghc-wuss") + (version "2.0.2.7") + (source + (origin + (method url-fetch) + (uri (hackage-uri "wuss" version)) + (sha256 + (base32 "042pnniwn4kyb4d29zdh0284l497r1x393y5yw6jgigkvpdmpddb")))) (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. . @ {-# LANGUAGE OverloadedStrings #-} . import -Web.Scotty . import Data.Monoid (mconcat) . main = scotty 3000 $ get -"/:word" $ do beam <- param "word" - html $ mconcat ["<h1>Scotty, ", beam, " -me up!</h1>"] @ . . 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] . -[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 + (properties '((upstream-name . "wuss"))) + (inputs (list ghc-crypton-connection ghc-data-default ghc-network ghc-websockets)) - (home-page "https://morpheusgraphql.com") - (synopsis "Morpheus GraphQL Subscriptions") - (description "Build GraphQL APIs with your favourite functional language!") + (home-page "http://hackage.haskell.org/package/wuss") + (synopsis "Secure WebSocket (WSS) clients") + (description + "Wuss is a library that lets you easily create secure @code{WebSocket} clients +over the WSS protocol. It is a small addition to + and is +adapted from existing solutions by , , and .") (license license:expat))) - -(define ghc-morpheus-graphql-client +(define-public 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")))) + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-client" version)) + (sha256 + (base32 "0l164jakzf0f351454hjdw6y8mccwj289ykjszq3n4rvcb67qi7l")))) (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql-client"))) (inputs (list ghc-aeson ghc-file-embed ghc-modern-uri @@ -421,342 +360,309 @@ Sinatra + Warp = Scotty. . [WAI] . (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!") + (description + "Build @code{GraphQL} APIs with your favorite functional language!") (license license:expat))) - -(define ghc-morpheus-graphql-tests +(define-public ghc-morpheus-graphql-subscriptions (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")))) + (name "ghc-morpheus-graphql-subscriptions") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-subscriptions" version)) + (sha256 + (base32 "1zf1xai9b82768cc8z9q30snsnhggyi1xrsabww24mnbb1a3qsja")))) (build-system haskell-build-system) - (inputs (list ghc-aeson ghc-relude ghc-tasty ghc-tasty-hunit - ghc-unordered-containers)) + (properties '((upstream-name . "morpheus-graphql-subscriptions"))) + (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 Test") - (description "") + (synopsis "Morpheus GraphQL Subscriptions") + (description + "Build @code{GraphQL} APIs with your favourite functional language!") (license license:expat))) - -(define ghc-morpheus-graphql-server +(define-public 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")))) + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-server" version)) + (sha256 + (base32 "0yb6kbzbriqxhgr93jxaqg072n6ikdilhmwndkys9sq0l4adfp7k")))) (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql-server"))) (inputs (list ghc-aeson + ghc-file-embed 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 + (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!") + (description + "Build @code{GraphQL} APIs with your favourite functional language!") (license license:expat))) -(define ghc-relude +(define-public ghc-morpheus-graphql-code-gen-utils + (package + (name "ghc-morpheus-graphql-code-gen-utils") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-code-gen-utils" version)) + (sha256 + (base32 "0yn2fblmain2hkgwvqdkghxh08w7h6aq6rf48pv6d6adn2ziis0q")))) + (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql-code-gen-utils"))) + (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 @code{GraphQL}.") + (license license:bsd-3))) + +(define-public ghc-morpheus-graphql-code-gen + (package + (name "ghc-morpheus-graphql-code-gen") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-code-gen" version)) + (sha256 + (base32 "0bxjlk4bpk5yflrsvmp2jayfjwn3qqm098cva0cgshim06xfxyax")))) + (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql-code-gen"))) + (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 @code{GraphQL}.") + (license license:bsd-3))) + +(define-public ghc-morpheus-graphql-tests + (package + (name "ghc-morpheus-graphql-tests") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-tests" version)) + (sha256 + (base32 "04avy0rpw9md4dd5jjjr4px9z2jwgwfz3mywrdi6mq03sk57xysh")))) + (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql-tests"))) + (inputs (list ghc-aeson ghc-relude ghc-tasty ghc-tasty-hunit + ghc-unordered-containers)) + (home-page "https://morpheusgraphql.com") + (synopsis "Morpheus GraphQL Test") + (description "test utils for morpheus graphql.") + (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")))) + (version "1.2.2.2") + (source + (origin + (method url-fetch) + (uri (hackage-uri "relude" version)) + (sha256 + (base32 "1865bladis4czglyvkcj05qh3fr2bvrm1w5dm5gz3wjs2cnsivci")))) (build-system haskell-build-system) + (properties '((upstream-name . "relude"))) + (arguments + (list + #:cabal-revision + '("3" "1zbx1xm4qdhjriyrdbyqflkymvpa9aafjb4jck61w5kmvjqqxplc") + #:phases + #~(modify-phases %standard-phases + (replace 'check + (lambda _ + (setenv "GHC_PACKAGE_PATH" + (string-append (or (getenv "TMP") "/tmp") + "/package.conf.d")) + (invoke "./dist/build/relude-test/relude-test") + (invoke "./dist/build/relude-doctest/relude-doctest") + (unsetenv "GHC_PACKAGE_PATH")))))) (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 + "@@__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 +possible to rely only on total functions, @@relude@@ strives to encourage best-practices and reduce the chances of introducing a bug. +---------------------------------+--------------------------------------------+ -| __Partial__ | __Total__ | +| __Partial__ | __Total__ | +=================================+============================================+ -| @head :: [a] -> a@ | @head :: NonEmpty a -> a@ | +| @@head :: [a] -> a@@ | @@head :: @code{NonEmpty} a -> a@@ | +---------------------------------+--------------------------------------------+ -| @tail :: [a] -> [a]@ | @tail :: NonEmpty a -> [a]@ | +| @@tail :: [a] -> [a]@@ | @@tail :: @code{NonEmpty} a -> [a]@@ | +---------------------------------+--------------------------------------------+ -| @read :: Read a => String -> a@ | @readMaybe :: Read a => String -> Maybe a@ | +| @@read :: Read a => String -> a@@ | @code{@@readMaybe} :: Read a => String -> +Maybe a@@ | +---------------------------------+--------------------------------------------+ -| @fromJust :: Maybe a -> a@ | @fromMaybe :: a -> Maybe a -> a@ | +| @code{@@fromJust} :: Maybe a -> a@@ | @code{@@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 +through the types. /Example:/ @@ @code{whenNotNull} :: Applicative f => [a] -> +(@code{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@@, @code{@@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 +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 +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 @code{@@NonEmpty}@@, @@Text@@, +@@Set@@, @@Reader[T]@@, @@MVar@@, @@STM@@ 3. Functions like @code{@@liftIO}@@, +@code{@@fromMaybe}@@, @code{@@sortWith}@@ are available by default as well 4. +@@IO@@ actions are lifted to @code{@@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 +@@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 +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 +(define-public ghc-morpheus-graphql-core (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 - and is -adapted from existing solutions by , , and .") - (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 -.") - (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")))) + (name "ghc-morpheus-graphql-core") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-core" version)) + (sha256 + (base32 "1595m4qcwbpz4zwa2jwcq7bgplxis2j69j3n24wcfs6pv1jlbbmj")))) (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql-core"))) (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.") + 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 - "Hackage documentation generation is not reliable. For up to date documentation, -please see: .") + "Build @code{GraphQL} APIs with your favorite functional language!") (license license:expat))) -(define ghc-smtp-mail +(define-public ghc-morpheus-graphql-app (package - (name "ghc-smtp-mail") - (version "0.3.0.0") - (source (origin - (method url-fetch) - (uri (hackage-uri "smtp-mail" version)) - (sha256 - (base32 - "0q81m4mi43cd0f1azm6984xw3qw2s6ygszdn86j5z3g5sjj5dax4")))) + (name "ghc-morpheus-graphql-app") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql-app" version)) + (sha256 + (base32 "156w5naxmda7hb4v107c8p1rzdqq53slf2nd393drsqd8qz7wv26")))) (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") + (properties '((upstream-name . "morpheus-graphql-app"))) + (inputs (list ghc-aeson + ghc-attoparsec-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 - "This packages provides a simple interface for mail over SMTP. PLease see the -README for more information.") - (license license:bsd-3))) + "Build @code{GraphQL} APIs with your favourite functional language!") + (license license:expat))) + +(define-public ghc-morpheus-graphql + (package + (name "ghc-morpheus-graphql") + (version "0.28.5") + (source + (origin + (method url-fetch) + (uri (hackage-uri "morpheus-graphql" version)) + (sha256 + (base32 "03srjbsirfkxfbk5sizixrqw7kyf9xfkhgxb4qxvhf8rh912i55x")))) + (build-system haskell-build-system) + (properties '((upstream-name . "morpheus-graphql"))) + (inputs (list ghc-aeson + ghc-attoparsec-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 @code{GraphQL} APIs with your favourite functional language!") + (license license:expat))) + (define-public go-github-com-jmoiron-sqlx (package diff --git a/backend/datarekisteri-backend.cabal b/backend/datarekisteri-backend.cabal index 00e7f97..ab59113 100644 --- a/backend/datarekisteri-backend.cabal +++ b/backend/datarekisteri-backend.cabal @@ -37,6 +37,7 @@ executable datarekisteri-backend smtp-mail, text, time, + unliftio-core, containers, wai, warp, diff --git a/backend/src/Datarekisteri/Backend.hs b/backend/src/Datarekisteri/Backend.hs index c9db1e1..3cac318 100644 --- a/backend/src/Datarekisteri/Backend.hs +++ b/backend/src/Datarekisteri/Backend.hs @@ -13,6 +13,7 @@ import "cryptonite" Crypto.Random (MonadRandom(..)) import qualified "base64" Data.ByteString.Base64 as B64 import Control.Monad.Except (catchError) +import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Logger (runStderrLoggingT) import Data.Default (def) import Data.Map (findWithDefault) @@ -76,7 +77,7 @@ runMigrations dbUrl = do callProcess "dbmate" ["--url", toString dbUrl, "--migrations-dir", migrationsPath, "up"] serverApp :: Config -> IO Application -serverApp config = scottyAppT (runAPIM config) $ do +serverApp config = scottyAppT defaultOptions (runAPIM config) $ do middleware $ gzip def middleware $ cors $ const $ Just CorsResourcePolicy { corsOrigins = Nothing -- all @@ -109,7 +110,7 @@ parseBearer auth = do guard $ toLower authType == "bearer" pure $ BearerToken authData -authBearer :: Maybe BearerToken -> ActionT LText APIM a -> ActionT LText APIM a +authBearer :: Maybe BearerToken -> ActionT APIM a -> ActionT APIM a authBearer Nothing m = m authBearer (Just (BearerToken bearer)) m = do let getUserPermissions = do @@ -129,14 +130,14 @@ parseBasic txt = do [authType, authData] <- words <$> txt guard $ toLower authType == "basic" (email, password) <- rightToMaybe $ - breakOn' ":" . decodeUtf8 <$> B64.decodeBase64 (encodeUtf8 authData) + breakOn' ":" . decodeUtf8 <$> B64.decodeBase64Untyped (encodeUtf8 authData) emailAddress <- toEmail email pure $ BasicAuth {..} where breakOn' x xs = let (fst, snd) = breakOn x xs in (fst, fromMaybe "" $ stripPrefix x snd) -authBasic :: Maybe BasicAuth -> ActionT LText APIM a -> ActionT LText APIM a +authBasic :: Maybe BasicAuth -> ActionT APIM a -> ActionT APIM a authBasic Nothing m = m authBasic (Just basic) m = do DBUser {..} <- verifyBasic basic @@ -148,7 +149,7 @@ authBasic (Just basic) m = do , statePermissions = permissions } -verifyBasic :: BasicAuth -> ActionT LText APIM (DBUser APIM) +verifyBasic :: BasicAuth -> ActionT APIM (DBUser APIM) verifyBasic BasicAuth {..} = do maybeUser <- lift $ dbGetUserByEmail emailAddress let unauthorized = do @@ -162,7 +163,7 @@ verifyBasic BasicAuth {..} = do pure user newtype APIM a = APIM (ReaderT RequestState IO a) - deriving (Functor, Applicative, Monad, MonadIO, MonadReader RequestState) + deriving (Functor, Applicative, Monad, MonadIO, MonadReader RequestState, MonadUnliftIO) data RequestState = RequestState { stateCurrentUser :: Maybe UserID diff --git a/backend/src/Datarekisteri/Backend/API.hs b/backend/src/Datarekisteri/Backend/API.hs index e559dd0..1e502dc 100644 --- a/backend/src/Datarekisteri/Backend/API.hs +++ b/backend/src/Datarekisteri/Backend/API.hs @@ -22,6 +22,7 @@ import Relude hiding (Undefined, get) import "cryptonite" Crypto.Random (getRandomBytes, MonadRandom) import qualified "base64" Data.ByteString.Base64 as B64 +import qualified "base64" Data.Base64.Types as B64 import Control.Monad.Except (MonadError, throwError, catchError) import Data.Morpheus.Server (deriveApp, runApp) @@ -106,7 +107,7 @@ updateUser user args = do newTokenArgsToData :: (MonadRandom m, MonadTime m, MonadPermissions m) => NewTokenArgs -> UserID -> m NewTokenData newTokenArgsToData NewTokenArgs {..} user = do - tokenData <- B64.encodeBase64 <$> getRandomBytes 128 + tokenData <- B64.extractBase64 . B64.encodeBase64 <$> getRandomBytes 128 issued <- currentTime permissions <- maybe currentPermissions pure =<< maybe (pure Nothing) toPermissions permissions let expires = Nothing diff --git a/channels.scm b/channels.scm index 52617ad..4349294 100644 --- a/channels.scm +++ b/channels.scm @@ -3,7 +3,7 @@ (url "https://git.savannah.gnu.org/git/guix.git") (branch "master") (commit - "27ae140024b6d05506cdf0d9fd5b91c25466f295") + "86813d5779253bb50002d79ab791eeda5a8b4729") (introduction (make-channel-introduction "9edb3f66fd807b096b48283debdcddccfea34bad" diff --git a/core/src/Datarekisteri/Core/Types.hs b/core/src/Datarekisteri/Core/Types.hs index 5d04874..d2a1775 100644 --- a/core/src/Datarekisteri/Core/Types.hs +++ b/core/src/Datarekisteri/Core/Types.hs @@ -35,6 +35,7 @@ module Datarekisteri.Core.Types import Relude import qualified "base64" Data.ByteString.Base64 as B64 +import qualified "base64" Data.Base64.Types as B64 import Data.Aeson (ToJSON(..), FromJSON(..)) import Data.Char (isSpace) @@ -51,10 +52,10 @@ import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress) import qualified Data.Text as T base64Encode :: ByteString -> Base64 -base64Encode = Base64 . B64.encodeBase64 +base64Encode = Base64 . B64.extractBase64 . B64.encodeBase64 base64Decode :: Base64 -> Maybe ByteString -base64Decode (Base64 x) = either (const Nothing) Just $ B64.decodeBase64 $ encodeUtf8 x +base64Decode (Base64 x) = either (const Nothing) Just $ B64.decodeBase64Untyped $ encodeUtf8 x toEmail :: Text -> Maybe Email toEmail = fmap Email . emailAddress . encodeUtf8 diff --git a/frontend/src/Datarekisteri/Frontend/Auth.hs b/frontend/src/Datarekisteri/Frontend/Auth.hs index 4cfd7f2..fe92c6d 100644 --- a/frontend/src/Datarekisteri/Frontend/Auth.hs +++ b/frontend/src/Datarekisteri/Frontend/Auth.hs @@ -15,6 +15,7 @@ module Datarekisteri.Frontend.Auth where import Relude import qualified "base64" Data.ByteString.Base64 as B64 +import qualified "base64" Data.Base64.Types as B64 import Yesod import Yesod.Auth @@ -37,7 +38,7 @@ postLoginR authReq = do <$> ireq textField "email" <*> ireq textField "password" case res of FormSuccess auth -> do - maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ B64.encodeBase64 $ encodeUtf8 auth + maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ B64.extractBase64 $ B64.encodeBase64 $ encodeUtf8 auth case maybeAuth of Nothing -> loginErrorMessageI LoginR Msg.InvalidEmailPass -- invalid creds Just txt -> do