add fourmolu (#868)

* add fourmolu

* linebreak

* simplify

* comment

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -518,7 +518,7 @@ instance ToJSON NtfTknStatus where
 
 instance FromJSON NtfTknStatus where
   parseJSON = J.withText "NtfTknStatus" $ either fail pure . smpDecode . encodeUtf8
-    
+
 checkEntity :: forall t e e'. (NtfEntityI e, NtfEntityI e') => t e' -> Either String (t e)
 checkEntity c = case testEquality (sNtfEntity @e) (sNtfEntity @e') of
   Just Refl -> Right c

src/Simplex/Messaging/Notifications/Server.hs

@@ -22,7 +22,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (intercalate, sort)
-import Data.List.NonEmpty (NonEmpty(..))
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -208,7 +208,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
     -- | Subscribe to queues. The list of results can have a different order.
     subscribeQueues :: SMPServer -> NonEmpty NtfSubData -> IO (NonEmpty (NtfSubData, Either SMPClientError ()))
     subscribeQueues srv subs =
-      L.map (second snd) . L.zip subs <$> subscribeQueuesNtfs ca srv (L.map sub subs)
+      L.zipWith (\s r -> (s, snd r)) subs <$> subscribeQueuesNtfs ca srv (L.map sub subs)
       where
         sub NtfSubData {smpQueue = SMPQueueNtf {notifierId}, notifierKey} = (notifierId, notifierKey)
 
@@ -248,10 +248,11 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
             forM errs (\((_, ntfId), err) -> handleSubError (SMPQueueNtf srv ntfId) err)
               >>= logSubErrors srv . catMaybes . L.toList
 
-    logSubStatus srv event n = when (n > 0) $
-      logInfo $ "SMP server " <> event <> " " <> showServer' srv <> " (" <> tshow n <> " subscriptions)"
+    logSubStatus srv event n =
+      when (n > 0) . logInfo $
+        "SMP server " <> event <> " " <> showServer' srv <> " (" <> tshow n <> " subscriptions)"
 
-    logSubErrors :: SMPServer -> [NtfSubStatus] -> M ()        
+    logSubErrors :: SMPServer -> [NtfSubStatus] -> M ()
     logSubErrors srv errs = forM_ (L.group $ sort errs) $ \errs' -> do
       logError $ "SMP subscription errors on server " <> showServer' srv <> ": " <> tshow (L.head errs') <> " (" <> tshow (length errs') <> " errors)"
 
@@ -289,14 +290,14 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
   case ntf of
     PNVerification _
       | status /= NTInvalid && status /= NTExpired ->
-        deliverNotification pp tkn ntf >>= \case
-          Right _ -> do
-            status_ <- atomically $ stateTVar tknStatus $ \case
-              NTActive -> (Nothing, NTActive)
-              NTConfirmed -> (Nothing, NTConfirmed)
-              _ -> (Just NTConfirmed, NTConfirmed)
-            forM_ status_ $ \status' -> withNtfLog $ \sl -> logTokenStatus sl ntfTknId status'
-          _ -> pure ()
+          deliverNotification pp tkn ntf >>= \case
+            Right _ -> do
+              status_ <- atomically $ stateTVar tknStatus $ \case
+                NTActive -> (Nothing, NTActive)
+                NTConfirmed -> (Nothing, NTConfirmed)
+                _ -> (Just NTConfirmed, NTConfirmed)
+              forM_ status_ $ \status' -> withNtfLog $ \sl -> logTokenStatus sl ntfTknId status'
+            _ -> pure ()
       | otherwise -> logError "bad notification token status"
     PNCheckMessages -> checkActiveTkn status $ do
       void $ deliverNotification pp tkn ntf
@@ -463,16 +464,16 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
               else pure $ NRErr AUTH
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
             | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do
-              logDebug "TVFY - token verified"
-              st <- asks store
-              updateTknStatus tkn NTActive
-              tIds <- atomically $ removeInactiveTokenRegistrations st tkn
-              forM_ tIds cancelInvervalNotifications
-              incNtfStat tknVerified
-              pure NROk
+                logDebug "TVFY - token verified"
+                st <- asks store
+                updateTknStatus tkn NTActive
+                tIds <- atomically $ removeInactiveTokenRegistrations st tkn
+                forM_ tIds cancelInvervalNotifications
+                incNtfStat tknVerified
+                pure NROk
             | otherwise -> do
-              logDebug "TVFY - incorrect code or token status"
-              pure $ NRErr AUTH
+                logDebug "TVFY - incorrect code or token status"
+                pure $ NRErr AUTH
           TCHK -> do
             logDebug "TCHK"
             pure $ NRTkn status
@@ -509,16 +510,16 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
           TCRN int
             | int < 20 -> pure $ NRErr QUOTA
             | otherwise -> do
-              logDebug "TCRN"
-              atomically $ writeTVar tknCronInterval int
-              atomically (TM.lookup tknId intervalNotifiers) >>= \case
-                Nothing -> runIntervalNotifier int
-                Just IntervalNotifier {interval, action} ->
-                  unless (interval == int) $ do
-                    uninterruptibleCancel action
-                    runIntervalNotifier int
-              withNtfLog $ \s -> logTokenCron s tknId int
-              pure NROk
+                logDebug "TCRN"
+                atomically $ writeTVar tknCronInterval int
+                atomically (TM.lookup tknId intervalNotifiers) >>= \case
+                  Nothing -> runIntervalNotifier int
+                  Just IntervalNotifier {interval, action} ->
+                    unless (interval == int) $ do
+                      uninterruptibleCancel action
+                      runIntervalNotifier int
+                withNtfLog $ \s -> logTokenCron s tknId int
+                pure NROk
             where
               runIntervalNotifier interval = do
                 action <- async . intervalNotifier $ fromIntegral interval * 1000000 * 60

src/Simplex/Messaging/Notifications/Server/Env.hs

@@ -34,7 +34,7 @@ import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (ATransport)
-import Simplex.Messaging.Transport.Server (loadFingerprint, loadTLSServerParams, TransportServerConfig)
+import Simplex.Messaging.Transport.Server (TransportServerConfig, loadFingerprint, loadTLSServerParams)
 import System.IO (IOMode (..))
 import System.Mem.Weak (Weak)
 import UnliftIO.STM

src/Simplex/Messaging/Notifications/Server/Main.hs

@@ -7,7 +7,6 @@
 
 module Simplex.Messaging.Notifications.Server.Main where
 
-import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Ini (lookupValue, readIniFile)
 import Data.Maybe (fromMaybe)
@@ -92,7 +91,7 @@ ntfServerCLI cfgPath logPath =
       hSetBuffering stdout LineBuffering
       hSetBuffering stderr LineBuffering
       fp <- checkSavedFingerprint cfgPath defaultX509Config
-      let host = fromRight "<hostnames>" $ T.unpack <$> lookupValue "TRANSPORT" "host" ini
+      let host = either (const "<hostnames>") T.unpack $ lookupValue "TRANSPORT" "host" ini
           port = T.unpack $ strictIni "TRANSPORT" "port" ini
           cfg@NtfServerConfig {transports, storeLogFile} = serverConfig
           srv = ProtoServerWithAuth (NtfServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing

src/Simplex/Messaging/Notifications/Server/Push/APNS.hs

@@ -356,15 +356,15 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
     result status reason'
       | status == Just N.ok200 = pure ()
       | status == Just N.badRequest400 =
-        case reason' of
-          "BadDeviceToken" -> throwError PPTokenInvalid
-          "DeviceTokenNotForTopic" -> throwError PPTokenInvalid
-          "TopicDisallowed" -> throwError PPPermanentError
-          _ -> err status reason'
+          case reason' of
+            "BadDeviceToken" -> throwError PPTokenInvalid
+            "DeviceTokenNotForTopic" -> throwError PPTokenInvalid
+            "TopicDisallowed" -> throwError PPPermanentError
+            _ -> err status reason'
       | status == Just N.forbidden403 = case reason' of
-        "ExpiredProviderToken" -> throwError PPPermanentError -- there should be no point retrying it as the token was refreshed
-        "InvalidProviderToken" -> throwError PPPermanentError
-        _ -> err status reason'
+          "ExpiredProviderToken" -> throwError PPPermanentError -- there should be no point retrying it as the token was refreshed
+          "InvalidProviderToken" -> throwError PPPermanentError
+          _ -> err status reason'
       | status == Just N.gone410 = throwError PPTokenInvalid
       | status == Just N.serviceUnavailable503 = liftIO (disconnectApnsHTTP2Client c) >> throwError PPRetryLater
       -- Just tooManyRequests429 -> TooManyRequests - too many requests for the same token

src/Simplex/Messaging/Notifications/Server/Store.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Simplex.Messaging.Notifications.Server.Store where

src/Simplex/Messaging/Notifications/Server/StoreLog.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
-
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module Simplex.Messaging.Notifications.Server.StoreLog

src/Simplex/Messaging/Notifications/Transport.hs

@@ -50,9 +50,9 @@ ntfServerHandshake c kh ntfVRange = do
   getHandshake th >>= \case
     NtfClientHandshake {ntfVersion, keyHash}
       | keyHash /= kh ->
-        throwError $ TEHandshake IDENTITY
-      | ntfVersion `isCompatible` ntfVRange -> do
-        pure (th :: THandle c) {thVersion = ntfVersion}
+          throwError $ TEHandshake IDENTITY
+      | ntfVersion `isCompatible` ntfVRange ->
+          pure (th :: THandle c) {thVersion = ntfVersion}
       | otherwise -> throwError $ TEHandshake VERSION
 
 -- | Notifcations server client transport handshake.