5.4.0.0: use ghc 9.6.2 (#791)

* Add 9.6 compat

* compile with GHC9.6.2: dependencies, imports, code

* refactor typeclasses

* refactor record dot

* update cabal version

* update github actions

* update direct-sqlcipher

* 5.4.0.0

* update cabal.project

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

src/Simplex/FileTransfer/Agent.hs

@@ -4,12 +4,15 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
 module Simplex.FileTransfer.Agent
   ( startXFTPWorkers,
     closeXFTPAgent,
@@ -24,7 +27,6 @@ module Simplex.FileTransfer.Agent
   )
 where
 
-import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple (logError)
 import Control.Monad
 import Control.Monad.Except
@@ -480,7 +482,7 @@ runXFTPSndWorker c srv doWork = do
             rcvChunks :: [[FileChunk]]
             rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
             sortChunks :: [FileChunk] -> [FileChunk]
-            sortChunks = map reverseReplicas . sortOn (chunkNo :: FileChunk -> Int)
+            sortChunks = map reverseReplicas . sortOn (\fc -> fc.chunkNo)
             reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
             addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
             addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =

src/Simplex/FileTransfer/Client.hs

@@ -3,12 +3,14 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Simplex.FileTransfer.Client where
 
+import Control.Monad
 import Control.Monad.Except
 import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder, byteString)
@@ -108,7 +110,7 @@ xftpClientServer = B.unpack . strEncode . snd3 . transportSession
     snd3 (_, s, _) = s
 
 xftpTransportHost :: XFTPClient -> TransportHost
-xftpTransportHost = (host :: HClient -> TransportHost) . client_ . http2Client
+xftpTransportHost c = c.http2Client.client_.host
 
 xftpSessionTs :: XFTPClient -> UTCTime
 xftpSessionTs = sessionTs . http2Client

src/Simplex/FileTransfer/Client/Agent.hs

@@ -8,6 +8,7 @@
 module Simplex.FileTransfer.Client.Agent where
 
 import Control.Logger.Simple (logInfo)
+import Control.Monad
 import Control.Monad.Except
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Char8 as B
@@ -21,7 +22,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ProtocolServer (..), XFTPServer)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (catchAll_, tryError)
+import Simplex.Messaging.Util (catchAll_)
 import UnliftIO
 
 type XFTPClientVar = TMVar (Either XFTPClientAgentError XFTPClient)

src/Simplex/FileTransfer/Client/Main.hs

@@ -5,10 +5,13 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
 module Simplex.FileTransfer.Client.Main
   ( SendOptions (..),
     CLIError (..),
@@ -27,7 +30,6 @@ module Simplex.FileTransfer.Client.Main
   )
 where
 
