From 466b53fc8cc749164f8dbd218c14c86e12175ac9 Mon Sep 17 00:00:00 2001 From: Fraser Tweedale Date: Sun, 7 Jun 2026 14:56:26 +0200 Subject: [PATCH] convert to crypton *crypton* is today the dominant cryptographic primitives "kitchen sink" library. There is a need and want of additional cryptographic primitives in *hackage-server*, including HMAC (various use cases) and, later, additional public key signature algorithms to support OpenID Connect (for trusted publishing) and Passkeys/webauthn login. This change migrates *hackage-server* to *crypton*. The changes are kept to a minimum without any refactoring. Dependencies on *cryptohash-md5* and *cryptohash-sha256* have been dropped. It would have been nice to drop *ed25519*, but without it we would be depending on internal implementation details to define the `MemSize` instance for the *hackage-security* `Key` type. --- hackage-server.cabal | 7 +++---- .../Server/Features/Security/MD5.hs | 17 ++++++++++------- .../Server/Features/Security/Orphans.hs | 11 +++-------- .../Server/Features/Security/SHA256.hs | 9 ++++++--- src/Distribution/Server/Features/UserSignup.hs | 10 ++++++++-- src/Distribution/Server/Users/AuthToken.hs | 7 +++++-- 6 files changed, 35 insertions(+), 26 deletions(-) diff --git a/hackage-server.cabal b/hackage-server.cabal index bd88d1455..7c3baf669 100644 --- a/hackage-server.cabal +++ b/hackage-server.cabal @@ -431,7 +431,7 @@ library , HStringTemplate ^>= 0.8 , HTTP >= 4000.3.16 && < 4000.6 , http-client ^>= 0.7 && < 0.8 - , http-client-tls ^>= 0.3 + , http-client-tls ^>= 0.4 , http-types >= 0.10 && < 0.13 , QuickCheck >= 2.14 && < 2.19 , acid-state ^>= 0.16 @@ -451,10 +451,8 @@ library -- commonmark-0.2 needed by commonmark-extensions-0.2.2 , commonmark-extensions ^>= 0.2.2 -- Note: 0.2.2 added footnoteSpec to gfmExtensions - , cryptohash-md5 ^>= 0.11.100 - , cryptohash-sha256 ^>= 0.11.100 + , crypton >= 1.1.4 && < 1.2 , csv ^>= 0.1 - , ed25519 ^>= 0.0.5 , hackage-security >= 0.6 && < 0.7 -- N.B: hackage-security-0.6.2 uses Cabal-syntax-3.8.1.0 -- see https://github.com/haskell/hackage-server/issues/1130 @@ -469,6 +467,7 @@ library , hslogger ^>= 1.3.1 , lifted-base ^>= 0.2.1 , mime-mail ^>= 0.5 + , ram >= 0.19 , random >= 1.2 && < 1.4 , rss ^>= 3000.2.0.7 , safecopy ^>= 0.10 diff --git a/src/Distribution/Server/Features/Security/MD5.hs b/src/Distribution/Server/Features/Security/MD5.hs index 02c4aa05c..357115d01 100644 --- a/src/Distribution/Server/Features/Security/MD5.hs +++ b/src/Distribution/Server/Features/Security/MD5.hs @@ -28,8 +28,8 @@ import qualified Data.ByteString.Lazy as BS.Lazy import Data.SafeCopy import qualified Data.Serialize as Ser --- cryptohash -import qualified Crypto.Hash.MD5 as MD5 +import qualified Data.ByteArray as BA +import qualified Crypto.Hash as Hash -- hackage import Distribution.Server.Framework.MemSize @@ -49,6 +49,9 @@ md5digestFromBS bs = case Ser.runGet (Ser.get :: Ser.Get MD5Digest) bs of Left e -> error ("md5digestFromBS: " ++ e) Right d -> d +fromCryptonDigest :: Hash.Digest Hash.MD5 -> MD5Digest +fromCryptonDigest = md5digestFromBS . BA.convert + -- | The 'Show' instance for 'MD5Digest' prints the underlying digest -- (without showing the newtype wrapper) -- @@ -65,7 +68,7 @@ instance ReadDigest MD5Digest where -- | Compute MD5 digest md5 :: BS.Lazy.ByteString -> MD5Digest -md5 = md5digestFromBS . MD5.hashlazy +md5 = fromCryptonDigest . Hash.hashlazy instance MemSize MD5Digest where memSize _ = 3 @@ -109,13 +112,13 @@ instance Ser.Serialize MD5Digest where -- will run in constant memory. -- lazyMD5 :: BS.Lazy.ByteString -> ByteStringWithMd5 -lazyMD5 = go MD5.init . BS.Lazy.toChunks +lazyMD5 = go Hash.hashInit . BS.Lazy.toChunks where - go :: MD5.Ctx -> [BS.ByteString] -> ByteStringWithMd5 + go :: Hash.Context Hash.MD5 -> [BS.ByteString] -> ByteStringWithMd5 go !md5ctx [] = - BsEndMd5 (md5digestFromBS (MD5.finalize md5ctx)) + BsEndMd5 (fromCryptonDigest (Hash.hashFinalize md5ctx)) go !md5ctx (block : blocks') = - BsChunk block (go (MD5.update md5ctx block) blocks') + BsChunk block (go (Hash.hashUpdate md5ctx block) blocks') -- | See 'lazyMD5' data ByteStringWithMd5 = BsChunk !BS.ByteString ByteStringWithMd5 diff --git a/src/Distribution/Server/Features/Security/Orphans.hs b/src/Distribution/Server/Features/Security/Orphans.hs index 14c76b860..e41703c08 100644 --- a/src/Distribution/Server/Features/Security/Orphans.hs +++ b/src/Distribution/Server/Features/Security/Orphans.hs @@ -13,7 +13,6 @@ import Control.DeepSeq import Data.SafeCopy import Data.Serialize import qualified Data.ByteString.Lazy as BS.L -import qualified Crypto.Sign.Ed25519 as Ed25519 -- hackage import Distribution.Server.Framework.MemSize @@ -71,13 +70,9 @@ instance MemSize (Some Sec.Key) where memSize (Some key) = memSize key instance MemSize (Sec.Key typ) where - memSize (Sec.KeyEd25519 pub pri) = memSize pub + memSize pri - -instance MemSize Ed25519.PublicKey where - memSize = memSize . Ed25519.unPublicKey - -instance MemSize Ed25519.SecretKey where - memSize = memSize . Ed25519.unSecretKey + memSize (Sec.KeyEd25519 _pub _pri) = + 5 {- ByteString overhead -} + 4 {- 32-byte public key -} + + 5 {- ByteString overhead -} + 8 {- 64-byte public key -} instance MemSize Sec.FileVersion where memSize (Sec.FileVersion v) = memSize v diff --git a/src/Distribution/Server/Features/Security/SHA256.hs b/src/Distribution/Server/Features/Security/SHA256.hs index 8bf7f44f7..62e95a60b 100644 --- a/src/Distribution/Server/Features/Security/SHA256.hs +++ b/src/Distribution/Server/Features/Security/SHA256.hs @@ -27,8 +27,8 @@ import qualified Data.ByteString.Char8 as BS.Char8 import qualified Data.ByteString.Lazy as BS.Lazy import qualified Data.Text.Encoding as T --- cryptohash -import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteArray as BA +import qualified Crypto.Hash as Hash -- hackage import Distribution.Server.Framework.MemSize @@ -49,6 +49,9 @@ sha256digestFromBS bs = case runGet getSHA256NoPfx bs of Left e -> error ("sha256digestFromBS: " ++ e) Right d -> d +fromCryptonDigest :: Hash.Digest Hash.SHA256 -> SHA256Digest +fromCryptonDigest = sha256digestFromBS . BA.convert + -- | 'Data.Serialize.Get' helper to read a raw 32byte SHA256Digest w/o -- any length-prefix getSHA256NoPfx :: Get SHA256Digest @@ -80,7 +83,7 @@ instance ReadDigest SHA256Digest where -- | Compute SHA256 digest sha256 :: BS.Lazy.ByteString -> SHA256Digest -sha256 = sha256digestFromBS . SHA256.hashlazy +sha256 = fromCryptonDigest . Hash.hashlazy instance MemSize SHA256Digest where memSize _ = 5 diff --git a/src/Distribution/Server/Features/UserSignup.hs b/src/Distribution/Server/Features/UserSignup.hs index fb771c078..21a85d3e9 100644 --- a/src/Distribution/Server/Features/UserSignup.hs +++ b/src/Distribution/Server/Features/UserSignup.hs @@ -43,7 +43,6 @@ import Network.Mail.Mime import Network.URI (URI(..), URIAuth(..)) import Graphics.Captcha import qualified Data.ByteString.Base64 as Base64 -import qualified Crypto.Hash.SHA256 as SHA256 import Data.String import Data.Char import Text.Read (readMaybe) @@ -51,6 +50,9 @@ import Data.Aeson import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Key as Key +import qualified Data.ByteArray as BA +import qualified Crypto.Hash as Hash + -- | A feature to allow open account signup, and password reset, -- both with email confirmation. @@ -270,7 +272,11 @@ userSignupFeature ServerEnv{serverBaseURI, serverCron} ++ "has been used already, or that it has expired."] hashTimeAndCaptcha :: UTCTime -> String -> BS.ByteString - hashTimeAndCaptcha timestamp captcha = Base64.encode (SHA256.hash (fromString (show timestamp ++ map toUpper captcha))) + hashTimeAndCaptcha timestamp captcha = + go (show timestamp ++ map toUpper captcha) + where + go = Base64.encode . BA.convert + . Hash.hashWith Hash.SHA256 . BS.pack makeCaptchaHash :: IO (UTCTime, BS.ByteString, BS.ByteString) makeCaptchaHash = do diff --git a/src/Distribution/Server/Users/AuthToken.hs b/src/Distribution/Server/Users/AuthToken.hs index 4a2174270..b1b5406ba 100644 --- a/src/Distribution/Server/Users/AuthToken.hs +++ b/src/Distribution/Server/Users/AuthToken.hs @@ -18,11 +18,13 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.ByteString.Short as BSS import qualified Data.ByteString.Base16 as BS16 -import qualified Crypto.Hash.SHA256 as SHA256 import Distribution.Pretty (Pretty(..)) import Distribution.Parsec (Parsec(..)) import qualified Distribution.Compat.CharParsing as P +import qualified Data.ByteArray as BA +import qualified Crypto.Hash as Hash + import Data.SafeCopy -- | Contains the original token which will be shown to the user @@ -38,7 +40,8 @@ newtype AuthToken = AuthToken BSS.ShortByteString convertToken :: OriginalToken -> AuthToken convertToken (OriginalToken bs) = - AuthToken $ BSS.toShort $ SHA256.hash $ getRawNonceBytes bs + AuthToken . BSS.toShort . BA.convert . Hash.hashWith Hash.SHA256 + $ getRawNonceBytes bs viewOriginalToken :: OriginalToken -> T.Text viewOriginalToken (OriginalToken ot) = T.pack $ renderNonce ot