Skip to content

Commit 36f2763

Browse files
BodigrimBodigrim
committed
Make CabalFileText to wrap a strict ByteString, not a lazy one
Cabal files are definitely small enough to use a strict ByteString. This eliminates one possible source of issues with lazy IO.
1 parent 6399f29 commit 36f2763

15 files changed

Lines changed: 59 additions & 63 deletions

File tree

‎src/Distribution/Server/Features/Core.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ import qualified Codec.Compression.GZip as GZip
2727
import Data.Aeson (Value (..), toJSON)
2828
import qualified Data.Aeson.Key as Key
2929
import qualified Data.Aeson.KeyMap as KeyMap
30-
import Data.ByteString.Lazy (LazyByteString)
30+
import Data.ByteString.Lazy (LazyByteString, fromStrict)
3131
import qualified Data.Foldable as Foldable
3232
import qualified Data.Text as Text
3333
import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -721,7 +721,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
721721
-- check that the cabal name matches the package
722722
guard (lookup "cabal" dpath == Just (display $ packageName pkginfo))
723723
let (fileRev, (utime, _uid)) = pkgLatestRevision pkginfo
724-
cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
724+
cabalfile = Resource.CabalFile (fromStrict $ cabalFileByteString fileRev) utime
725725
return $ toResponse cabalfile
726726