-import Control.Concurrent.STM (stateTVar)
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -367,7 +369,7 @@ cliSendFileOpts SendOptions {filePath, outputDir, numRecipients, xftpServers, re
         rcvChunks :: [[FileChunk]]
         rcvChunks = map (sortChunks . M.elems) $ M.elems $ foldl' addRcvChunk M.empty rcvReplicas
         sortChunks :: [FileChunk] -> [FileChunk]
-        sortChunks = map reverseReplicas . sortOn (chunkNo :: FileChunk -> Int)
+        sortChunks = map reverseReplicas . sortOn (\c -> c.chunkNo)
         reverseReplicas ch@FileChunk {replicas} = (ch :: FileChunk) {replicas = reverse replicas}
         addRcvChunk :: Map Int (Map Int FileChunk) -> SentRecipientReplica -> Map Int (Map Int FileChunk)
         addRcvChunk m SentRecipientReplica {chunkNo, server, rcvNo, replicaId, replicaKey, digest, chunkSize} =
@@ -426,7 +428,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
       liftIO $ printNoNewLine "Downloading file..."
       downloadedChunks <- newTVarIO []
-      let srv FileChunk {replicas} = server (head replicas :: FileChunkReplica)
+      let srv FileChunk {replicas} = (head replicas).server
           srvChunks = groupAllOn srv chunks
       chunkPaths <- map snd . sortOn fst . concat <$> pooledForConcurrentlyN 16 srvChunks (mapM $ downloadFileChunk a encPath size downloadedChunks)
       encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
@@ -505,7 +507,7 @@ cliFileDescrInfo InfoOptions {fileDescription} = do
         putStrLn $ "File download size: " <> strEnc size
         putStrLn "File server(s):"
         forM_ replicas $ \srvReplicas -> do
-          let srv = replicaServer $ head srvReplicas
+          let srv = (head srvReplicas).server
               chSizes = map (\FileServerReplica {chunkSize = chSize_} -> unFileSize $ fromMaybe chunkSize chSize_) srvReplicas
           putStrLn $ strEnc srv <> ": " <> strEnc (FileSize $ sum chSizes)
       where

src/Simplex/FileTransfer/Crypto.hs

@@ -6,6 +6,7 @@
 
 module Simplex.FileTransfer.Crypto where
 
+import Control.Monad
 import Control.Monad.Except
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (first)

src/Simplex/FileTransfer/Description.hs

@@ -5,10 +5,13 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
 module Simplex.FileTransfer.Description
   ( FileDescription (..),
     AFileDescription (..),
@@ -25,7 +28,6 @@ module Simplex.FileTransfer.Description
     YAMLServerReplicas (..), -- for tests
     validateFileDescription,
     groupReplicasByServer,
-    replicaServer,
     fdSeparator,
     kb,
     mb,
@@ -199,7 +201,7 @@ validateFileDescription fd@FileDescription {size, chunks}
   | chunksSize chunks /= unFileSize size = Left "chunks total size is different than file size"
   | otherwise = Right $ ValidFD fd
   where
-    chunkNos = map (chunkNo :: FileChunk -> Int) chunks
+    chunkNos = map (\c -> c.chunkNo) chunks
     chunksSize = fromIntegral . foldl' (\s FileChunk {chunkSize} -> s + unFileSize chunkSize) 0
 
 encodeFileDescription :: FileDescription p -> YAMLFileDescription
@@ -257,7 +259,7 @@ instance (ToField a) => ToField (FileSize a) where toField (FileSize s) = toFiel
 
 groupReplicasByServer :: FileSize Word32 -> [FileChunk] -> [[FileServerReplica]]
 groupReplicasByServer defChunkSize =
-  groupAllOn replicaServer . unfoldChunksToReplicas defChunkSize
+  groupAllOn (\r -> r.server) . unfoldChunksToReplicas defChunkSize
 
 encodeFileReplicas :: FileSize Word32 -> [FileChunk] -> [YAMLServerReplicas]
 encodeFileReplicas defChunkSize =
@@ -265,13 +267,10 @@ encodeFileReplicas defChunkSize =
   where
     encodeServerReplicas fs =
       YAMLServerReplicas
-        { server = replicaServer $ head fs, -- groupAllOn guarantees that fs is not empty
+        { server = (head fs).server, -- groupAllOn guarantees that fs is not empty
           chunks = map (B.unpack . encodeServerReplica) fs
         }
 
-replicaServer :: FileServerReplica -> XFTPServer
-replicaServer = server
-
 encodeServerReplica :: FileServerReplica -> ByteString
 encodeServerReplica FileServerReplica {chunkNo, replicaId, replicaKey, digest, chunkSize} =
   bshow chunkNo
@@ -323,7 +322,7 @@ foldReplicasToChunks :: FileSize Word32 -> [FileServerReplica] -> Either String
 foldReplicasToChunks defChunkSize fs = do
   sd <- foldSizesDigests fs
   -- TODO validate (check that chunks match) or in separate function
-  sortOn (chunkNo :: FileChunk -> Int) . map reverseReplicas . M.elems <$> foldChunks sd fs
+  sortOn (\c -> c.chunkNo) . map reverseReplicas . M.elems <$> foldChunks sd fs
   where
     foldSizesDigests :: [FileServerReplica] -> Either String (Map Int (FileSize Word32), Map Int FileDigest)
     foldSizesDigests = foldl' addSizeDigest $ Right (M.empty, M.empty)

src/Simplex/FileTransfer/Server.hs

@@ -12,6 +12,7 @@
 module Simplex.FileTransfer.Server where
 
 import Control.Logger.Simple
+import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Reader

src/Simplex/FileTransfer/Server/Main.hs

@@ -32,7 +32,7 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
 import Text.Read (readMaybe)
 
 xftpServerVersion :: String
-xftpServerVersion = "1.0.1"
+xftpServerVersion = "1.1.0"
 
 xftpServerCLI :: FilePath -> FilePath -> IO ()
 xftpServerCLI cfgPath logPath = do

src/Simplex/FileTransfer/Transport.hs

@@ -16,7 +16,9 @@ module Simplex.FileTransfer.Transport
 where
 
 import qualified Control.Exception as E
+import Control.Monad
 import Control.Monad.Except
+import Control.Monad.IO.Class
 import qualified Data.ByteArray as BA
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)