[WIP] [CSL-2125] Migrate to GHC 8.2.2 and LTS 10.3

crypto/Pos/Arbitrary/Crypto.hs

@@ -62,19 +62,19 @@ instance Arbitrary SignTag where
 -- 'arbitrary' and then use 'Pos.Crypto.toPublic' to get the corresponding
 -- public key.
 
-keys :: [(PublicKey, SecretKey)]
-keys = deterministic "keys" $
+singingKeys :: [(PublicKey, SecretKey)]
+singingKeys = deterministic "keys" $
  replicateM keysToGenerate keyGen
 
 instance Arbitrary PublicKey where
- arbitrary = fst <$> elements keys
+ arbitrary = fst <$> elements singingKeys
 instance Arbitrary SecretKey where
- arbitrary = snd <$> elements keys
+ arbitrary = snd <$> elements singingKeys
 
 instance Nonrepeating PublicKey where
- nonrepeating n = map fst <$> sublistN n keys
+ nonrepeating n = map fst <$> sublistN n singingKeys
 instance Nonrepeating SecretKey where
- nonrepeating n = map snd <$> sublistN n keys
+ nonrepeating n = map snd <$> sublistN n singingKeys
 
 -- Repeat the same for ADA redemption keys
 redemptionKeys :: [(RedeemPublicKey, RedeemSecretKey)]

crypto/Pos/Crypto/Encryption.hs

@@ -42,11 +42,11 @@ deriveAesKeyBS :: ByteString -> AesKey
 deriveAesKeyBS = AesKey . blake2b
 
 aesEncrypt :: ByteString -> AesKey -> Either CryptoError ByteString
-aesEncrypt input (fromAESKey -> sk) = ctrCombine <$> init <*> pure nullIV <*> pure input
+aesEncrypt input (fromAESKey -> sk) = ctrCombine <$> cInit <*> pure nullIV <*> pure input
  where
  -- FIXME: return either here
- init :: Either CryptoError AES256
- init = eitherCryptoError $ cipherInit sk
+ cInit :: Either CryptoError AES256
+ cInit = eitherCryptoError $ cipherInit sk
 
 aesDecrypt :: ByteString -> AesKey -> Either CryptoError ByteString
 aesDecrypt = aesEncrypt -- encryption/decryption is symmetric

crypto/Pos/Crypto/SecretSharing.hs

@@ -280,12 +280,12 @@ testScrape t = do
  let thr :: Scrape.Threshold
  thr = fromIntegral t
  -- Generate t*2 keys.
- keys <- sortWith toVssPublicKey <$> replicateM (t*2) vssKeyGen
- let pks = map toVssPublicKey keys
+ publicKeys <- sortWith toVssPublicKey <$> replicateM (t*2) vssKeyGen
+ let pks = map toVssPublicKey publicKeys
  -- Generate and share a secret.
  (secret, proof, encShares) <- genSharedSecret thr (NE.fromList pks)
  -- Decrypt the shares.
- decShares <- zipWithM decryptShare keys (map snd encShares)
+ decShares <- zipWithM decryptShare publicKeys (map snd encShares)
  -- Recover the secret.
  let recovered = recoverSecret thr
  (map (,1) pks)

crypto/Pos/Crypto/Signing/Safe.hs

@@ -37,7 +37,7 @@ import Pos.Crypto.Signing.Types.Safe
 -- | Regerates secret key with new passphrase.
 -- Note: This operation remains corresponding public key and derived (child) keys unchanged.
 changeEncPassphrase
- :: (Bi PassPhrase, MonadRandom m)
+ :: (MonadRandom m)
  => PassPhrase
  -> PassPhrase
  -> EncryptedSecretKey
@@ -75,15 +75,14 @@ safeCreateKeypairFromSeed seed (PassPhrase pp) =
 -- "Pos.Crypto.Random" because the OpenSSL generator is probably safer than
 -- the default IO generator.
 safeKeyGen
- :: (MonadRandom m, Bi PassPhrase, Bi (Hash ByteString))
+ :: (MonadRandom m)
  => PassPhrase -> m (PublicKey, EncryptedSecretKey)
 safeKeyGen pp = do
  seed <- getRandomBytes 32
  pure $ safeDeterministicKeyGen seed pp
 
 safeDeterministicKeyGen
- :: (Bi PassPhrase, Bi (Hash ByteString))
- => BS.ByteString
+ :: BS.ByteString
  -> PassPhrase
  -> (PublicKey, EncryptedSecretKey)
 safeDeterministicKeyGen seed pp =