727727
serveCabalFileRevisionsList :: DynamicPath -> ServerPartE Response
@@ -731,7 +731,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
731731
let revisions = pkgMetadataRevisions pkginfo
732732
revisionToObj rev (cabalFileText, (utime, uid)) =
733733
let uname = userIdToName users uid
734-
hash = sha256 (cabalFileByteString cabalFileText)
734+
hash = sha256 (fromStrict $ cabalFileByteString cabalFileText)
735735
in
736736
Object $ KeyMap.fromList
737737
[ (Key.fromString "number", Number (fromIntegral rev))
@@ -750,7 +750,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
750750
case mrev >>= \rev -> revisions Vec.!? rev of
751751
Just (fileRev, (utime, _uid)) -> return $ toResponse cabalfile
752752
where
753-
cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
753+
cabalfile = Resource.CabalFile (fromStrict $ cabalFileByteString fileRev) utime
754754
Nothing -> errNotFound "Package revision not found"
755755
[MText "Cannot parse revision, or revision out of range."]
756756

‎src/Distribution/Server/Features/Core/Backup.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,7 @@ doPackageImport (PartialIndex packages updatelog) entry = case entry of
9898
list <- importCSV "tarball.csv" bs >>= importTarballMetadata fp
9999
return $ partial { partialTarballUpload = list }
100100
[other] | Just version <- extractVersion other (packageName pkgId) ".cabal" ->
101-
return $ partial { partialCabal = (version, CabalFileText bs):partialCabal partial }
101+
return $ partial { partialCabal = (version, CabalFileText $ BS.toStrict bs) : partialCabal partial }
102102
_ -> return partial
103103
return $! PartialIndex (Map.insert pkgId partial' packages) updatelog
104104
BackupBlob filename@["package",pkgStr,other] blobId -> do
@@ -198,7 +198,7 @@ partialToFullPkg (pkgId, PartialPkg{..}) = do
198198
filename = display pkgId ++ ".cabal"
199199

200200
case runParseResult $ parseGenericPackageDescription $
201-
BS.toStrict $ cabalFileByteString latestCabalFile of
201+
cabalFileByteString latestCabalFile of
202202
(_, Left (_, errs)) -> fail $ unlines (map (showPError filename) $ toList errs)
203203
(_, Right _) -> return ()
204204

@@ -322,8 +322,8 @@ cabalListToExport pkgId cabalInfos =
322322
cabalName = display (packageName pkgId) ++ ".cabal"
323323

324324
blobEntry :: (Int, CabalFileText) -> BackupEntry
325-
blobEntry (0, CabalFileText bs) = BackupByteString (pkgPath pkgId cabalName) bs
326-
blobEntry (n, CabalFileText bs) = BackupByteString (pkgPath pkgId (cabalName ++ "-" ++ show n)) bs
325+
blobEntry (0, CabalFileText bs) = BackupByteString (pkgPath pkgId cabalName) (BS.fromStrict bs)
326+
blobEntry (n, CabalFileText bs) = BackupByteString (pkgPath pkgId (cabalName ++ "-" ++ show n)) (BS.fromStrict bs)
327327

328328
cabalMetadata :: CSV
329329
cabalMetadata =

‎src/Distribution/Server/Features/EditCabalFiles.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Distribution.Server.Util.CabalRevisions
2323
(Change(..), diffCabalRevisions, insertRevisionField)
2424
import Text.StringTemplate.Classes (SElem(SM))
2525

26+
import Data.ByteString (StrictByteString)
2627
import Data.ByteString.Lazy (LazyByteString)
2728
import qualified Data.ByteString.Lazy as BS.L
2829
import qualified Data.Map as Map
@@ -84,7 +85,7 @@ editCabalFilesFeature _env templates
8485
ok $ toResponse $ template
8586
[ "pkgid" $= pkgid
8687
, "cabalfile" $= insertRevisionField (pkgNumRevisions pkg)
87-
(cabalFileByteString (pkgLatestCabalFileText pkg))
88+
(BS.L.fromStrict (cabalFileByteString (pkgLatestCabalFileText pkg)))
8889
]
8990

9091
serveEditCabalFilePost :: DynamicPath -> ServerPartE Response
@@ -98,11 +99,11 @@ editCabalFilesFeature _env templates
9899
uid <- guardAuthorised [ InGroup (maintainersGroup pkgname)
99100
, InGroup trusteesGroup ]
100101
let oldVersion = cabalFileByteString (pkgLatestCabalFileText pkg)
101-
newRevision <- getCabalFile
102+
newRevision <- BS.L.toStrict <$> getCabalFile
102103
shouldPublish <- getPublish
103104
case diffCabalRevisionsByteString oldVersion newRevision of
104105
Left errs ->
105-
responseTemplate template pkgid newRevision
106+
responseTemplate template pkgid (BS.L.fromStrict newRevision)
106107
shouldPublish [errs] []
107108

108109
Right changes
@@ -117,7 +118,7 @@ editCabalFilesFeature _env templates
117118
, "changes" $= changes
118119
]
119120
| otherwise ->
120-
responseTemplate template pkgid newRevision
121+
responseTemplate template pkgid (BS.L.fromStrict newRevision)
121122
shouldPublish [] changes
122123

123124
where
@@ -141,9 +142,9 @@ editCabalFilesFeature _env templates
141142
-- | Wrapper around 'diffCabalRevisions' which operates on
142143
-- 'LazyByteString' decoded with lenient UTF8 and with any leading BOM
143144
-- stripped.
144-
diffCabalRevisionsByteString :: LazyByteString -> LazyByteString -> Either String [Change]
145+
diffCabalRevisionsByteString :: StrictByteString -> StrictByteString -> Either String [Change]
145146
diffCabalRevisionsByteString oldRevision newRevision =
146-
maybe (diffCabalRevisions (BS.L.toStrict oldRevision) (BS.L.toStrict newRevision))
147+
maybe (diffCabalRevisions oldRevision newRevision)
147148
Left
148149
parseSpecVerCheck
149150
where

‎src/Distribution/Server/Features/Html.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ import qualified Data.Map as Map
6868
import qualified Data.Set as Set
6969
import qualified Data.Vector as Vec
7070
import qualified Data.Text as T
71-
import qualified Data.ByteString.Lazy as BS (LazyByteString)
71+
import qualified Data.ByteString.Lazy as BS (LazyByteString, fromStrict)
7272
import qualified Network.URI as URI
7373

7474
import Text.XHtml.Strict
@@ -812,9 +812,9 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
812812
start [] = []
813813
start (curr:rest) = go curr rest
814814

815-
go curr [] = [(sha256 (cabalFileByteString (fst curr)), [])]
815+
go curr [] = [(sha256 (BS.fromStrict (cabalFileByteString (fst curr))), [])]
816816
go curr (prev:rest) =
817-
( sha256 (cabalFileByteString (fst curr))
817+
( sha256 (BS.fromStrict (cabalFileByteString (fst curr)))
818818
, changes curr prev )
819819
: go prev rest
820820

‎src/Distribution/Server/Features/Mirror.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -243,12 +243,12 @@ mirrorFeature ServerEnv{serverBlobStore = store}
243243
cabalPut dpath = do
244244
uid <- guardMirrorGroup
245245
pkgid :: PackageId <- packageInPath dpath
246-
fileContent <- expectTextPlain
246+
fileContent <- BS.L.toStrict <$> expectTextPlain
247247
time <- liftIO getCurrentTime
248248
let uploadData = (time, uid)
249249
filename = display pkgid <.> "cabal"
250250

251-
case runParseResult $ parseGenericPackageDescription $ BS.L.toStrict fileContent of
251+
case runParseResult $ parseGenericPackageDescription fileContent of
252252
(_, Left (_, err NE.:| _)) -> badRequest (toResponse $ showPError filename err)
253253
(_, Right pkg) | pkgid /= packageId pkg ->
254254
errBadRequest "Wrong package Id"

‎src/Distribution/Server/Features/PackageCandidates.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ import Distribution.Text
4141
import Distribution.Package
4242
import Distribution.Version
4343

44+
import qualified Data.ByteString.Lazy as BS (toStrict, fromStrict)
4445
import qualified Data.Text as T
4546
import qualified Text.XHtml.Strict as XHtml
4647
import Text.XHtml.Strict ((<<), (!))
@@ -381,7 +382,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
381382
pkg <- packageInPath dpath >>= lookupCandidateId
382383
guard (lookup "cabal" dpath == Just (display $ packageName pkg))
383384
let (fileRev, (utime, _uid)) = pkgLatestRevision (candPkgInfo pkg)
384-
cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
385+
cabalfile = Resource.CabalFile (BS.fromStrict (cabalFileByteString fileRev)) utime
385386
return $ toResponse cabalfile
386387

387388
uploadCandidate :: (PackageId -> Bool) -> ServerPartE CandPkgInfo
@@ -394,7 +395,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
394395
now <- liftIO getCurrentTime
395396
let (UploadResult pkg pkgStr _) = uresult
396397
pkgid = packageId pkg
397-
cabalfile = CabalFileText pkgStr
398+
cabalfile = CabalFileText $ BS.toStrict pkgStr
398399
uploadinfo = (now, uid)
399400
candidate = CandPkgInfo {
400401
candPkgInfo = PkgInfo {
@@ -451,7 +452,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
451452
-- run filters
452453
let pkgInfo = candPkgInfo candidate
453454
uresult = UploadResult (pkgDesc pkgInfo)
454-
(cabalFileByteString (pkgLatestCabalFileText pkgInfo))
455+
(BS.fromStrict (cabalFileByteString (pkgLatestCabalFileText pkgInfo)))
455456
(candWarnings candidate)
456457
time <- liftIO getCurrentTime
457458
let uploadInfo = (time, uid)

‎src/Distribution/Server/Features/PackageInfoJSON.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,6 @@ import Distribution.Server.Prelude
1919
import qualified Data.Aeson as Aeson
2020
import Data.Aeson ((.=))
2121
import qualified Data.Aeson.Key as Key
22-
import qualified Data.ByteString.Lazy.Char8 as BS (toStrict)
2322
import qualified Data.Map.Strict as Map
2423
import qualified Data.Text as T
2524
import qualified Data.Vector as Vector
@@ -181,7 +180,7 @@ getBasicDescription
181180
-- @PackageBasicDescription@
182181
-> Either String PackageBasicDescription
183182
getBasicDescription uploadedAt (CabalFileText cf) metadataRev =
184-
let parseResult = PkgDescr.parseGenericPackageDescription (BS.toStrict cf)
183+
let parseResult = PkgDescr.parseGenericPackageDescription cf
185184
in case PkgDescr.runParseResult parseResult of
186185
(_, Right pkg) -> let
187186
pkgd = PkgDescr.packageDescription pkg

‎src/Distribution/Server/Features/Upload.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ import Data.Maybe (fromMaybe)
2929
import Data.List (dropWhileEnd, intersperse)
3030
import Data.Time.Clock (getCurrentTime)
3131
import Data.Function (fix)
32-
import Data.ByteString.Lazy (LazyByteString)
32+
import Data.ByteString.Lazy (LazyByteString, toStrict)
3333

3434
import Distribution.Package
3535
import Distribution.PackageDescription (GenericPackageDescription)
@@ -302,7 +302,7 @@ uploadFeature ServerEnv{serverBlobStore = store}
302302
now <- liftIO getCurrentTime
303303
let (UploadResult pkg pkgStr _) = uresult
304304
pkgid = packageId pkg
305-
cabalfile = CabalFileText pkgStr
305+
cabalfile = CabalFileText $ toStrict pkgStr
306306
uploadinfo = (now, uid)
307307
success <- updateAddPackage pkgid cabalfile uploadinfo (Just tarball)
308308
if success

‎src/Distribution/Server/Packages/Index.hs‎

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -24,15 +24,12 @@ import Distribution.Server.Users.Users
2424
( Users, userIdToName )
2525
import Distribution.Server.Users.Types
2626
( UserId(..), UserName(..) )
27-
import Distribution.Server.Util.ParseSpecVer
2827

2928
import Distribution.Text
3029
( display )
3130
import Distribution.Types.PackageName
3231
import Distribution.Package
3332
( Package, PackageId, packageName, packageVersion )
34-
import Distribution.CabalSpecVersion
35-
( pattern CabalSpecV2_0 )
3633
import Data.Time.Clock
3734
( UTCTime )
3835
import Data.Time.Clock.POSIX
@@ -43,7 +40,7 @@ import Data.SafeCopy (base, deriveSafeCopy)
4340
import Data.Map (Map)
4441
import qualified Data.Map as Map
4542
import qualified Data.Vector as Vec
46-
import Data.ByteString.Lazy (LazyByteString)
43+
import Data.ByteString.Lazy (LazyByteString, fromStrict)
4744
import System.FilePath.Posix
4845
import Data.Maybe (mapMaybe)
4946

@@ -107,7 +104,7 @@ writeIncremental pkgs =
107104
tarPath <- either (const Nothing) Just $
108105
Tar.toTarPath False fileName
109106
let !tarEntry = addTimestampAndOwner timestamp userid username $
110-
Tar.fileEntry tarPath cabalfile
107+
Tar.fileEntry tarPath $ fromStrict cabalfile
111108
return tarEntry
112109
where
113110
pkgname = unPackageName (packageName pkgid)
@@ -175,7 +172,7 @@ legacyExtras = go Map.empty
175172
-- files for a package), and does not contain the TUF files.
176173
writeLegacy :: Users -> Map String (LazyByteString, UTCTime) -> PackageIndex PkgInfo -> LazyByteString
177174
writeLegacy users =
178-
writeLegacyAux (cabalFileByteString . pkgLatestCabalFileText) setModTime
175+
writeLegacyAux (fromStrict . cabalFileByteString . pkgLatestCabalFileText) setModTime
179176
. extraEntries
180177
where
181178
setModTime pkgInfo entry =

‎src/Distribution/Server/Packages/Types.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ import Distribution.Server.Users.Types (UserId(..))
2121
import Distribution.Server.Framework.BlobStorage (BlobId, BlobId_v0, BlobStorage)
2222
import Distribution.Server.Framework.Instances (PackageIdentifier_v0)
2323
import Distribution.Server.Framework.MemSize
24-
import Distribution.Server.Util.Parse (unpackUTF8)
24+
import Distribution.Server.Util.Parse (unpackUTF8Strict)
2525
import Distribution.Server.Features.Security.Orphans ()
2626
import Distribution.Server.Features.Security.MD5
2727
import Distribution.Server.Features.Security.SHA256
@@ -35,6 +35,7 @@ import Distribution.PackageDescription.Parsec
3535
( parseGenericPackageDescription, runParseResult )
3636

3737
import Data.Serialize (Serialize)
38+
import Data.ByteString (StrictByteString)
3839
import Data.ByteString.Lazy (LazyByteString)
3940
import Data.Time.Clock (UTCTime(..))
4041
import Data.Time.Calendar (Day(..))
@@ -47,7 +48,9 @@ import qualified Data.Vector as Vec
4748
Datatypes
4849
-------------------------------------------------------------------------------}
4950

50-
newtype CabalFileText = CabalFileText { cabalFileByteString :: LazyByteString }
51+
-- | Cabal files are definitely small enough to use a strict ByteString.
52+
-- This eliminates one possible source of issues with lazy IO.
53+
newtype CabalFileText = CabalFileText { cabalFileByteString :: StrictByteString }
5154
deriving (Eq, MemSize)
5255

5356
-- | The information we keep about a particular version of a package.
@@ -156,7 +159,7 @@ instance Package PkgInfo where
156159
-------------------------------------------------------------------------------}
157160

158161
cabalFileString :: CabalFileText -> String
159-
cabalFileString = unpackUTF8 . cabalFileByteString
162+
cabalFileString = unpackUTF8Strict . cabalFileByteString
160163

161164
pkgOriginalRevision :: PkgInfo -> (CabalFileText, UploadInfo)
162165
pkgOriginalRevision = Vec.head . pkgMetadataRevisions
@@ -208,7 +211,7 @@ pkgLatestTarball pkginfo =
208211
pkgDesc :: PkgInfo -> GenericPackageDescription
209212
pkgDesc pkgInfo =
210213
case runParseResult $ parseGenericPackageDescription $
211-
BS.L.toStrict $ cabalFileByteString $ fst $
214+
cabalFileByteString $ fst $
212215
pkgLatestRevision pkgInfo of
213216
-- We only make PkgInfos with parsable pkgDatas, so if it
214217
-- doesn't parse then something has gone wrong.
@@ -219,7 +222,7 @@ pkgDesc pkgInfo =
219222
pkgDescMaybe :: PkgInfo -> Maybe GenericPackageDescription
220223
pkgDescMaybe pkgInfo =
221224
case runParseResult $ parseGenericPackageDescription $
222-
BS.L.toStrict $ cabalFileByteString $ fst $
225+
cabalFileByteString $ fst $
223226
pkgLatestRevision pkgInfo of
224227
-- We only make PkgInfos with parsable pkgDatas, so if it
225228
-- doesn't parse then something has gone wrong.

0 commit comments

Comments
 (0)