From 76ce99add43ffd49d9a399ecafb02488246bf284 Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Tue, 24 Sep 2019 13:00:42 +0300
Subject: [PATCH] Add Distribution.Compat.MD5
---
Cabal/Cabal.cabal | 1 +
Cabal/Distribution/Compat/MD5.hs | 50 +++++++++++++++++++
.../Distribution/PackageDescription/Quirks.hs | 20 +++-----
3 files changed, 57 insertions(+), 14 deletions(-)
create mode 100644 Cabal/Distribution/Compat/MD5.hs
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 73ab549f0f..fa09f12338 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -531,6 +531,7 @@ library
Distribution.Utils.Base62
Distribution.Compat.CopyFile
Distribution.Compat.GetShortPathName
+ Distribution.Compat.MD5
Distribution.Compat.MonadFail
Distribution.Compat.Prelude
Distribution.Compat.SnocList
diff --git a/Cabal/Distribution/Compat/MD5.hs b/Cabal/Distribution/Compat/MD5.hs
new file mode 100644
index 0000000000..6189aa9ec2
--- /dev/null
+++ b/Cabal/Distribution/Compat/MD5.hs
@@ -0,0 +1,50 @@
+module Distribution.Compat.MD5 (
+ MD5,
+ showMD5,
+ md5,
+ -- * Binary
+ binaryPutMD5,
+ binaryGetMD5,
+ ) where
+
+import Data.Binary (Get, Put)
+import Data.Binary.Get (getWord64le)
+import Data.Binary.Put (putWord64le)
+import Foreign.Ptr (castPtr)
+import GHC.Fingerprint (Fingerprint (..), fingerprintData)
+import Numeric (showHex)
+import System.IO.Unsafe (unsafeDupablePerformIO)
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BS
+
+type MD5 = Fingerprint
+
+-- | Show 'MD5' in human readable form
+--
+-- >>> showMD5 (Fingerprint 123 456)
+-- "000000000000007b00000000000001c8"
+--
+-- >>> showMD5 $ md5 $ BS.pack [0..127]
+-- "37eff01866ba3f538421b30b7cbefcac"
+--
+showMD5 :: MD5 -> String
+showMD5 (Fingerprint a b) = pad a' ++ pad b' where
+ a' = showHex a ""
+ b' = showHex b ""
+ pad s = replicate (16 - length s) '0' ++ s
+
+md5 :: BS.ByteString -> MD5
+md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
+ fingerprintData (castPtr ptr) len
+
+binaryPutMD5 :: MD5 -> Put
+binaryPutMD5 (Fingerprint a b) = do
+ putWord64le a
+ putWord64le b
+
+binaryGetMD5 :: Get MD5
+binaryGetMD5 = do
+ a <- getWord64le
+ b <- getWord64le
+ return (Fingerprint a b)
diff --git a/Cabal/Distribution/PackageDescription/Quirks.hs b/Cabal/Distribution/PackageDescription/Quirks.hs
index 37d75e8aea..e00d152701 100644
--- a/Cabal/Distribution/PackageDescription/Quirks.hs
+++ b/Cabal/Distribution/PackageDescription/Quirks.hs
@@ -1,19 +1,17 @@
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
-- |
--
-- @since 2.2.0.0
module Distribution.PackageDescription.Quirks (patchQuirks) where
-import Prelude ()
-import Distribution.Compat.Prelude
-import GHC.Fingerprint (Fingerprint (..), fingerprintData)
-import Foreign.Ptr (castPtr)
-import System.IO.Unsafe (unsafeDupablePerformIO)
+import Distribution.Compat.MD5
+import Distribution.Compat.Prelude
+import GHC.Fingerprint (Fingerprint (..))
+import Prelude ()
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Unsafe as BS
-import qualified Data.Map as Map
+import qualified Data.Map as Map
-- | Patch legacy @.cabal@ file contents to allow parsec parser to accept
-- all of Hackage.
@@ -30,13 +28,7 @@ patchQuirks bs = case Map.lookup (BS.take 256 bs, md5 bs) patches of
where
output = f bs
-md5 :: BS.ByteString -> Fingerprint
-md5 bs = unsafeDupablePerformIO $ BS.unsafeUseAsCStringLen bs $ \(ptr, len) ->
- fingerprintData (castPtr ptr) len
-
-- | 'patches' contains first 256 bytes, pre- and post-fingerprints and a patch function.
---
---
patches :: Map.Map (BS.ByteString, Fingerprint) (Fingerprint, BS.ByteString -> BS.ByteString)
patches = Map.fromList
-- http://hackage.haskell.org/package/unicode-transforms-0.3.3
--
GitLab