@@ -104,7 +103,7 @@ safeToPublic (FakeSigner sk) = toPublic sk
 -- we can manually cleanup all IO buffers we use to store passphrase
 -- (when we'll actually use them)
 withSafeSigners
- :: (Monad m, Bi PassPhrase, Traversable t)
+ :: (Monad m, Traversable t)
  => t EncryptedSecretKey
  -> m PassPhrase
  -> (t SafeSigner -> m a) -> m a
@@ -126,7 +125,7 @@ withSafeSigner sk ppGetter action = do
 
 -- This function is like @withSafeSigner@ but doesn't check @checkPassMatches@
 withSafeSignerUnsafe
- :: (Monad m, Bi PassPhrase)
+ :: (Monad m)
  => EncryptedSecretKey
  -> m PassPhrase
  -> (SafeSigner -> m a)

networking/src/Node.hs

@@ -274,7 +274,7 @@ node
  :: forall packing peerData m t .
  ( Mockable Fork m, Mockable Channel.Channel m
  , Mockable SharedAtomic m, MonadMask m
- , Mockable Async m, Mockable Concurrently m
+ , Mockable Async m
  , Ord (ThreadId m), Show (ThreadId m)
  , Mockable SharedExclusive m
  , Mockable Delay m

networking/src/Node/Internal.hs

@@ -617,7 +617,7 @@ startNode
  :: forall packingType peerData m .
  ( Mockable SharedAtomic m, Mockable Channel.Channel m
  , MonadMask m
- , Mockable Async m, Mockable Concurrently m
+ , Mockable Async m
  , Ord (ThreadId m), Show (ThreadId m)
  , Mockable CurrentTime m, Mockable Metrics.Metrics m
  , Mockable SharedExclusive m
@@ -789,7 +789,7 @@ waitForRunningHandlers node = do
 -- to various handlers.
 nodeDispatcher
  :: forall m packingType peerData .
- ( Mockable SharedAtomic m, Mockable Async m, Mockable Concurrently m
+ ( Mockable SharedAtomic m, Mockable Async m
  , Ord (ThreadId m), MonadMask m, Mockable SharedExclusive m
  , Mockable Channel.Channel m
  , Mockable CurrentTime m, Mockable Metrics.Metrics m

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-9.1
+resolver: lts-10.3
 
 flags:
  ether:
@@ -39,44 +39,32 @@ nix:
  shell-file: shell.nix
 
 extra-deps:
-- ekg-core-0.1.1.3 # https:/tibbe/ekg-core/pull/21
-- transformers-0.5.5.0 # https://hub.darcs.net/ross/transformers/issue/33#comment-20171004T152940
-- universum-0.9.0
-- serokell-util-0.5.2
-- pvss-0.2.0
+# Serokell packages
+- log-warper-1.8.5 # TODO: remove after appear on Stackage
+- rocksdb-haskell-1.0.0
+- serokell-util-0.6.0
+- universum-1.0.2 # TODO: remove after appear on Stackage
+
+# miscellaneous packages
 - base58-bytestring-0.1.0
-- log-warper-1.8.0
-- concurrent-extra-0.7.0.10 # not yet on Stackage
-# - purescript-bridge-0.8.0.1
 - directory-1.3.1.0 # https:/malcolmwallace/cpphs/issues/8
+- json-sop-0.2.0.3
+- lens-sop-0.2.0.2
+- loc-0.1.3.1
+- pipes-interleave-1.1.1
+- pvss-0.2.0
+- systemd-1.1.2
+- tabl-1.0.3
+- transformers-0.5.5.0 # https://hub.darcs.net/ross/transformers/issue/33#comment-20171004T152940
+
+# servant
 - servant-0.12
 - servant-server-0.12
 - servant-client-0.12
 - servant-client-core-0.12
 - servant-multipart-0.11
 - servant-docs-0.11.1 # needed for servant-0.12
-- servant-swagger-1.1.4 # needed for servant-0.12
-- servant-swagger-ui-0.2.4.3.4.0 # needed for servant-0.12
 - servant-quickcheck-0.0.4
-- ether-0.5.1.0
-- pipes-interleave-1.1.1
-- rocksdb-haskell-1.0.0
-- generic-arbitrary-0.1.0
-- happy-1.19.5 # https:/commercialhaskell/stack/issues/3151
-- entropy-0.3.7 # https:/commercialhaskell/stack/issues/3151
-- fmt-0.5.0.0
-- systemd-1.1.2
-- tabl-1.0.3
-# ekg-statsd version without the unnecessary diffing optimisation
-- ekg-statsd-0.2.2.0
-# https:/fpco/lts-haskell/issues/70
-- fgl-5.5.3.1
-- megaparsec-6.2.0
-- parser-combinators-0.2.0
-- loc-0.1.3.1
-- lens-sop-0.2.0.2
-- json-sop-0.2.0.3
-- servant-generic-0.1.0.1
 
 # GitHub dependencies
 ## Serokell fork of time-units; don't show microseconds in unicode
@@ -96,7 +84,7 @@ extra-deps:
  commit: 7120bb4d28e708acd52dfd61d3dca7914fac7d7f # master
 ## plutus; smart-contracts language
 - git: https:/input-output-hk/plutus-prototype
- commit: d4aa461fc69fc6957aab46b41a670c2144aefb77
+ commit: c8ea123947fb62e4e02ca46f0eaadc5b47da3605 # from chshersh/csl2125-ghc-8.2.2 branch
 ## ed25519
 - git: https:/thoughtpolice/hs-ed25519
  # We're waiting on next release

util/Pos/Util/Filesystem.hs

@@ -16,7 +16,6 @@ import Universum
 import Control.Concurrent (myThreadId)
 import qualified Control.Exception.Safe as E
 import Data.Char (isAlphaNum)
-import Data.List (last)
 import Data.Time (getCurrentTime)
 import qualified Prelude
 import System.Directory (canonicalizePath, createDirectory, doesDirectoryExist,
@@ -69,7 +68,7 @@ withTempDir parentDir template = bracket acquire dispose
 -- which is a bit more lenient than `System.FilePath.takeDirectory`.
 directory :: FilePath -> FilePath
 directory "" = ""
-directory f = case last f of
+directory f@(y:ys) = case last (y :| ys) of
  x | x == pathSeparator -> f
  _ -> takeDirectory (normalise f)
 

util/Pos/Util/Lens.hs

@@ -14,7 +14,6 @@ module Pos.Util.Lens
  ) where
 
 import Universum
-import Unsafe (unsafeInit, unsafeLast)
 
 import Control.Lens (LensRules, lensField, lensRules, mappingNamer)
 
@@ -32,8 +31,8 @@ _neTail f (x :| xs) = (x :|) <$> f xs
 
 -- | Lens for the last element of 'NonEmpty'.
 _neLast :: Lens' (NonEmpty a) a
-_neLast f (x :| []) = (:| []) <$> f x
-_neLast f (x :| xs) = (\y -> x :| unsafeInit xs ++ [y]) <$> f (unsafeLast xs)
+_neLast f (x :| [])  = (:| []) <$> f x
+_neLast f (x :| (l : ls)) = (\y -> x :| init (l :| ls) ++ [y]) <$> f (last (l :| ls))
 
 ----------------------------------------------------------------------------
 -- Custom LensRules

util/Pos/Util/Modifier.hs

@@ -32,7 +32,7 @@ module Pos.Util.Modifier
  , toHashMap
  ) where
 
-import Universum hiding (filter, mapMaybe, toList)
+import Universum hiding (filter, keys, mapMaybe, toList)
 import qualified Universum
 
 import Data.Hashable (Hashable)
@@ -215,14 +215,14 @@ mapMaybe getter f = runIdentity . mapMaybeM (Identity getter) f
 -- | Applies a map modifier to a hashmap, returning the result
 modifyHashMap :: (Eq k, Hashable k) => MapModifier k v -> HashMap k v -> HashMap k v
 modifyHashMap pm hm =
- foldl' (flip (uncurry HM.insert)) (foldl' (flip HM.delete) hm deletes) inserts
+ foldl' (uncurry HM.insert) (foldl' HM.delete hm deletes) inserts
  where
  inserts = insertions pm
  deletes = deletions pm
 
 modifyMap :: Ord k => MapModifier k v -> Map k v -> Map k v
 modifyMap pm hm =
- foldl' (flip (uncurry M.insert)) (foldl' (flip M.delete) hm deletes) inserts
+ foldl' (uncurry M.insert) (foldl' M.delete hm deletes) inserts
  where
  inserts = insertions pm
  deletes = deletions pm

util/Pos/Util/Util.hs

@@ -250,8 +250,8 @@ dumpSplices x = do
 histogram :: forall a. Ord a => [a] -> Map a Int
 histogram = foldl' step M.empty
  where
- step :: Map a Int -> a -> Map a Int
- step m x = M.insertWith (+) x 1 m
+ step :: a -> Map a Int -> Map a Int
+ step x = M.insertWith (+) x 1
 
 median :: Ord a => NonEmpty a -> a
 median l = NE.sort l NE.!! middle