FIXUP lisää Gitin ssl-tiedot

.guix/modules/tiedote-md-package.scm

@@ -11,16 +11,13 @@
   #:use-module (gnu packages haskell-check)
   #:use-module (gnu packages haskell-web)
   #:use-module (gnu packages golang-web)
-  #:use-module (gnu packages ssh)
   #:use-module (gnu packages version-control))
 
 (define vcs-file?
-  (or (and=> (current-source-directory)
+  (or (git-predicate (string-append (current-source-directory) "/../.."))
-             (lambda (dir)
-               (git-predicate (string-append dir "/../.."))))
       (const #t)))
 
-(define tiedote-md*
+(define-public tiedote-md
   (package
     (name "tiedote-md")
     (version "0.0.1-git")
@@ -31,7 +28,7 @@
     (inputs (list ghc-acid-state
                   ghc-attoparsec
                   ghc-base64
-                  ghc-crypton
+                  ghc-cryptonite
                   ghc-case-insensitive
                   ghc-glob
                   ghc-purebred-email
@@ -44,19 +41,17 @@
                   ghc-scotty
                   ghc-exit-codes
                   git
-                  openssh-sans-x
                   go-github-com-aymerick-douceur))
     (arguments
       (list
        #:phases
        #~(modify-phases %standard-phases
            (add-after 'install 'wrap-binaries
-             (lambda* (#:key inputs #:allow-other-keys)
+             (lambda _
                (wrap-program
                  (string-append #$output "/bin/tiedote.md")
-                 `("PATH" prefix (,(string-append (assoc-ref inputs "git") "/bin")
+                 `("PATH" prefix (,(string-append #$(this-package-input "git") "/bin")
-                                  ,(string-append (assoc-ref inputs "openssh-sans-x") "/bin")
+                                  ,(string-append #$(this-package-input "go-github-com-aymerick-douceur")
-                                  ,(string-append (assoc-ref inputs "go-github-com-aymerick-douceur")
                                                   "/bin")))))))))
     (home-page "https://git.olarinmaensamoojat.fi/OMS/tiedote.md")
     (synopsis "Git- ja markdown-pohjainen masssasähköpostijärjestelmä OMS:lle")
@@ -67,53 +62,90 @@ sähköpostipohjaista käyttöliittymää. Toistaiseksi tiedote.md on kovakoodat
 käyttämään OMS:n tiedotepohjia.")
     (license license:agpl3+)))
 
-(define ghc-template-haskell-lift
+(define ghc-scotty
   (package
-    (name "ghc-template-haskell-lift")
+    (name "ghc-scotty")
-    (version "0.1.0.0")
+    (version "0.12")
-    (source
+    (source (origin
-     (origin
               (method url-fetch)
-       (uri (hackage-uri "template-haskell-lift" version))
+              (uri (hackage-uri "scotty" version))
               (sha256
-        (base32 "09zilw0nbjmn1k688l058183rwa3br0fvh3x8jxqygjh3011w8ps"))))
+               (base32
+                "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1"))))
     (build-system haskell-build-system)
-    (properties '((upstream-name . "template-haskell-lift")))
+    (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 ("1"
+     `(#:cabal-revision ("7"
-                         "072g7a9b2sp0vc3g48xqbrxfis1rizqakz0b8064hs0cbgj3xkgn")))
+                         "1i8icc612w4dbmqmnf99drqpmjvhjnkmqgk9xr63amj8jkz5lp4m")))
-    (home-page "http://hackage.haskell.org/package/template-haskell-lift")
+    (home-page "https://github.com/scotty-web/scotty")
-    (synopsis "The 'Lift' typeclass.")
+    (synopsis
+     "Haskell web framework inspired by Ruby's Sinatra, using WAI and Warp")
     (description
-     "The stable home of @code{TemplateHaskell's} Lift typeclass, which implements
+     "This package provides a Haskell web framework inspired by Ruby's Sinatra, using
-cross-stage persistence for Template Haskell.")
+WAI and Warp. . @ {-# LANGUAGE OverloadedStrings #-} .  import
-    (license license:bsd-2)))
+Web.Scotty .  import Data.Monoid (mconcat) .  main = scotty 3000 $   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-doclayout*
+(define ghc-hspec-wai
   (package
-    (inherit ghc-doclayout)
+    (name "ghc-hspec-wai")
-    (source
+    (version "0.11.1")
-      (origin
+    (source (origin
-        (inherit (package-source ghc-doclayout))
+              (method url-fetch)
-        (patches
+              (uri (hackage-uri "hspec-wai" version))
-          (list (local-file "../patches/ghc-doclayout-add-lift-instance.patch")))))
+              (sha256
-    (inputs (modify-inputs (package-inputs ghc-doclayout)
+               (base32
-              (append ghc-template-haskell-lift)))))
+                "03wiksic5y9a2g6a86nsxrnajdgdvpv17w02h5qla0zp9zs6pa1j"))))
-
+    (build-system haskell-build-system)
-(define-public tiedote-md
+    (inputs (list ghc-quickcheck
-  ((package-input-rewriting `((,ghc-doclayout . ,ghc-doclayout*)))
+                  ghc-base-compat
-   tiedote-md*))
+                  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-acid-state
   (package
    (name "ghc-acid-state")
-    (version "0.16.1.4")
+   (version "0.16.1.2")
-    (source
+   (source (origin
-      (origin
              (method url-fetch)
              (uri (hackage-uri "acid-state" version))
              (sha256
-          (base32 "1z3q0d83dmdhr2s0bh4vhlyz82wik3w8gdmqs5mxk6kw6g7f0xzl"))))
+              (base32
+               "1ixg62liif1g18ggxap8zdhzy261fj5d24pmb0n36gfhz18b38bx"))))
    (build-system haskell-build-system)
    (properties '((upstream-name . "acid-state")))
    (inputs (list ghc-cereal
@@ -122,119 +154,71 @@ cross-stage persistence for Template Haskell.")
                  ghc-network
                  ghc-network-bsd
                  ghc-th-expand-syns))
-    (native-inputs (list hspec-discover ghc-hspec ghc-hedgehog))
+   (native-inputs (list ghc-hspec ghc-hspec-discover ghc-hedgehog))
    (home-page "https://github.com/acid-state/acid-state")
-    (synopsis
+   (synopsis "Add ACID guarantees to any serializable Haskell data structure.")
-      "Add ACID guarantees to any serializable Haskell data structure.")
    (description
     "Use regular Haskell data structures as your database and get stronger ACID
-      guarantees than most RDBMS offer.")
+guarantees than most RDBMS offer.")
    (license license:public-domain)))
 
-(define ghc-ap-normalize
+(define ghc-safecopy
   (package
-    (name "ghc-ap-normalize")
+   (name "ghc-safecopy")
-    (version "0.1.0.1")
+   (version "0.10.4.2")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
-       (uri (hackage-uri "ap-normalize" version))
+             (uri (hackage-uri "safecopy" version))
              (sha256
-        (base32 "1212zxc4qn6msk0w13yhrza2qjs79h78misllb4chng75jqi61l2"))))
+              (base32
+               "0r2mf0p82gf8vnldx477b5ykrj1x7hyg13nqfn6gzb50japs6h3i"))))
    (build-system haskell-build-system)
-    (properties '((upstream-name . "ap-normalize")))
+   (properties '((upstream-name . "safecopy")))
-    (arguments (list #:tests? #f))
+   (inputs (list ghc-cereal
-    (home-page "http://hackage.haskell.org/package/ap-normalize")
+                 ghc-generic-data
-    (synopsis "Self-normalizing applicative expressions")
+                 ghc-old-time
-    (description
+                 ghc-vector))
-     "An applicative functor transformer to normalize expressions using @@(\\<$>)@@,
+   (native-inputs (list ghc-lens
-@@(\\<*>)@@, and @@pure@@ into a linear list of actions.  See
+                        ghc-lens-action
-\"@code{ApNormalize}\" to get started.")
+                        ghc-tasty
-    (license license:expat)))
+                        ghc-tasty-quickcheck
-
+                        ghc-quickcheck-instances
-(define ghc-concise
+                        ghc-quickcheck
-  (package
+                        ghc-hunit))
-    (name "ghc-concise")
+   (arguments
-    (version "0.1.0.1")
+    `(#:cabal-revision ("6"
-    (source
+                        "0ii5cdg4l4ww81p7gd5m3z2jdqrs2hvqhwzrlz267nzxbws00x0b")))
-     (origin
+   (home-page "https://github.com/acid-state/safecopy")
-       (method url-fetch)
+   (synopsis "Binary serialization with version control.")
-       (uri (hackage-uri "concise" version))
+   (description "An extension to Data.Serialize with built-in version control.")
-       (sha256
+   (license license:public-domain)))
-        (base32 "09crgc6gjfidlad6263253xx1di6wfhc9awhira21s0z7rddy9sw"))))
-    (build-system haskell-build-system)
-    (properties '((upstream-name . "concise")))
-    (inputs (list ghc-lens))
-    (native-inputs (list ghc-tasty ghc-tasty-quickcheck ghc-quickcheck
-                         ghc-quickcheck-instances))
-    (home-page "https://github.com/frasertweedale/hs-concise")
-    (synopsis "Utilities for Control.Lens.Cons")
-    (description
-     "concise provides a handful of functions to extend what you can do with
-Control.Lens.Cons.")
-    (license license:bsd-3)))
-
-(define ghc-exit-codes
-  (package
-    (name "ghc-exit-codes")
-    (version "1.0.0")
-    (source
-     (origin
-       (method url-fetch)
-       (uri (hackage-uri "exit-codes" version))
-       (sha256
-        (base32 "00cyli96zkyqhjr3lqzrislqyk72xwm2dcqvjagklidh32d4k8ja"))))
-    (build-system haskell-build-system)
-    (properties '((upstream-name . "exit-codes")))
-    (home-page "http://github.com/JustusAdam/exit-codes")
-    (synopsis "Exit codes as defined by BSD")
-    (description
-     "Expose the exit codes defined by BSD in sysexits.h to the Haskell world.")
-    (license license:bsd-3)))
-
-(define ghc-filestore
-  (package
-    (name "ghc-filestore")
-    (version "0.6.5.1")
-    (source
-     (origin
-       (method url-fetch)
-       (uri (hackage-uri "filestore" version))
-       (sha256
-        (base32 "1m6rav1rcigckakw8ky27lbwh5a9q8xl7nvv358ljykmvyl1j2lc"))))
-    (build-system haskell-build-system)
-    (properties '((upstream-name . "filestore")))
-    (inputs (list ghc-utf8-string ghc-xml ghc-split ghc-diff ghc-old-locale))
-    (native-inputs (list ghc-hunit git-minimal/pinned mercurial))
-    (home-page "http://hackage.haskell.org/package/filestore")
-    (synopsis "Interface for versioning file stores.")
-    (description
-     "The filestore library provides an abstract interface for a versioning file
-store, and modules that instantiate this interface.  Currently Git, Darcs, and
-Mercurial modules are provided, and other VCSs or databases could be added.")
-    (license license:bsd-3)))
 
 (define ghc-generic-data
   (package
    (name "ghc-generic-data")
-    (version "1.1.0.2")
+   (version "1.0.0.1")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
              (uri (hackage-uri "generic-data" version))
              (sha256
-        (base32 "1dfs728nbkilzfmdk6gnjk7wdk1habqn35pb071zcmcp8ll0lzpj"))))
+              (base32
+               "0fz65k4sxn9c23rg5iv0vij2mksl5rkn6dl2f3i9d9d60b5wca9y"))))
    (build-system haskell-build-system)
    (properties '((upstream-name . "generic-data")))
-    (inputs (list ghc-ap-normalize ghc-base-orphans ghc-show-combinators
+   (inputs (list ghc-ap-normalize
-                  ghc-contravariant))
+                 ghc-contravariant
-    (native-inputs (list ghc-generic-lens
+                 ghc-show-combinators))
+   (native-inputs (list ghc-tasty
+                        ghc-tasty-hunit
                         ghc-tasty
                         ghc-tasty-hunit
+                        ghc-tasty
+                        ghc-tasty-hunit
+                        ghc-generic-lens
+                        ghc-tasty
+                        ghc-tasty-hunit
+                        ghc-generic-lens
                         ghc-one-liner))
-    (arguments
-     `(#:cabal-revision ("1"
-                         "0f2aijk70cb01p8yzbg5jq4gawnaryg8qnb1jx4xx92mfmn673p8")))
    (home-page "https://github.com/Lysxia/generic-data#readme")
    (synopsis "Deriving instances with GHC.Generics and related utilities")
    (description
@@ -246,12 +230,12 @@ representations to help using \"GHC.Generics\".  See README.")
   (package
    (name "ghc-lens-action")
    (version "0.2.6")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
              (uri (hackage-uri "lens-action" version))
              (sha256
-        (base32 "0cdprc5j6r976dmrga2zwvcr7qsv7nqy3nvncp66yyy0dk2qlwm3"))))
+              (base32
+               "0cdprc5j6r976dmrga2zwvcr7qsv7nqy3nvncp66yyy0dk2qlwm3"))))
    (build-system haskell-build-system)
    (properties '((upstream-name . "lens-action")))
    (inputs (list ghc-lens ghc-comonad ghc-contravariant ghc-profunctors
@@ -266,94 +250,92 @@ representations to help using \"GHC.Generics\".  See README.")
 folds as split off from the original lens package.")
    (license license:bsd-3)))
 
-(define ghc-linear-base
+(define ghc-ap-normalize
   (package
-    (name "ghc-linear-base")
+   (name "ghc-ap-normalize")
-    (version "0.5.0")
+   (version "0.1.0.1")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
-       (uri (hackage-uri "linear-base" version))
+             (uri (hackage-uri "ap-normalize" version))
              (sha256
-        (base32 "0iikqp73i0isxkd8xwg5f8f6dk3cv5iw6ifjkmp5r5kwxb650xgq"))))
+              (base32
+               "1212zxc4qn6msk0w13yhrza2qjs79h78misllb4chng75jqi61l2"))))
    (build-system haskell-build-system)
-    (properties '((upstream-name . "linear-base")))
+   (properties '((upstream-name . "ap-normalize")))
-    (inputs (list ghc-hashable ghc-linear-generics ghc-storable-tuple
+   (native-inputs (list ghc-inspection-testing ghc-inspection-testing))
-                  ghc-vector ghc-primitive))
+   (home-page "http://hackage.haskell.org/package/ap-normalize")
-    (native-inputs (list ghc-inspection-testing
+   (synopsis "Self-normalizing applicative expressions")
-                         ghc-tasty-inspection-testing
+   (description
-                         ghc-tasty
+    "An applicative functor transformer to normalize expressions using @@(\\<$>)@@,
-                         ghc-tasty-hedgehog
+@@(\\<*>)@@, and @@pure@@ into a linear list of actions.  See \"ApNormalize\" to
-                         ghc-mmorph
+get started.")
-                         ghc-hedgehog))
-    (home-page "https://github.com/tweag/linear-base#README")
-    (synopsis "Standard library for linear types.")
-    (description "Please see README.md.")
    (license license:expat)))
 
-(define ghc-linear-generics
+(define ghc-show-combinators
   (package
-    (name "ghc-linear-generics")
+   (name "ghc-show-combinators")
-    (version "0.2.3")
+   (version "0.2.0.0")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
-       (uri (hackage-uri "linear-generics" version))
+             (uri (hackage-uri "show-combinators" version))
              (sha256
-        (base32 "0093ywl8s8k92b50li28gcmqc616f6l7jkv7vslkvqzn42yrvbq2"))))
+              (base32
+               "07ds87ldl9165hj3k5h84iawc6vqlbggni3dg1nhbxww1spxn0n9"))))
    (build-system haskell-build-system)
-    (properties '((upstream-name . "linear-generics")))
+   (properties '((upstream-name . "show-combinators")))
-    (inputs (list ghc-th-abstraction))
-    (native-inputs (list hspec-discover ghc-hspec))
    (arguments
-     `(#:cabal-revision ("4"
+    `(#:cabal-revision ("2"
-                         "1wxb2r70bn1rhs771jlq08q1wvaf7risn6y931snaxa0xwi6a4zq")))
+                        "0n3xlpm41wpw1ybmacg9s7150nx00qrdlw2rq4fzz7iw7333cyjx")))
-    (home-page "https://github.com/linear-generics/linear-generics")
+   (home-page "https://github.com/Lysxia/show-combinators#readme")
-    (synopsis "Generic programming library for generalised deriving.")
+   (synopsis "Combinators to write Show instances")
    (description
-     "This package offers a version of
+    "This package provides a minimal pretty-printing library for Show instances in
-<https://hackage.haskell.org/package/base/docs/GHC-Generics.html GHC.Generics>
+Haskell.")
-with two important improvements: .  1.  The @@to@@, @@from@@, @@to1@@, and
+   (license license:expat)))
-@@from1@@ methods have multiplicity-polymorphic types, allowing them to be used
+
-with either traditional Haskell code or linearly typed code. .  2.  The
+(define ghc-generic-lens
-representations used for @@Generic1@@ are modified slightly.  As a result,
+  (package
-@@to1@@ and @@from1@@ never need to use @@fmap@@.  This can
+   (name "ghc-generic-lens")
-<https://gitlab.haskell.org/ghc/ghc/-/issues/15969 greatly improve performance>,
+   (version "2.2.2.0")
-and it is <https://github.com/tweag/linear-base/pull/316 necessary to support
+   (source (origin
-multiplicity polymorphism>.  A smaller change, approximately
+             (method url-fetch)
-<https://gitlab.haskell.org/ghc/ghc/-/issues/7492 as proposed by spl>, reduces
+             (uri (hackage-uri "generic-lens" version))
-the number of instances that must be written to actually use @@Generic1@@ for
+             (sha256
-deriving instances of other classes. .  For more details, see the
+              (base32
-\"Generics.Linear\" documentation. .  The implementation is based on the
+               "0s4b51s11ssmndmx9m9zbwgv9rb27ajwihsrk10hn582rp4ck3c6"))))
-@@generic-deriving@@ package, first described in the paper . * /A generic
+   (build-system haskell-build-system)
-deriving mechanism for Haskell/.  Jose Pedro Magalhaes, Atze Dijkstra, Johan
+   (properties '((upstream-name . "generic-lens")))
-Jeuring, and Andres Loeh.  Haskell'10. .  This library is organized as follows:
+   (inputs (list ghc-generic-lens-core ghc-profunctors))
-. * \"Generics.Linear\" defines the core functionality for generics, including the
+   (native-inputs (list ghc-lens
-multiplicity-polymorphic @@Generic(1)@@ classes and a replacement for the
+                        ghc-inspection-testing
-@@:.:@@ composition type. . * \"Generics.Linear.TH\" implements Template Haskell
+                        ghc-hunit
-functionality for deriving instances of @@Generic(1)@@. . *
+                        ghc-lens
-\"Generics.Linear.Unsafe.@code{ViaGHCGenerics}\" offers @code{@@DerivingVia}@@
+                        ghc-hunit
-targets to derive @@Generic@@ and @@Generic1@@ instances from
+                        ghc-lens
-@@\"GHC.Generics\".'GHC.Generics.Generic'@@.  Because these instances necessarily
+                        ghc-hunit
-use unsafe coercions, their use will likely inhibit full optimization of code
+                        ghc-doctest
-using them. .  Educational code: the educational modules exported by
+                        ghc-lens))
-<https://hackage.haskell.org/package/generic-deriving generic-deriving> have
+   (home-page "https://github.com/kcsongor/generic-lens")
-been copied into the @@tests\\/Generic\\/Deriving@@ directory in this repository,
+   (synopsis "Generically derive traversals, lenses and prisms.")
-with the very few modifications required to accommodate the differences between
+   (description
-the @@Generic1@@ representations here and in @@base@@.  All the same caveats
+    "This library uses GHC.Generics to derive efficient optics (traversals, lenses
-apply as in the originals; see that package's @@README@@.")
+and prisms) for algebraic data types in a type-directed way, with a focus on
+good type inference and error messages when possible.  The library exposes a
+van Laarhoven interface.  For an alternative interface, supporting an opaque
+optic type, see @@<https://hackage.haskell.org/package/generic-optics
+generic-optics>@@.")
    (license license:bsd-3)))
 
 (define ghc-one-liner
   (package
    (name "ghc-one-liner")
    (version "2.1")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
              (uri (hackage-uri "one-liner" version))
              (sha256
-        (base32 "09gdivd38disddxs42179vmgca0yzk5dfm6ygicgl5l25qbizrfh"))))
+              (base32
+               "09gdivd38disddxs42179vmgca0yzk5dfm6ygicgl5l25qbizrfh"))))
    (build-system haskell-build-system)
    (properties '((upstream-name . "one-liner")))
    (inputs (list ghc-contravariant ghc-bifunctors ghc-profunctors ghc-tagged
@@ -369,16 +351,155 @@ apply as in the originals; see that package's @@README@@.")
 particularly useful for writing default implementations of type class methods.")
    (license license:bsd-3)))
 
+(define ghc-generic-lens-core
+  (package
+   (name "ghc-generic-lens-core")
+   (version "2.2.1.0")
+   (source (origin
+             (method url-fetch)
+             (uri (hackage-uri "generic-lens-core" version))
+             (sha256
+              (base32
+               "08i4c9yb6z84iknrnl9f3f343121j7ilp0a679v81nsjm9xz3rlf"))))
+   (build-system haskell-build-system)
+   (properties '((upstream-name . "generic-lens-core")))
+   (inputs (list ghc-indexed-profunctors))
+   (arguments
+    `(#:cabal-revision ("1"
+                        "1dbjhd6k7ypqa9f4h9v2xndgb4mjhfli3n1vjm8r8ga0kfndbqfn")))
+   (home-page "https://github.com/kcsongor/generic-lens")
+   (synopsis "Generically derive traversals, lenses and prisms.")
+   (description
+    "This library uses GHC.Generics to derive efficient optics (traversals, lenses
+and prisms) for algebraic data types in a type-directed way, with a focus on
+good type inference and error messages when possible.  This package is the
+shared internal logic of the @@<https://hackage.haskell.org/package/generic-lens
+generic-lens>@@ and @@<https://hackage.haskell.org/package/generic-optics
+generic-optics>@@ libraries.")
+   (license license:bsd-3)))
+
+(define ghc-indexed-profunctors
+  (package
+   (name "ghc-indexed-profunctors")
+   (version "0.1.1")
+   (source (origin
+             (method url-fetch)
+             (uri (hackage-uri "indexed-profunctors" version))
+             (sha256
+              (base32
+               "1cbccbvrx73drr1jf3yyw0rp1mcfv3jc1rvdcby5xxx4ja543fjs"))))
+   (build-system haskell-build-system)
+   (properties '((upstream-name . "indexed-profunctors")))
+   (home-page "http://hackage.haskell.org/package/indexed-profunctors")
+   (synopsis "Utilities for indexed profunctors")
+   (description
+    "This package contains basic definitions related to indexed profunctors.  These
+are primarily intended as internal utilities to support the @@optics@@ and
+@@generic-lens@@ package families.")
+   (license license:bsd-3)))
+
+(define ghc-linear-base
+  (package
+   (name "ghc-linear-base")
+   (version "0.3.1")
+   (source (origin
+             (method url-fetch)
+             (uri (hackage-uri "linear-base" version))
+             (sha256
+              (base32
+               "1gm8bwyi39x5x29xb6nq13x9x9p30vm29s11k4pkcql70sj4pv0h"))))
+   (build-system haskell-build-system)
+   (properties '((upstream-name . "linear-base")))
+   (inputs (list ghc-hashable ghc-linear-generics ghc-storable-tuple ghc-vector
+                 ghc-primitive))
+   (native-inputs (list ghc-inspection-testing
+                        ghc-tasty-inspection-testing
+                        ghc-hedgehog
+                        ghc-tasty
+                        ghc-tasty-hedgehog
+                        ghc-mmorph
+                        ghc-tasty
+                        ghc-tasty-hedgehog
+                        ghc-hedgehog))
+   (arguments
+    `(#:cabal-revision ("1"
+                        "153nkw2i7n22xzfj8q2xmzsh77pr7pay8v3gc1xli491qmsc0fcd")))
+   (home-page "https://github.com/tweag/linear-base#README")
+   (synopsis "Standard library for linear types.")
+   (description "Please see README.md.")
+   (license license:expat)))
+
+(define ghc-linear-generics
+  (package
+   (name "ghc-linear-generics")
+   (version "0.2.2")
+   (source (origin
+             (method url-fetch)
+             (uri (hackage-uri "linear-generics" version))
+             (sha256
+              (base32
+               "0ls571qzayky0dax9d209lw9wv344z3969daqcsncv0r5rlvlps9"))))
+   (build-system haskell-build-system)
+   (properties '((upstream-name . "linear-generics")))
+   (inputs (list ghc-th-abstraction-0.5))
+   (native-inputs (list ghc-hspec hspec-discover))
+   (home-page "https://github.com/linear-generics/linear-generics")
+   (synopsis "Generic programming library for generalised deriving.")
+   (description
+    "This package offers a version of
+<https://hackage.haskell.org/package/base/docs/GHC-Generics.html GHC.Generics>
+with two important improvements:  1. The @@to@@, @@from@@, @@to1@@, and
+@@from1@@ methods have multiplicity-polymorphic types, allowing them to be used
+with either traditional Haskell code or linearly typed code.  2. The
+representations used for @@Generic1@@ are modified slightly.")
+   (license license:bsd-3)))
+
+(define ghc-th-abstraction-0.5
+  (package
+   (inherit ghc-th-abstraction)
+   (version "0.5.0.0")
+   (source (origin
+            (method url-fetch)
+            (uri (hackage-uri "th-abstraction" version))
+            (sha256
+             (base32
+              "0r4ri85283i1jjhd94wa9nps6cd9a8mh6rr4ds1gb2hqnwxdqn42"))))))
+
+(define ghc-filestore
+  (package
+   (name "ghc-filestore")
+   (version "0.6.5")
+   (source (origin
+             (method url-fetch)
+             (uri (hackage-uri "filestore" version))
+             (sha256
+              (base32
+               "0z29273vdqjsrj4vby0gp7d12wg9nkzq9zgqg18db0p5948jw1dh"))))
+   (build-system haskell-build-system)
+   (properties '((upstream-name . "filestore")))
+   (inputs (list ghc-utf8-string ghc-xml ghc-split ghc-diff ghc-old-locale git mercurial))
+   (native-inputs (list ghc-hunit))
+   (arguments
+    `(#:cabal-revision ("1"
+                        "1v9xqm0112knv6za05qf310ldndrc0h3xhajgwjaycbzkrknz4n7")))
+   (home-page "http://hackage.haskell.org/package/filestore")
+   (synopsis "Interface for versioning file stores.")
+   (description
+    "The filestore library provides an abstract interface for a versioning file
+store, and modules that instantiate this interface.  Currently Git, Darcs, and
+Mercurial modules are provided, and other VCSs or databases could be added.")
+   (license license:bsd-3)))
+
 (define ghc-purebred-email
   (package
    (name "ghc-purebred-email")
-    (version "0.7")
+   (version "0.6.0.1")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
              (uri (hackage-uri "purebred-email" version))
              (sha256
-        (base32 "1rw72rjji7bclql975gqpbisapjgzzywydql6p6b1v0ivzpsaq3s"))))
+               (base32
+                 "0gdzdbxgsyps8hqd903bsyja0cr6kbklkicvma62q48wv0y7230j"))))
    (build-system haskell-build-system)
    (properties '((upstream-name . "purebred-email")))
    (inputs (list ghc-attoparsec
@@ -412,110 +533,48 @@ and forward/bounce - Content transfer and charset decoding/encoding - MIME
 message header extensions for non-ASCII text
 (<https://tools.ietf.org/html/rfc2047 RFC 2047>) - MIME parameter value and
 encoded word extensions (<https://tools.ietf.org/html/rfc2231 RFC 2231>) -
-@@Content-Disposition@@ header field (<https://tools.ietf.org/html/rfc2183 RFC
+@@Content-Disposition@@ header field (<https://tools.ietf.org/html/rfc2183 RFC 2183>) - Address syntax in @@From@@ and @@Sender@@ fields
-2183>) - Address syntax in @@From@@ and @@Sender@@ fields
+     (<https://tools.ietf.org/html/rfc6854 RFC 6854>)")
-(<https://tools.ietf.org/html/rfc6854 RFC 6854>) - @@Author@@ header field
-(<https://tools.ietf.org/html/rfc9057 RFC 9057>).")
      (license license:agpl3+)))
 
-(define ghc-safecopy
+(define ghc-concise
   (package
-    (name "ghc-safecopy")
+   (name "ghc-concise")
-    (version "0.10.4.3")
+   (version "0.1.0.1")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
-       (uri (hackage-uri "safecopy" version))
+             (uri (hackage-uri "concise" version))
              (sha256
-        (base32 "03hkb4znm7jaszz290hqal3zbmw3606gafrbdxrvlcfkrpg1m71c"))))
+               (base32
+                 "09crgc6gjfidlad6263253xx1di6wfhc9awhira21s0z7rddy9sw"))))
    (build-system haskell-build-system)
-    (properties '((upstream-name . "safecopy")))
+   (properties '((upstream-name . "concise")))
-    (inputs (list ghc-cereal ghc-generic-data ghc-old-time ghc-vector))
+   (inputs (list ghc-lens))
-    (native-inputs (list ghc-lens ghc-lens-action ghc-tasty
+   (native-inputs (list ghc-tasty ghc-tasty-quickcheck ghc-quickcheck
-                         ghc-tasty-quickcheck ghc-hunit))
+                        ghc-quickcheck-instances))
-    (home-page "https://github.com/acid-state/safecopy")
+   (home-page "https://github.com/frasertweedale/hs-concise")
-    (synopsis "Binary serialization with version control.")
+   (synopsis "Utilities for Control.Lens.Cons")
    (description
-     "An extension to Data.Serialize with built-in version control.")
+     "concise provides a handful of functions to extend what you can do with
-    (license license:public-domain)))
+ Control.Lens.Cons.")
-
-(define 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 hspec-discover
-                         ghc-async
-                         ghc-hspec
-                         ghc-hspec-wai
-                         ghc-lifted-base
-                         ghc-doctest
-                         ghc-http-client))
-    (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. . @@ &#123;-&#35; LANGUAGE @code{OverloadedStrings} &#35;-&#125; .
- import Web.Scotty .  main = scotty 3000 $ &#32;&#32;get &#34;/:word&#34; $ do
-&#32;&#32;&#32;&#32;beam <- @code{pathParam} &#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-show-combinators
+(define ghc-exit-codes
   (package
-    (name "ghc-show-combinators")
+   (name "ghc-exit-codes")
-    (version "0.2.0.0")
+   (version "1.0.0")
-    (source
+   (source (origin
-     (origin
              (method url-fetch)
-       (uri (hackage-uri "show-combinators" version))
+             (uri (hackage-uri "exit-codes" version))
              (sha256
-        (base32 "07ds87ldl9165hj3k5h84iawc6vqlbggni3dg1nhbxww1spxn0n9"))))
+               (base32
+                 "00cyli96zkyqhjr3lqzrislqyk72xwm2dcqvjagklidh32d4k8ja"))))
    (build-system haskell-build-system)
-    (properties '((upstream-name . "show-combinators")))
+   (properties '((upstream-name . "exit-codes")))
-    (arguments
+   (home-page "http://github.com/JustusAdam/exit-codes")
-     `(#:cabal-revision ("2"
+   (synopsis "Exit codes as defined by BSD")
-                         "0n3xlpm41wpw1ybmacg9s7150nx00qrdlw2rq4fzz7iw7333cyjx")))
-    (home-page "https://github.com/Lysxia/show-combinators#readme")
-    (synopsis "Combinators to write Show instances")
    (description
-     "This package provides a minimal pretty-printing library for Show instances in
+     "Expose the exit codes defined by BSD in sysexits.h to the Haskell world.")
-Haskell.")
+   (license license:bsd-3)))
-    (license license:expat)))
 
 tiedote-md

.guix/modules/tiedote-md-service.scm

@@ -30,7 +30,7 @@ the tiedote.md user on this system.")
   (sendmail-path
     (string "/run/privileged/bin/sendmail")
     "Path to a sendmail compatible mailing executable.")
-  (webhook-port
+  (port
     (integer 3000)
     "Port to listen on for webhook notifications.")
   (socket-path
@@ -54,36 +54,10 @@ the tiedote.md user on this system.")
             (home-directory state-directory)
             (shell (file-append bash-minimal "/bin/bash"))))))
 
