From fd9985484bab9ec6948ce64e9260164d903a9cd6 Mon Sep 17 00:00:00 2001 From: Malte Brandy Date: Tue, 26 Jan 2021 01:59:59 +0100 Subject: [PATCH] Activate synapse-cleanup --- nixos/machines/hera/configuration.nix | 2 +- .../default.nix} | 31 ++++- nixos/roles/matrix-synapse/synapse-cleanup.hs | 125 ++++++++++++++++++ overlays/30-ghc.nix | 2 +- 4 files changed, 153 insertions(+), 7 deletions(-) rename nixos/roles/{matrix-synapse.nix => matrix-synapse/default.nix} (79%) create mode 100644 nixos/roles/matrix-synapse/synapse-cleanup.hs diff --git a/nixos/machines/hera/configuration.nix b/nixos/machines/hera/configuration.nix index 3f613c1a..3c4a5c74 100644 --- a/nixos/machines/hera/configuration.nix +++ b/nixos/machines/hera/configuration.nix @@ -15,7 +15,7 @@ in { ../../roles/monitoring ../../roles/blog.nix ../../roles/email2matrix.nix - ../../roles/matrix-synapse.nix + ../../roles/matrix-synapse ../../roles/coturn.nix ../../roles/go-neb.nix ../../roles/laminar diff --git a/nixos/roles/matrix-synapse.nix b/nixos/roles/matrix-synapse/default.nix similarity index 79% rename from nixos/roles/matrix-synapse.nix rename to nixos/roles/matrix-synapse/default.nix index a1ef0196..f7cdd0a7 100644 --- a/nixos/roles/matrix-synapse.nix +++ b/nixos/roles/matrix-synapse/default.nix @@ -3,6 +3,20 @@ let server_name = "maralorn.de"; hostName = "matrix.${server_name}"; in { + systemd.services."matrix-cleanup" = { + serviceConfig = { + ExecStart = pkgs.writeHaskell "matrix-cleanup" { + libraries = builtins.attrValues pkgs.myHaskellScriptPackages ++ [ + pkgs.haskellPackages.postgresql-simple + pkgs.haskellPackages.HTTP + ]; + ghcArgs = [ "-threaded" ]; + } (builtins.readFile ./synapse-cleanup.hs); + User = "matrix-synapse"; + Type = "oneshot"; + }; + startAt = "06:00"; + }; services = { nginx = { enable = true; @@ -59,11 +73,18 @@ in { dynamic_thumbnails = true; turn_shared_secret = config.services.coturn.static-auth-secret; turn_uris = let - turns = - "turns:${config.services.coturn.realm}:${toString config.services.coturn.tls-listening-port}"; - turn = - "turn:${config.services.coturn.realm}:${toString config.services.coturn.listening-port}"; - in [ "${turns}?transport=udp" "${turns}?transport=tcp" "${turn}?transport=udp" "${turn}?transport=tcp" ]; + turns = "turns:${config.services.coturn.realm}:${ + toString config.services.coturn.tls-listening-port + }"; + turn = "turn:${config.services.coturn.realm}:${ + toString config.services.coturn.listening-port + }"; + in [ + "${turns}?transport=udp" + "${turns}?transport=tcp" + "${turn}?transport=udp" + "${turn}?transport=tcp" + ]; turn_user_lifetime = "24h"; allow_guest_access = true; logConfig = '' diff --git a/nixos/roles/matrix-synapse/synapse-cleanup.hs b/nixos/roles/matrix-synapse/synapse-cleanup.hs new file mode 100644 index 00000000..e82a2978 --- /dev/null +++ b/nixos/roles/matrix-synapse/synapse-cleanup.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wall -Wno-missing-signatures -Wno-type-defaults -Wno-orphans #-} + +import Control.Concurrent +import Data.Aeson +import Data.String.Interpolate +import Data.Time +import Data.Time.Clock.POSIX +import Database.PostgreSQL.Simple +import Network.HTTP +import Prelude ( ) +import Relude +import Say +import System.IO + +newtype PurgeResult = PurgeResult + { purge_id :: Text + } + deriving (Generic, FromJSON) +newtype Status = Status + { status :: Text + } + deriving (Generic, FromJSON) + +apiUrl :: Text +apiUrl = [i|http://localhost:8008/_synapse/admin/v1|] +daysOld = 30 +lastMessages = 500 +minUsersToPurgeRoom = 5 + +main :: IO () +main = do + hSetBuffering stdout LineBuffering + upToTime <- + addUTCTime ((-1) * realToFrac daysOld * nominalDay) <$> getCurrentTime + conn <- connectPostgreSQL "dbname='matrix-synapse'" + (token :: Text) <- + fromMaybe (error "No admin token in database") + . viaNonEmpty head + <$> (fromOnly <<$>> query_ + conn + "SELECT token FROM access_tokens JOIN users ON user_id=name WHERE admin=1 ORDER BY id DESC LIMIT 1" + ) + let + upToTimeStamp = floor . (* 1000) . utcTimeToPOSIXSeconds $ upToTime + timeOutBody = + [i|{"delete_local_events":"true", "purge_up_to_ts":#{upToTimeStamp}}|] + contentType = "application/json" + setAuth = insertHeaders [Header HdrAuthorization [i|Bearer #{token}|]] + wait :: Text -> IO Text + wait purgeId = go 1 + where + go timeout = do + say [i|purge #{purgeId} is going on waiting #{timeout} seconds|] + threadDelay (timeout * 1000000) + response <- + simpleHTTP + . setAuth + . getRequest + $ [i|#{apiUrl}/purge_history_status/#{purgeId}|] + case response of + Left _ -> pure "failed" + Right resp -> do + let res = + maybe "failed" status (decode . encodeUtf8 . rspBody $ resp) + if res == "active" then go (timeout * 2) else pure res + e <- simpleHTTP + . setAuth + . postRequest + $ [i|#{apiUrl}/purge_media_cache/?before_ts=#{upToTimeStamp}|] + sayShow e + roomIds <- fromOnly @Text <<$>> query + conn + "SELECT q.room_id FROM (select count(*) as numberofusers, room_id FROM current_state_events WHERE type ='m.room.member' GROUP BY room_id) AS q LEFT JOIN room_aliases a ON q.room_id=a.room_id WHERE q.numberofusers > ? ORDER BY numberofusers desc" + (Only minUsersToPurgeRoom) + forM_ roomIds $ \roomId -> do + eventId <- + fmap (second (posixSecondsToUTCTime . (/ 1000) . realToFrac)) + . viaNonEmpty head + . mapMaybe sequence + <$> query + conn + "SELECT event_id, received_ts from events WHERE type='m.room.message' AND room_id =? ORDER BY received_ts DESC LIMIT 1 offset ?" + (roomId, lastMessages - 1) + let url = [i|#{apiUrl}/purge_history/#{roomId}|] + whenJust eventId $ \(name :: Text, timestamp) -> do + response <- + simpleHTTP + . setAuth + . postRequestWithBody url contentType + =<< if timestamp < upToTime + then + (do + say [i|Deleting up to #{name} in #{roomId}.|] + pure + [i|{"delete_local_events":"true", "purge_up_to_event_id":"#{name}"}|] + ) + else do + say [i|Deleting up to last #{daysOld} days in #{roomId}.|] + pure timeOutBody + case response of + Left e -> + sayErr [i|Could not get purge status in #{roomId}. Error: #{e}|] + Right resp -> do + maybe + (sayErr [i|Could not parse purge result: #{rspBody resp}|]) + (\purgeResult -> do + say + [i|Purging with id #{purge_id purgeResult} for room #{roomId}.|] + result <- wait (purge_id purgeResult) + say [i|Purge result: #{result}|] + ) + (decode . encodeUtf8 . rspBody $ resp) diff --git a/overlays/30-ghc.nix b/overlays/30-ghc.nix index 4d9fb320..c751323d 100644 --- a/overlays/30-ghc.nix +++ b/overlays/30-ghc.nix @@ -14,7 +14,7 @@ let brittany ormolu releaser cabal-fmt stack ghcid ghcide haskell-language-server cabal-install dhall taskwarrior pandoc hlint cabal2nix weeder reflex-dom password optics shh-extras neuron - hspec-discover cabal-edit paths hmatrix; + hspec-discover cabal-edit paths hmatrix postgresql-simple; } // makeHaskellScriptPackages p; inherit (master) ghc haskellPackages; in {