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.

Author: frasertweedale

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

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

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

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

src/Distribution/Server/Features/UserSignup.hs

@@ -43,14 +43,16 @@ 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)
 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

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