-(define (make-tiedote.md-server-script config)
-  (match-record config <tiedote.md-configuration>
-    (socket-path email-address sender-name webhook-port sendmail-path
-     remote-branch remote-url state-directory)
-    (program-file "tiedote.md-server"
-                  #~(begin
-                      ; use utf8 before starting tiedote.md to be able to pass utf characters as arguments
-                      (setlocale LC_ALL "C.UTF-8")
-                      ; use utf8 after exec so that ghc text library doesn't crash from IO
-                      (setenv "LANG" "C.UTF-8")
-                      (let ((tiedote.md #$(file-append tiedote-md "/bin/tiedote.md"))
-                            (repo-path (string-append #$state-directory "/git-repo")))
-                        (apply execl
-                               `(,tiedote.md
-                                 ,tiedote.md
-                                 "--address" #$email-address
-                                 "--sender-name" #$sender-name
-                                 "--sendmail" #$sendmail-path
-                                 "--socket" #$socket-path
-                                 "server"
-                                 "--repository" ,repo-path
-                                 "--port" #$(number->string webhook-port)
-                                 "--remote-url" #$remote-url
-                                 ,@(if #$(maybe-value-set? remote-branch)
-                                     (list "--remote-branch" #$remote-branch)
-                                     '()))))))))
-
 (define (tiedote.md-shepherd-service config)
   (match-record config <tiedote.md-configuration>
-    (state-directory socket-path)
+    (state-directory socket-path email-address sender-name port sendmail-path
+     remote-branch remote-url)
     (list (shepherd-service
             (documentation "A simple mass email system")
             (requirement '(networking user-processes))
@@ -91,46 +65,48 @@ the tiedote.md user on this system.")
             (start #~(let* ((user (getpw "tiedote.md"))
                             (uid (passwd:uid user))
                             (gid (passwd:gid user))
-                            (socket-directory (dirname #$socket-path)))
+                            (socket-directory (dirname #$socket-path))
+                            (repo-path (string-append #$state-directory "/git-repo")))
                        (begin
                          (mkdir-p socket-directory)
                          (chown socket-directory uid gid)
-                         (make-forkexec-constructor (list #$(make-tiedote.md-server-script config))
+                         (make-forkexec-constructor
+                          (list #$(file-append tiedote-md "/bin/tiedote.md")
+                            "--address" #$email-address
+                            "--sender-name" #$sender-name
+                            "--sendmail" #$sendmail-path
+                            "--socket" #$socket-path
+                            "server"
+                            "--repository" repo-path
+                            "--port" #$(number->string port)
+                            "--remote-url" #$remote-url
+                            ;,@(if #$(maybe-value-set? remote-branch)
+                            ;    (list "--remote-branch" #$remote-branch)
+                            ;    '())
+                            )
                           #:user "tiedote.md"
                           #:group "tiedote.md"
-                                                    #:environment-variables
+                          #:environment (cons "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
-                                                    (cons* "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
+                                              (default-environment-variable))
-                                                           (default-environment-variables))
                           #:directory #$state-directory))))
             (stop #~(make-kill-destructor))))))
 
 (define (tiedote.md-activation config)
   (match-record config <tiedote.md-configuration>
     (state-directory email-address sender-name sendmail-path socket-path)
-    (let* ((tiedote.md (file-append tiedote-md "/bin/tiedote.md"))
+    (let* ((receive-exec (list (file-append tiedote-md "/bin/tiedote.md") ; file to exec
-           (receive-exec (list tiedote.md ; file to exec
+                               (file-append tiedote-md "/bin/tiedote.md") ; arg $0
-                               tiedote.md ; arg $0
                                "--address" email-address
                                "--sender-name" sender-name
                                "--sendmail" sendmail-path
-                               "--socket" socket-path
+                               "--socket" socket-path))
-                               "receive"))
            (receive-script (program-file "tiedote.md-receive"
-                                         #~(begin
+                                         #~(apply execl #$receive-exec)))
-                                             (setlocale LC_ALL "C.UTF-8")
-                                             (setenv "LANG" "C.UTF-8")
-                                             (apply execl '#$receive-exec))))
            (forward-file (mixed-text-file "dot-forward" "|" receive-script)))
-      #~(let* ((.forward (string-append #$state-directory "/.forward"))
+      #~(let ((.forward (string-append #$state-directory "/.forward")))
-               (user (getpw "tiedote.md"))
-               (uid (passwd:uid user))
-               (gid (passwd:gid user)))
           (if (file-exists? .forward)
             (delete-file .forward))
-          ; smtpd does not follow symbolic links and requires .forward files to
+          (symlink #$forward-file .forward)))))
-          ; be owned by the recipient
-          (copy-file #$forward-file .forward)
-          (chown .forward uid gid)))))
 
 (define tiedote.md-service-type
   (service-type

.guix/patches/ghc-doclayout-add-lift-instance.patch

@@ -1,149 +0,0 @@
-From 8179aba8aa35ac3fa518a2a398b0f66b67092433 Mon Sep 17 00:00:00 2001
-From: Saku Laesvuori <saku@laesvuori.fi>
-Date: Wed, 5 Aug 2026 10:28:41 +0300
-Subject: [PATCH] Add Template Haskell Lift instance for Doc
-
----
- doclayout.cabal                  |  1 +
- src/Text/DocLayout.hs            |  4 +++-
- src/Text/DocLayout/ANSIFont.hs   | 20 +++++++++++---------
- src/Text/DocLayout/Attributed.hs |  6 ++++--
- 4 files changed, 19 insertions(+), 12 deletions(-)
-
-diff --git a/doclayout.cabal b/doclayout.cabal
-index 83ad188..ff3b545 100644
---- a/doclayout.cabal
-+++ b/doclayout.cabal
-@@ -32,6 +32,7 @@ library
-                        containers,
-                        emojis >=0.1.2,
-                        mtl,
-+                       template-haskell-lift,
-                        safe
-   default-language:    Haskell2010
-   ghc-options:         -Wall -fno-warn-unused-do-bind
-diff --git a/src/Text/DocLayout.hs b/src/Text/DocLayout.hs
-index d4ff1b3..7c252df 100644
---- a/src/Text/DocLayout.hs
-+++ b/src/Text/DocLayout.hs
-@@ -4,6 +4,7 @@
- {-# LANGUAGE DeriveFoldable     #-}
- {-# LANGUAGE DeriveFunctor      #-}
- {-# LANGUAGE DeriveGeneric      #-}
-+{-# LANGUAGE DeriveLift         #-}
- {-# LANGUAGE DeriveTraversable  #-}
- {-# LANGUAGE FlexibleInstances  #-}
- {-# LANGUAGE LambdaCase         #-}
-@@ -127,6 +128,7 @@ import qualified Data.Text as T
- import Data.Text (Text)
- import qualified Data.Text.Lazy as TL
- import qualified Data.Text.Lazy.Builder as B
-+import Language.Haskell.TH.Lift (Lift)
- import Text.DocLayout.HasChars
- import Text.DocLayout.ANSIFont
- import Text.DocLayout.Attributed
-@@ -159,7 +161,7 @@ data Doc a = Text Int a            -- ^ Text with specified width.
-          | Linked Text (Doc a)       -- ^ A hyperlink
-          | Empty
-          deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,
--                  Data, Typeable, Generic)
-+                  Data, Typeable, Generic, Lift)
- 
- 
- instance Semigroup (Doc a) where
-diff --git a/src/Text/DocLayout/ANSIFont.hs b/src/Text/DocLayout/ANSIFont.hs
-index b952d0b..7002f92 100644
---- a/src/Text/DocLayout/ANSIFont.hs
-+++ b/src/Text/DocLayout/ANSIFont.hs
-@@ -1,5 +1,6 @@
- {-# LANGUAGE OverloadedStrings  #-}
- {-# LANGUAGE DeriveDataTypeable #-}
-+{-# LANGUAGE DeriveLift         #-}
- module Text.DocLayout.ANSIFont
-   ( Font(..)
-   , baseFont
-@@ -17,6 +18,7 @@ module Text.DocLayout.ANSIFont
-   ) where
- 
- import Data.Data (Data)
-+import Language.Haskell.TH.Lift (Lift)
- import Data.String
- import Data.Text (Text)
- 
-@@ -29,18 +31,18 @@ data Font = Font
-     ftBackground :: Background,
-     ftLink :: Maybe Text
-   }
--  deriving (Show, Eq, Read, Data, Ord)
-+  deriving (Show, Eq, Read, Data, Ord, Lift)
- 
- baseFont :: Font
- baseFont = Font Normal Roman ULNone Unstruck FGDefault BGDefault Nothing
- 
--data Weight = Normal | Bold deriving (Show, Eq, Read, Data, Ord)
--data Shape = Roman | Italic deriving (Show, Eq, Read, Data, Ord)
--data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Show, Eq, Enum, Read, Data, Ord)
--data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Show, Eq, Read, Data, Ord)
--data Strikeout = Unstruck | Struck deriving (Show, Eq, Read, Data, Ord)
--data Foreground = FGDefault | FG Color8 deriving (Show, Eq, Read, Data, Ord)
--data Background = BGDefault | BG Color8 deriving (Show, Eq, Read, Data, Ord)
-+data Weight = Normal | Bold deriving (Show, Eq, Read, Data, Ord, Lift)
-+data Shape = Roman | Italic deriving (Show, Eq, Read, Data, Ord, Lift)
-+data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Show, Eq, Enum, Read, Data, Ord, Lift)
-+data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Show, Eq, Read, Data, Ord, Lift)
-+data Strikeout = Unstruck | Struck deriving (Show, Eq, Read, Data, Ord, Lift)
-+data Foreground = FGDefault | FG Color8 deriving (Show, Eq, Read, Data, Ord, Lift)
-+data Background = BGDefault | BG Color8 deriving (Show, Eq, Read, Data, Ord, Lift)
- 
- data StyleReq
-   = RWeight Weight
-@@ -49,7 +51,7 @@ data StyleReq
-   | RBackground Background
-   | RUnderline Underline
-   | RStrikeout Strikeout
--  deriving (Show, Eq, Read, Data, Ord)
-+  deriving (Show, Eq, Read, Data, Ord, Lift)
- 
- (~>) :: Font -> StyleReq -> Font
- (~>) f (RWeight w) = f{ftWeight = w}
-diff --git a/src/Text/DocLayout/Attributed.hs b/src/Text/DocLayout/Attributed.hs
-index 46574a1..24124c3 100644
---- a/src/Text/DocLayout/Attributed.hs
-+++ b/src/Text/DocLayout/Attributed.hs
-@@ -1,4 +1,5 @@
- {-# LANGUAGE DeriveGeneric      #-}
-+{-# LANGUAGE DeriveLift         #-}
- {-# LANGUAGE DeriveTraversable  #-}
- {-# LANGUAGE DeriveDataTypeable #-}
- {-# LANGUAGE FlexibleInstances #-}
-@@ -9,6 +10,7 @@ import Data.String
- import Text.DocLayout.ANSIFont (Font, baseFont)
- import Data.Data (Data, Typeable)
- import GHC.Generics
-+import Language.Haskell.TH.Lift (Lift)
- import Data.Sequence ((><))
- import qualified Data.Sequence as S
- import Data.Text (Text)
-@@ -18,7 +20,7 @@ type Link = Maybe Text
- -- | Font attributes.
- data Attr a = Attr Link Font a
-   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,
--    Data, Typeable, Generic)
-+    Data, Typeable, Generic, Lift)
- 
- instance Semigroup a => Semigroup (Attr a) where
-   (<>) (Attr l f x) (Attr _ _ y) = Attr l f $ x <> y  -- This is arbitrary
-@@ -29,7 +31,7 @@ instance (IsString a, Monoid a) => Monoid (Attr a) where
- -- | A sequence of strings with font attributes.
- newtype Attributed a = Attributed (S.Seq (Attr a))
-   deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,
--         Data, Typeable, Generic)
-+         Data, Typeable, Generic, Lift)
- 
- fromList :: [Attr a] -> Attributed a
- fromList = Attributed . S.fromList
-
-base-commit: aa2e9d853b7c26f49d3b540f7ca0625e612503ce
--- 
-2.54.0
-

README.md

@@ -41,7 +41,9 @@ lähettämisestä ja Git-tietovaraston päivittämisestä, kun se saa muutoksist
 ilmoituksen HTTP POST -pyyntönä (esim. Git-palvelun webhookista).
 
 Palvelimen voi käynnistää komennolla `tiedote.md server`. Mahdolliset asetukset
-saa listattua lisäämällä komentoon `--help` valitsimen.
+saa listattua lisäämällä komentoon `--help` valitsimen. `--address`
+valitsimesta tulee huomata, että osoitteessa voi käyttää vain ASCII-merkkejä
+(ks. [#15](https://git.olarinmaensamoojat.fi/OMS/tiedote.md/issues/15)).
 
 Sähköpostin lähettämiseen tarvitaan `sendmail`-yhteensopiva MTA (mail transfer
 agent, sähköpostin välitysohjelma), jollaisen useimmat sähköpostipalvelimet

channels.scm

@@ -3,7 +3,7 @@
         (url "https://git.savannah.gnu.org/git/guix.git")
         (branch "master")
         (commit
-          "86813d5779253bb50002d79ab791eeda5a8b4729")
+          "a6fc564bcc32ba599fc701f340c2d59c47bb225b")
         (introduction
           (make-channel-introduction
             "9edb3f66fd807b096b48283debdcddccfea34bad"

src/Main.hs

@@ -22,7 +22,7 @@ import System.Directory (findExecutable)
 import System.Exit (exitWith)
 import System.Exit.Codes (codeTempFail)
 import System.Posix.User (getRealUserID, userName, getUserEntryForID)
-import Web.Scotty (scotty, post, liftIO, defaultHandler, Handler(Handler), ScottyException)
+import Web.Scotty (scotty, post, liftAndCatchIO, defaultHandler)
 
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.IO as LT
@@ -41,8 +41,8 @@ serverMain socket mail repoPath origin sendmailPath checkpointDelay port = do
     _ <- forkIO $ acidServerSockAddr skipAuthenticationCheck socket acid
     queueMessages acid
     _ <- forkIO $ scotty port $ do
-        defaultHandler $ Handler $ liftIO . (print :: ScottyException -> IO ())
+        defaultHandler $ liftAndCatchIO . LT.putStrLn -- Don't return exceptions to clients
-        post "/" $ liftIO $ void $ forkIO $ updateMessages acid repoPath origin
+        post "/" $ liftAndCatchIO $ void $ forkIO $ updateMessages acid repoPath origin
     updateMessages acid repoPath origin
     _ <- forkIO $ manageQueueingMessages acid
     _ <- forkIO $ managePreviews acid mail sendmailPath

src/TiedoteMD/Read.hs

@@ -18,7 +18,6 @@ import Data.Bifunctor (first, second)
 import Data.ByteArray (convert)
 import Data.ByteString (ByteString)
 import "base64" Data.ByteString.Base64.URL
-import Data.Base64.Types (extractBase64)
 import Data.Default (def)
 import Data.Either (rights, lefts, fromRight)
 import Data.FileStore (FileStore(..), Revision(..), FileStoreError(..), gitFileStore)
@@ -129,7 +128,7 @@ readMessageFile store file = retrieve store file Nothing >>=
 cidOf :: MediaItem -> ContentID
 cidOf MediaItem {mediaContents, mediaMimeType} =
     fromRight (error "makeContentID failed with valid input!") $
-        makeContentID $ "<" <> extractBase64 encodedHash <> "@tiedote.md.sha256>"
+        makeContentID $ "<" <> encodedHash <> "@tiedote.md.sha256>"
             where encodedHash = encodeBase64' $ convert $ hashWith SHA256 $
                       LBS.toStrict mediaContents <> encodeUtf8 mediaMimeType
 

src/TiedoteMD/Review.hs

@@ -103,11 +103,8 @@ parseEmail = first (EmailParseError . T.pack) . parse (message mime)
 
 getEmailsFromMessage :: MIMEMessage -> [Email]
 getEmailsFromMessage = readEmails . toListOf
-    (entities . transferDecoded' . _Right . charsetText' defaultCharsets . _Right)
+    (entities . filtered isText . transferDecoded' . _Right . charsetText' defaultCharsets . _Right)
-    -- Windows is broken and reports text/csv as application/vnd.ms-excel...
+    where isText = matchContentType "text" Nothing . view contentType
-    -- Purebred-email tries to decode non-text entities as utf-8 which should
-    -- work in this case. It is unlikely that any entity would accidentally
-    -- contain enough valid addresses on their own lines to fool readEmails.
 
 readEmails :: [T.Text] -> [Email]
 readEmails = fromMaybe [] . listToMaybe . reverse . sortBy (comparing length) .

src/TiedoteMD/Send.hs

@@ -4,6 +4,7 @@
 module TiedoteMD.Send where
 
 import Control.Concurrent (threadDelay)
+import Control.Exception (throwIO)
 import Control.Lens (set, _Just)
 import Control.Monad (forever, unless)
 import Data.Acid (AcidState, query, update)
@@ -14,7 +15,8 @@ import Data.MIME.Charset (defaultCharsets)
 import Data.Set (Set)
 import Data.Time (getCurrentTime)
 import System.Exit (ExitCode(..))
-import System.IO (hClose, stdout, stderr)
+import System.Exit.Codes (codeTempFail)
+import System.IO (hClose, stdout)
 import System.Process (CreateProcess(..), StdStream(..), waitForProcess, createProcess, proc)
 import System.Random (getStdRandom, uniform)
 
@@ -23,25 +25,18 @@ import qualified Data.IMF as IMF
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Set as Set
 import qualified Data.Text as T
-import qualified Data.Text.IO as T
 
 import TiedoteMD.State
 import TiedoteMD.Types
 
 sendmail :: FilePath -> LBS.ByteString -> IO ()
 sendmail path bs = do
-    (Just stdin, _, Just stderr, processHandle) <- createProcess
+    (Just stdin, _, _, processHandle) <- createProcess (proc path ["-t"]) {std_in = CreatePipe}
-        (proc path ["-t"]) {std_in = CreatePipe, std_err = CreatePipe}
     LBS.hPut stdin bs
     hClose stdin
-    errors <- T.hGetContents stderr
     exitCode <- waitForProcess processHandle 
-    -- TODO: handle System.Exit.Codes.codeTempFail differently from other failures
+    unless (exitCode `elem` [ExitSuccess, codeTempFail]) $
-    unless (exitCode == ExitSuccess) $ do
+        throwIO $ ProcessError (T.pack path) exitCode
-        T.hPutStr System.IO.stderr $
-            "Sending mail with " <> (T.pack path) <> " failed with " <> (T.pack $ show exitCode)
-        unless (T.null errors) $ T.hPutStrLn System.IO.stderr $ ":\n" <> errors
-        T.hPutStrLn System.IO.stderr ""
 
 manageQueue :: AcidState State -> Mailbox -> FilePath -> IO ()
 manageQueue acid sender sendmailPath = forever $ do

src/TiedoteMD/Templates/TH.hs

@@ -8,6 +8,7 @@ module TiedoteMD.Templates.TH where
 import Control.Exception (throwIO)
 import Data.FileEmbed
 import Language.Haskell.TH.Syntax (Q, Exp, Lift, runIO, lift, Quasi(qAddDependentFile))
+import Text.DocLayout (Doc(..))
 import Text.DocTemplates.Internal (Variable(..), Pipe(..), Alignment(..), Border(..), Template(..))
 import Text.Pandoc (compileTemplate)
 
@@ -16,6 +17,7 @@ import qualified Data.Text.IO as T
 
 import TiedoteMD.Types
 
+deriving instance Lift (Doc T.Text)
 deriving instance Lift (Template T.Text)
 deriving instance Lift Alignment
 deriving instance Lift Border

tiedote-md.cabal

@@ -1,6 +1,6 @@
 cabal-version: 3.6
 name: tiedote-md
-version: 0.0.2
+version: 0.0.1
 author: Saku Laesvuori
 maintainer: saku@laesvuori.fi
 bug-reports: https://git.olarinmaensamoojat.fi/OMS/tiedote.md/issues
@@ -30,7 +30,7 @@ executable tiedote.md
     bytestring,
     case-insensitive,
     containers,
-    crypton,
+    cryptonite,
     data-default,
     directory,
     doclayout,
@@ -67,6 +67,7 @@ executable tiedote.md
     TiedoteMD.Send
     TiedoteMD.State
     TiedoteMD.Templates
+    TiedoteMD.Templates
     TiedoteMD.Templates.TH
     TiedoteMD.Types
   hs-source-dirs: src