Merge branch 'reduce-warnings'

.github/workflows/main.yml

@@ -14,7 +14,7 @@ jobs:
       fail-fast: false
       matrix:
         os:  [ 'ubuntu-latest', 'macOS-latest', 'windows-latest' ]
-        ghc: [ '9.0', '9.2', '9.4', '9.6' ]
+        ghc: [ '9.0', '9.2', '9.4', '9.6', '9.8', '9.10' ]
 
     steps:
     - uses: actions/checkout@v3

Crypto/Cipher/AESGCMSIV.hs

@@ -27,6 +27,7 @@ module Crypto.Cipher.AESGCMSIV (
     decrypt,
 ) where
 
+import Data.Maybe
 import Data.Bits
 import Data.Word
 
@@ -195,4 +196,4 @@ transformTag :: Bytes -> IV AES
 transformTag tag = toIV $ B.copyAndFreeze tag $ \ptr ->
     peekElemOff ptr 15 >>= pokeElemOff ptr 15 . (.|. (0x80 :: Word8))
   where
-    toIV bs = let Just iv = makeIV (bs :: Bytes) in iv
+    toIV bs = fromJust $ makeIV (bs :: Bytes)

Crypto/Cipher/DES/Primitive.hs

@@ -218,7 +218,7 @@ do_round r (ml, mr) kb = (mr, m')
     comp_kb = compression_permutation kb'
     expa_mr = expansion_permutation mr
     res = comp_kb `desXor` expa_mr
-    res' = tail $ iterate (trans 6) ([], res)
+    res' = drop 1 $ iterate (trans 6) ([], res)
     trans n (_, b) = (take n b, drop n b)
     res_s =
         concat $

Crypto/Cipher/Twofish/Primitive.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MagicHash #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
 module Crypto.Cipher.Twofish.Primitive (
     Twofish,
@@ -13,8 +14,8 @@ import Crypto.Internal.ByteArray (ByteArray)
 import qualified Crypto.Internal.ByteArray as B
 import Crypto.Internal.WordArray
 import Data.Bits
-import Data.List
 import Data.Word
+import Data.List (foldl')
 
 -- Based on the Golang referance implementation
 -- https://github.com/golang/crypto/blob/master/twofish/twofish.go

Crypto/MAC/CMAC.hs

@@ -151,7 +151,9 @@ expandIPT'
 expandIPT' bytes (Q x y z) =
     reverse . setB x . setB y . setB z . setB 0 $ replicate bytes 0
   where
-    setB i ws = hd ++ setBit (head tl) r : tail tl
+    setB i ws = case tl of
+      (a:as) -> hd ++ setBit a r : as
+      _ -> error "expandIPT'"
       where
         (q, r) = i `quotRem` 8
         (hd, tl) = splitAt q ws

Crypto/Number/Compat.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
 
 -- |
 -- Module      : Crypto.Number.Compat

Crypto/Number/F2m.hs

@@ -25,7 +25,7 @@ module Crypto.Number.F2m (
 
 import Crypto.Number.Basic
 import Data.Bits (setBit, shift, testBit, xor, unsafeShiftR)
-import Data.List
+import Data.List (foldl')
 
 -- | Binary Polynomial represented by an integer
 type BinaryPolynomial = Integer

Crypto/PubKey/ECC/DH.hs

@@ -41,5 +41,7 @@ calculatePublic curve d = q
 getShared :: Curve -> PrivateNumber -> PublicPoint -> SharedKey
 getShared curve db qa = SharedKey $ i2ospOf_ ((nbBits + 7) `div` 8) x
   where
-    Point x _ = pointMul curve db qa
+    x = case pointMul curve db qa of
+      Point x' _ -> x'
+      _ -> error "getShared"
     nbBits = curveSizeBits curve

Crypto/PubKey/Rabin/Basic.hs

@@ -147,9 +147,9 @@ decrypt oaep pk c =
         k = numBytes n
         c' = os2ip c
         solutions = rights $ toList $ mapTuple (unpad oaep k . i2ospOf_ k) $ sqroot' c' p q a b n
-     in if length solutions /= 1
-            then Nothing
-            else Just $ head solutions
+     in case solutions of
+       [x] -> Just x
+       _   -> Nothing
   where
     toList (w, x, y, z) = w : x : y : z : []
     mapTuple f (w, x, y, z) = (f w, f x, f y, f z)

Crypto/Random/Probabilistic.hs

@@ -10,7 +10,6 @@ module Crypto.Random.Probabilistic (
 
 import Crypto.Internal.Compat
 import Crypto.Random
-import Crypto.Random.Types
 
 -- | This create a random number generator out of thin air with
 -- the system entropy; don't generally use as the IO is not exposed

tests/ECC.hs

@@ -4,6 +4,8 @@
 
 module ECC (tests) where
 
+import Data.Either
+
 import qualified Crypto.ECC as ECC
 import Crypto.Error
 
@@ -50,6 +52,7 @@ data VectorPoint = VectorPoint
     , vpError :: Maybe CryptoError
     }
 
+vectorsPoint :: [VectorPoint]
 vectorsPoint =
     [ VectorPoint
         { vpCurve = Curve ECC.Curve_P256R1
@@ -252,6 +255,7 @@ vectorsPoint =
         }
     ]
 
+vectorsWeakPoint :: [VectorPoint]
 vectorsWeakPoint =
     [ VectorPoint
         { vpCurve = Curve ECC.Curve_X25519
@@ -303,11 +307,12 @@ vectorsWeakPoint =
     ]
 
 vpEncodedPoint :: VectorPoint -> ByteString
-vpEncodedPoint vector = let Right bs = convertFromBase Base16 (vpHex vector) in bs
+vpEncodedPoint vector = fromRight (error "vpEncodedPoint") $ convertFromBase Base16 (vpHex vector)
 
 cryptoError :: CryptoFailable a -> Maybe CryptoError
 cryptoError = onCryptoFailure Just (const Nothing)
 
+doPointDecodeTest :: Show p => p -> VectorPoint -> TestTree
 doPointDecodeTest i vector =
     case vpCurve vector of
         Curve curve ->
@@ -316,15 +321,17 @@ doPointDecodeTest i vector =
                     (show i)
                     (vpError vector @=? cryptoError (ECC.decodePoint prx $ vpEncodedPoint vector))
 
+doWeakPointECDHTest :: Show p => p -> VectorPoint -> TestTree
 doWeakPointECDHTest i vector =
     case vpCurve vector of
         Curve curve -> testCase (show i) $ do
             let prx = Just curve -- using Maybe as Proxy
-                CryptoPassed public = ECC.decodePoint prx $ vpEncodedPoint vector
+                public = throwCryptoError $ ECC.decodePoint prx $ vpEncodedPoint vector
             keyPair <- ECC.curveGenerateKeyPair prx
             vpError vector
                 @=? cryptoError (ECC.ecdh prx (ECC.keypairGetPrivate keyPair) public)
 
+tests :: TestTree
 tests =
     testGroup
         "ECC"

tests/ECDSA.hs

@@ -3,6 +3,7 @@
 
 module ECDSA (tests) where
 
+import Data.Maybe
 import qualified Crypto.ECC as ECDSA
 import Crypto.Error
 import Crypto.Hash
@@ -32,6 +33,7 @@ instance Arbitrary Curve where
       where
         makeCurve c name = Curve c (ECC.getCurveByName name) name
 
+arbitraryScalar :: ECC.Curve -> Gen Integer
 arbitraryScalar curve = choose (1, n - 1)
   where
     n = ECC.ecc_n (ECC.common_curve curve)
@@ -55,6 +57,7 @@ testRecover name = testProperty (show name) $ \ (ArbitraryBS0_2901 msg) -> do
     let pub = ECC.signExtendedDigestWith k key digest >>= \ signature -> ECC.recoverDigest curve signature digest
     pure $ propertyHold [eqTest "recovery" (Just $ ECC.generateQ curve d) (ECC.public_q <$> pub)]
 
+tests :: TestTree
 tests = testGroup "ECDSA"
     [ localOption (QuickCheckTests 5) $
         testGroup
@@ -85,8 +88,8 @@ tests = testGroup "ECDSA"
             kECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx kECC
             privECDSA = throwCryptoError $ ECDSA.scalarFromInteger prx d
             pubECDSA = ECDSA.toPublic prx privECDSA
-            Just sigECC = ECC.signWith kECC privECC hashAlg msg
-            Just sigECDSA = ECDSA.signWith prx kECDSA privECDSA hashAlg msg
+            sigECC = fromJust $ ECC.signWith kECC privECC hashAlg msg
+            sigECDSA = fromJust $ ECDSA.signWith prx kECDSA privECDSA hashAlg msg
             sigECDSA' = sigECCToECDSA prx sigECC
             msg' = msg `B.append` B.singleton 42
         return $

tests/KAT_OTP.hs

@@ -56,11 +56,17 @@ totpSHA512Expected =
     , (20000000000, 47863826)
     ]
 
-otpKey = "12345678901234567890" :: ByteString
-totpSHA256Key = "12345678901234567890123456789012" :: ByteString
+otpKey :: ByteString
+otpKey = "12345678901234567890"
+
+totpSHA256Key :: ByteString
+totpSHA256Key = "12345678901234567890123456789012"
+
+totpSHA512Key :: ByteString
 totpSHA512Key =
-    "1234567890123456789012345678901234567890123456789012345678901234" :: ByteString
+    "1234567890123456789012345678901234567890123456789012345678901234"
 
+makeKATs :: (Eq a, Show a) => (t -> a) -> [(t, a)] -> [TestTree]
 makeKATs otp expected = concatMap (makeTest otp) (zip3 is counts otps)
   where
     is :: [Int]
@@ -69,20 +75,34 @@ makeKATs otp expected = concatMap (makeTest otp) (zip3 is counts otps)
     counts = map fst expected
     otps = map snd expected
 
+makeTest :: (Eq a1, Show a2, Show a1) => (t -> a1) -> (a2, t, a1) -> [TestTree]
 makeTest otp (i, count, password) =
     [ testCase (show i) (assertEqual "" password (otp count))
     ]
 
-Right totpSHA1Params = mkTOTPParams SHA1 0 30 OTP8 TwoSteps
-Right totpSHA256Params = mkTOTPParams SHA256 0 30 OTP8 TwoSteps
-Right totpSHA512Params = mkTOTPParams SHA512 0 30 OTP8 TwoSteps
+totpSHA1Params :: TOTPParams SHA1
+totpSHA1Params = case mkTOTPParams SHA1 0 30 OTP8 TwoSteps of
+  Right x -> x
+  _ -> error "totpSHA1Params"
+
+totpSHA256Params :: TOTPParams SHA256
+totpSHA256Params = case mkTOTPParams SHA256 0 30 OTP8 TwoSteps of
+  Right x -> x
+  _ -> error "totpSHA256Params"
+
+totpSHA512Params :: TOTPParams SHA512
+totpSHA512Params = case mkTOTPParams SHA512 0 30 OTP8 TwoSteps of
+  Right x -> x
+  _ -> error "totpSHA512Params"
 
 -- resynching with the expected value should just return the current counter + 1
+prop_resyncExpected :: Word64 -> Word16 -> Bool
 prop_resyncExpected ctr window = resynchronize SHA1 OTP6 window key ctr (otp, []) == Just (ctr + 1)
   where
     key = "1234" :: ByteString
     otp = hotp SHA1 OTP6 key ctr
 
+tests :: TestTree
 tests =
     testGroup
         "OTP"

tests/KAT_PubKey/ECC.hs

@@ -4,6 +4,8 @@ module KAT_PubKey.ECC (eccTests, eccKatTests) where
 
 import Control.Arrow (second)
 
+import Data.List
+
 import qualified Crypto.PubKey.ECC.Prim as ECC
 import qualified Crypto.PubKey.ECC.Types as ECC
 
@@ -58,6 +60,7 @@ data VectorPoint = VectorPoint
     , valid :: Bool
     }
 
+vectorsPoint :: [VectorPoint]
 vectorsPoint =
     [ VectorPoint
         { curve = ECC.getCurveByName ECC.SEC_p192r1
@@ -133,6 +136,7 @@ vectorsPoint =
         }
     ]
 
+doPointValidTest :: Show a => a -> VectorPoint -> TestTree
 doPointValidTest i vector =
     testCase
         (show i)
@@ -147,6 +151,7 @@ arbitraryPoint aCurve =
     n = ECC.ecc_n (ECC.common_curve aCurve)
     pointGen = ECC.pointBaseMul aCurve <$> choose (1, n - 1)
 
+eccTests :: TestTree
 eccTests =
     testGroup
         "ECC"
@@ -182,6 +187,7 @@ eccTests =
                 ]
         ]
 
+eccKatTests :: IO TestTree
 eccKatTests = do
     res <-
         testKatLoad "KATs/ECC-PKV.txt" (map (second (map toVector)) . katLoaderSimple)
@@ -224,6 +230,6 @@ eccKatTests = do
                     undefined
                     (valueHexInteger qx)
                     (valueHexInteger qy)
-                    (head res /= 'F')
+                    ("F" `isPrefixOf` res)
             Just _ -> error ("ERROR: " ++ show kvs)
             Nothing -> error ("ERROR: " ++ show kvs) -- VectorPoint undefined 0 0 True

tests/KAT_PubKey/RSA.hs

@@ -2,14 +2,13 @@
 
 module KAT_PubKey.RSA (rsaTests) where
 
+import Data.Either
 import Crypto.Hash
 import qualified Crypto.PubKey.RSA as RSA
 import qualified Crypto.PubKey.RSA.PKCS15 as RSA
 
 import Imports
 
-import Data.Either (isRight)
-
 data VectorRSA = VectorRSA
     { size :: Int
     , msg :: ByteString
@@ -24,6 +23,7 @@ data VectorRSA = VectorRSA
     , sig :: Either RSA.Error ByteString
     }
 
+vectorsSHA1 :: [VectorRSA]
 vectorsSHA1 =
     [ VectorRSA
         { size = 2048 `div` 8
@@ -104,16 +104,19 @@ vectorToPublic vector =
 vectorHasSignature :: VectorRSA -> Bool
 vectorHasSignature = isRight . sig
 
+doSignatureTest :: Show a => a -> VectorRSA -> TestTree
 doSignatureTest i vector = testCase (show i) (expected @=? actual)
   where
     expected = sig vector
     actual = RSA.sign Nothing (Just SHA1) (vectorToPrivate vector) (msg vector)
 
+doVerifyTest :: Show a => a -> VectorRSA -> TestTree
 doVerifyTest i vector = testCase (show i) (True @=? actual)
   where
     actual = RSA.verify (Just SHA1) (vectorToPublic vector) (msg vector) bs
-    Right bs = sig vector
+    bs = fromRight (error "doVerifyTest") $ sig vector
 
+rsaTests :: TestTree
 rsaTests =
     testGroup
         "RSA"