From 8a2ffc6043cc2f12113a00ff351090df554beca2 Mon Sep 17 00:00:00 2001 From: Piotr Paradzinski Date: Mon, 4 May 2026 18:36:54 +0200 Subject: [PATCH 1/2] replace deprecated cryptohash with crypton --- Database/MongoDB/Internal/Protocol.hs | 12 +++++++---- Database/MongoDB/Query.hs | 29 ++++++++++++++++----------- mongoDB.cabal | 8 ++++++-- 3 files changed, 31 insertions(+), 18 deletions(-) diff --git a/Database/MongoDB/Internal/Protocol.hs b/Database/MongoDB/Internal/Protocol.hs index dbf7630..f0eca8e 100644 --- a/Database/MongoDB/Internal/Protocol.hs +++ b/Database/MongoDB/Internal/Protocol.hs @@ -52,7 +52,8 @@ import Control.Concurrent (ThreadId, killThread, forkIOWithUnmask) import Control.Concurrent.STM.TChan (TChan, newTChan, readTChan, writeTChan, isEmptyTChan) import Control.Exception.Lifted (SomeException, mask_, onException, throwIO, try) - +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L import Control.Monad.Trans (MonadIO, liftIO) @@ -61,7 +62,7 @@ import Data.Bson.Binary (getDocument, putDocument, getInt32, putInt32, getInt64, putInt64, putCString) import Data.Text (Text) -import qualified Crypto.Hash.MD5 as MD5 +import Crypto.Hash( Digest, MD5, hash) import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -794,11 +795,14 @@ type Username = Text type Password = Text type Nonce = Text +md5 :: BS.ByteString -> BS.ByteString +md5 = BA.convert . (hash :: BS.ByteString -> Digest MD5) + pwHash :: Username -> Password -> Text -pwHash u p = T.pack . byteStringHex . MD5.hash . TE.encodeUtf8 $ u `T.append` ":mongo:" `T.append` p +pwHash u p = T.pack . byteStringHex . md5 . TE.encodeUtf8 $ u `T.append` ":mongo:" `T.append` p pwKey :: Nonce -> Username -> Password -> Text -pwKey n u p = T.pack . byteStringHex . MD5.hash . TE.encodeUtf8 . T.append n . T.append u $ pwHash u p +pwKey n u p = T.pack . byteStringHex . md5 . TE.encodeUtf8 . T.append n . T.append u $ pwHash u p {- Authors: Tony Hannan diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs index b83e316..7047be8 100644 --- a/Database/MongoDB/Query.hs +++ b/Database/MongoDB/Query.hs @@ -62,9 +62,7 @@ import Control.Monad import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, local, runReaderT) import Control.Monad.Trans (MonadIO, liftIO, lift) import Control.Monad.Trans.Except -import qualified Crypto.Hash.MD5 as MD5 -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Crypto.Hash.SHA256 as SHA256 +import Crypto.Hash (Digest, MD5, SHA1, SHA256, hash) import qualified Crypto.MAC.HMAC as HMAC import qualified Crypto.Nonce as Nonce import Data.Binary.Put (runPut) @@ -89,6 +87,7 @@ import Data.Bson cast ) import Data.Bson.Binary (putDocument) +import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base64 as B64 @@ -133,9 +132,8 @@ import Database.MongoDB.Internal.Protocol pwKey, FlagBit (..) ) -import Control.Monad.Trans.Except import qualified Database.MongoDB.Internal.Protocol as P -import Database.MongoDB.Internal.Util (liftIOE, loop, true1, (<.>), splitDot) +import Database.MongoDB.Internal.Util (liftIOE, loop, true1, (<.>)) import System.Mem.Weak (Weak) import Text.Read (readMaybe) import Prelude hiding (lookup) @@ -289,9 +287,16 @@ authMongoCR usr pss = do data HashAlgorithm = SHA1 | SHA256 deriving Show -hash :: HashAlgorithm -> B.ByteString -> B.ByteString -hash SHA1 = SHA1.hash -hash SHA256 = SHA256.hash +hashBytes :: HashAlgorithm -> B.ByteString -> B.ByteString +hashBytes SHA1 = BA.convert . (hash :: B.ByteString -> Digest SHA1) +hashBytes SHA256 = BA.convert . (hash :: B.ByteString -> Digest SHA256) + +hmacBytes :: HashAlgorithm -> B.ByteString -> B.ByteString -> B.ByteString +hmacBytes SHA1 key msg = BA.convert (HMAC.hmac key msg :: HMAC.HMAC SHA1) +hmacBytes SHA256 key msg = BA.convert (HMAC.hmac key msg :: HMAC.HMAC SHA256) + +md5 :: B.ByteString -> B.ByteString +md5 = BA.convert . (hash :: B.ByteString -> Digest MD5) authSCRAMSHA1 :: MonadIO m => Username -> Password -> Action m Bool authSCRAMSHA1 = authSCRAMWith SHA1 @@ -309,7 +314,7 @@ saslprep = id authSCRAMWith :: MonadIO m => HashAlgorithm -> Username -> Password -> Action m Bool -- ^ Authenticate with the current database, using the SCRAM-SHA-1 authentication mechanism (default in MongoDB server >= 3.0) authSCRAMWith algo un pw = toAuthResult $ do - let hmac = HMAC.hmac (hash algo) 64 + let hmac = hmacBytes algo nonce <- liftIO (Nonce.withGenerator Nonce.nonce128 <&> B64.encode) let firstBare = B.concat [B.pack $ "n=" ++ T.unpack un ++ ",r=", nonce] let client1 = @@ -332,11 +337,11 @@ authSCRAMWith algo un pw = toAuthResult $ do shortcircuit (B.isInfixOf nonce snonce) "nonce" let withoutProof = B.concat [B.pack "c=biws,r=", snonce] let digest = case algo of - SHA1 -> B16.encode $ MD5.hash $ B.pack $ T.unpack un ++ ":mongo:" ++ T.unpack pw + SHA1 -> B16.encode $ md5 $ B.pack $ T.unpack un ++ ":mongo:" ++ T.unpack pw SHA256 -> B.pack $ T.unpack $ saslprep pw let saltedPass = scramHI algo digest salt iterations let clientKey = hmac saltedPass (B.pack "Client Key") - let storedKey = hash algo clientKey + let storedKey = hashBytes algo clientKey let authMsg = B.concat [firstBare, B.pack ",", serverPayload1, B.pack ",", withoutProof] let clientSig = hmac storedKey authMsg let pval = B64.encode . BS.pack $ BS.zipWith xor clientKey clientSig @@ -373,7 +378,7 @@ shortcircuit False reason = throwE (show reason) scramHI :: HashAlgorithm -> B.ByteString -> B.ByteString -> Int -> B.ByteString scramHI algo digest salt iters = snd $ foldl com (u1, u1) [1..(iters-1)] where - hmacd = HMAC.hmac (hash algo) 64 digest + hmacd = hmacBytes algo digest u1 = hmacd (B.concat [salt, BS.pack [0, 0, 0, 1]]) com (u,uc) _ = let u' = hmacd u in (u', BS.pack $ BS.zipWith xor uc u') diff --git a/mongoDB.cabal b/mongoDB.cabal index f78a68f..6029c7c 100644 --- a/mongoDB.cabal +++ b/mongoDB.cabal @@ -38,11 +38,12 @@ Library , conduit , conduit-extra , mtl >= 2 - , cryptohash -any + , crypton >= 1.0 && < 2 , parsec -any , random -any , random-shuffle -any , resourcet + , ram >= 0.22 && < 0.23 , monad-control >= 0.3.1 , lifted-base >= 0.1.0.3 , pureMD5 @@ -102,6 +103,8 @@ test-suite test , old-locale , text , time + build-tool-depends: + hspec-discover:hspec-discover default-language: Haskell2010 default-extensions: OverloadedStrings @@ -122,12 +125,13 @@ Benchmark bench , bytestring -any , containers -any , mtl >= 2 - , cryptohash -any + , crypton >= 1.0 && < 2 , nonce >= 1.0.5 , stm , parsec -any , random -any , random-shuffle -any + , ram >= 0.22 && < 0.23 , monad-control >= 0.3.1 , lifted-base >= 0.1.0.3 , transformers From 40840d6ffbafed67e14224f1bf285d5866518b93 Mon Sep 17 00:00:00 2001 From: Piotr Paradzinski Date: Thu, 7 May 2026 23:56:33 +0200 Subject: [PATCH 2/2] align crypton and ram --- mongoDB.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/mongoDB.cabal b/mongoDB.cabal index 6029c7c..fd0b5d2 100644 --- a/mongoDB.cabal +++ b/mongoDB.cabal @@ -38,12 +38,12 @@ Library , conduit , conduit-extra , mtl >= 2 - , crypton >= 1.0 && < 2 + , crypton >= 1.1 , parsec -any , random -any , random-shuffle -any , resourcet - , ram >= 0.22 && < 0.23 + , ram >= 0.20.1 && < 0.23 , monad-control >= 0.3.1 , lifted-base >= 0.1.0.3 , pureMD5 @@ -125,13 +125,13 @@ Benchmark bench , bytestring -any , containers -any , mtl >= 2 - , crypton >= 1.0 && < 2 + , crypton >= 1.1 , nonce >= 1.0.5 , stm , parsec -any , random -any , random-shuffle -any - , ram >= 0.22 && < 0.23 + , ram >= 0.20.1 && < 0.23 , monad-control >= 0.3.1 , lifted-base >= 0.1.0.3 , transformers