Skip to content

Commit bafec07

Browse files
snoybergsnoyberg
committed
Store non-base-16 values internally
1 parent b57a83a commit bafec07

4 files changed

Lines changed: 41 additions & 9 deletions

File tree

‎src/Stack/PackageIndex.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -371,7 +371,7 @@ getPackageCaches = do
371371
result <- liftM mconcat $ forM (configPackageIndices config) $ \index -> do
372372
fp <- configPackageIndexCache (indexName index)
373373
PackageCache pis <-
374-
$(versionedDecodeOrLoad (storeVersionConfig "pkg-v5" "InumGzcLY3PEJmcTS_Apdy7pRGI="
374+
$(versionedDecodeOrLoad (storeVersionConfig "pkg-v5" "A607WaDwhg5VVvZTxNgU9g52DO8="
375375
:: VersionConfig (PackageCache ())))
376376
fp
377377
(populateCache index)

‎src/Stack/StaticBytes.hs‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ import Foreign.ForeignPtr
3535
import Foreign.Storable
3636
import Data.Bits
3737
import qualified Data.Primitive.ByteArray as BA
38+
import Data.ByteArray
3839

3940
newtype Bytes8 = Bytes8 Word64
4041
deriving (Eq, Ord, Generic, NFData, Hashable, Data, Store)
@@ -170,6 +171,25 @@ instance StaticBytes Bytes128 where
170171
toWordsS (Bytes128 b1 b2) = toWordsS b1 . toWordsS b2
171172
usePeekS off f = Bytes128 <$> usePeekS off f <*> usePeekS (off + 64) f
172173

174+
instance ByteArrayAccess Bytes8 where
175+
length _ = 8
176+
withByteArray = withByteArrayS
177+
instance ByteArrayAccess Bytes16 where
178+
length _ = 16
179+
withByteArray = withByteArrayS
180+
instance ByteArrayAccess Bytes32 where
181+
length _ = 32
182+
withByteArray = withByteArrayS
183+
instance ByteArrayAccess Bytes64 where
184+
length _ = 64
185+
withByteArray = withByteArrayS
186+
instance ByteArrayAccess Bytes128 where
187+
length _ = 128
188+
withByteArray = withByteArrayS
189+
190+
withByteArrayS :: StaticBytes sbytes => sbytes -> (Ptr p -> IO a) -> IO a
191+
withByteArrayS sbytes = withByteArray (fromStatic sbytes :: ByteString)
192+
173193
toStaticExact
174194
:: forall dbytes sbytes.
175195
(DynamicBytes dbytes, StaticBytes sbytes)

‎src/Stack/Types/BuildPlan.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -283,7 +283,7 @@ instance Store LoadedSnapshot
283283
instance NFData LoadedSnapshot
284284

285285
loadedSnapshotVC :: VersionConfig LoadedSnapshot
286-
loadedSnapshotVC = storeVersionConfig "ls-v4" "SAac9cP0PrUmpJ7zA3mhPVK2-zg="
286+
loadedSnapshotVC = storeVersionConfig "ls-v4" "a_ljrJRo8hA_-gcIDP9c6NXJ2pE="
287287

288288
-- | Information on a single package for the 'LoadedSnapshot' which
289289
-- can be installed.

‎src/Stack/Types/PackageIdentifier.hs‎

Lines changed: 19 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,8 @@ import Crypto.Hash.Conduit (hashFile)
4141
import Crypto.Hash as Hash (hashlazy, Digest, SHA256)
4242
import Data.Aeson.Extended
4343
import Data.Attoparsec.Text as A
44-
import qualified Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16))
44+
import qualified Data.ByteArray
45+
import qualified Data.ByteArray.Encoding as Mem
4546
import qualified Data.ByteString.Lazy as L
4647
import qualified Data.Text as T
4748
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
@@ -117,12 +118,23 @@ newtype CabalHash = CabalHash { unCabalHash :: StaticSHA256 }
117118

118119
-- | A SHA256 hash, stored in a static size for more efficient
119120
-- serialization with store.
120-
newtype StaticSHA256 = StaticSHA256 Bytes64
121+
newtype StaticSHA256 = StaticSHA256 Bytes32
121122
deriving (Generic, Show, Eq, NFData, Data, Typeable, Ord, Hashable, Store)
122123

123124
-- | Generate a 'StaticSHA256' value from a base16-encoded SHA256 hash.
124-
mkStaticSHA256FromText :: Text -> Either StaticBytesException StaticSHA256
125-
mkStaticSHA256FromText = fmap StaticSHA256 . toStaticExact . encodeUtf8
125+
mkStaticSHA256FromText :: Text -> Either SomeException StaticSHA256
126+
mkStaticSHA256FromText t =
127+
mapLeft (toException . stringException) (Mem.convertFromBase Mem.Base16 (encodeUtf8 t))
128+
>>= either (Left . toE) (Right . StaticSHA256)
129+
. toStaticExact
130+
. (id :: ByteString -> ByteString)
131+
where
132+
toE e = toException $ stringException $ concat
133+
[ "Unable to convert "
134+
, show t
135+
, " into SHA256: "
136+
, show e
137+
]
126138

127139
-- | Generate a 'StaticSHA256' value from the contents of a file.
128140
mkStaticSHA256FromFile :: MonadIO m => Path Abs File -> m StaticSHA256
@@ -133,18 +145,18 @@ fromDigest digest
133145
= StaticSHA256
134146
$ either impureThrow id
135147
$ toStaticExact
136-
(Mem.convertToBase Mem.Base16 digest :: ByteString)
148+
(Data.ByteArray.convert digest :: ByteString)
137149

138150
-- | Convert a 'StaticSHA256' into a base16-encoded SHA256 hash.
139151
staticSHA256ToText :: StaticSHA256 -> Text
140152
staticSHA256ToText = decodeUtf8 . staticSHA256ToBase16
141153

142154
-- | Convert a 'StaticSHA256' into a base16-encoded SHA256 hash.
143155
staticSHA256ToBase16 :: StaticSHA256 -> ByteString
144-
staticSHA256ToBase16 (StaticSHA256 x) = fromStatic x
156+
staticSHA256ToBase16 (StaticSHA256 x) = Mem.convertToBase Mem.Base16 x
145157

146158
-- | Generate a 'CabalHash' value from a base16-encoded SHA256 hash.
147-
mkCabalHashFromSHA256 :: Text -> Either StaticBytesException CabalHash
159+
mkCabalHashFromSHA256 :: Text -> Either SomeException CabalHash
148160
mkCabalHashFromSHA256 = fmap CabalHash . mkStaticSHA256FromText
149161

150162
-- | Convert a 'CabalHash' into a base16-encoded SHA256 hash.

0 commit comments

Comments
 (0)