Merge pull request #1500 from tweag/rev-types

Add *RevisionIx newtypes

Author: ysangkok

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell, BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Distribution.Server.Features.Core.State (
     -- * DB state
@@ -33,6 +34,7 @@ import Distribution.Server.Users.Types (UserId, UserName(..), UserInfo(..))
 import Distribution.Server.Users.Users (Users, lookupUserId)
 import Distribution.Server.Framework.MemSize
 
+import Data.Coerce (Coercible, coerce)
 import Data.Acid     (Query, Update, makeAcidic)
 import Data.SafeCopy (Migrate(..), base, extension, deriveSafeCopy)
 import Control.Monad.Reader
@@ -103,7 +105,7 @@ addPackage2 pkgid cabalfile uploadinfo@(timestamp, uid) username mtarball = do
       Nothing -> do
         let !pkginfo = mkPackageInfo pkgid cabalfile uploadinfo mtarball
             pkgindex'   = PackageIndex.insert pkginfo pkgindex
-            !pkgentry   = CabalFileEntry pkgid 0 timestamp uid username
+            !pkgentry   = CabalFileEntry pkgid (MetadataRevIx 0) timestamp uid username
             updatelog'  = fmap (Seq.|> pkgentry) updatelog
         State.put $! PackagesState pkgindex' updatelog'
         return (Just pkginfo)
@@ -116,7 +118,7 @@ addPackage3 !pkginfo (timestamp,uid) username entries = do
       Just _  -> return False
       Nothing -> do
         let pkgindex'   = PackageIndex.insert pkginfo pkgindex
-            !pkgentry   = CabalFileEntry (pkgInfoId pkginfo) 0 timestamp uid username
+            !pkgentry   = CabalFileEntry (pkgInfoId pkginfo) (MetadataRevIx 0) timestamp uid username
             updatelog'  = fmap (\ul -> foldr (\e s -> s Seq.|> e) ul (pkgentry:entries)) updatelog
         State.put $! PackagesState pkgindex' updatelog'
         return True
@@ -160,7 +162,7 @@ addPackageRevision2 pkgid cabalfile uploadinfo@(timestamp, uid) username = do
                                      `Vec.snoc` (cabalfile, uploadinfo)
             }
             pkgindex'   = PackageIndex.insert pkginfo' pkgindex
-            newrevision = Vec.length (pkgMetadataRevisions pkginfo)
+            newrevision = MetadataRevIx $ Vec.length (pkgMetadataRevisions pkginfo)
             !pkgentry   = CabalFileEntry pkgid newrevision timestamp uid username
             updatelog'  = fmap (Seq.|> pkgentry) updatelog
         State.put $! PackagesState pkgindex' updatelog'
@@ -172,7 +174,7 @@ addPackageRevision2 pkgid cabalfile uploadinfo@(timestamp, uid) username = do
               pkgTarballRevisions  = Vec.empty
             }
             pkgindex'   = PackageIndex.insert pkginfo pkgindex
-            !pkgentry   = CabalFileEntry pkgid 0 timestamp uid username
+            !pkgentry   = CabalFileEntry pkgid (MetadataRevIx 0) timestamp uid username
             updatelog'  = fmap (Seq.|> pkgentry) updatelog
         State.put $! PackagesState pkgindex' updatelog'
         return (Nothing, pkginfo)
@@ -279,11 +281,11 @@ initialUpdateLog oldExtras users pkgs =
       where
         pkgId = pkgInfoId pkgInfo
 
-    entryCabal :: PackageId -> (Int, (a, UploadInfo)) -> TarIndexEntry
+    entryCabal :: PackageId -> (MetadataRevIx, (a, UploadInfo)) -> TarIndexEntry
     entryCabal pkgId (revNo, (_cabalFile, (timestamp, uid))) =
         CabalFileEntry pkgId revNo timestamp uid (uidToName uid)
 
-    entryTUF :: PackageId -> (Int, (a, UploadInfo)) -> TarIndexEntry
+    entryTUF :: PackageId -> (TarballRevIx, (a, UploadInfo)) -> TarIndexEntry
     entryTUF pkgId (revNo, (_tarball, (timestamp, _uid))) =
         MetadataEntry pkgId revNo timestamp
 
@@ -295,8 +297,8 @@ initialUpdateLog oldExtras users pkgs =
     entryTimestamp (MetadataEntry  _ _ timestamp    ) = timestamp
     entryTimestamp (ExtraEntry     _ _ timestamp    ) = timestamp
 
-    vecToList :: Vec.Vector a -> [(Int, a)]
-    vecToList = zip [0..] . Vec.toList
+    vecToList :: Coercible Int ix => Vec.Vector a -> [(ix, a)]
+    vecToList = coerce . zip [(0 :: Int)..] . Vec.toList
 
 ------------------------------------------------------------------------------
 

src/Distribution/Server/Features/PackageInfoJSON.hs

@@ -38,7 +38,7 @@ import qualified Distribution.Server.Framework                as Framework
 import           Distribution.Server.Features.Core            (CoreFeature(..),
                                                                CoreResource(..))
 import qualified Distribution.Server.Features.PreferredVersions as Preferred
-import           Distribution.Server.Packages.Types           (CabalFileText(..), pkgSpecificRevision, pkgLatestRevision, pkgMaxRevision, pkgNumRevisions)
+import           Distribution.Server.Packages.Types           (CabalFileText(..), MetadataRevIx(..), pkgSpecificRevision, pkgLatestRevision, pkgMaxRevision, pkgNumRevisions)
 
 import Distribution.Utils.ShortText (fromShortText)
 import Data.Foldable (toList)
@@ -55,7 +55,7 @@ data PackageBasicDescription = PackageBasicDescription
   , pbd_description       :: !T.Text
   , pbd_author            :: !T.Text
   , pbd_homepage          :: !T.Text
-  , pbd_metadata_revision :: !Int
+  , pbd_metadata_revision :: !MetadataRevIx
   , pbd_uploaded_at       :: !UTCTime
   } deriving (Eq, Show)
 
@@ -69,7 +69,7 @@ data PackageBasicDescriptionDTO = PackageBasicDescriptionDTO
   , description       :: !T.Text
   , author            :: !T.Text
   , homepage          :: !T.Text
-  , metadata_revision :: !Int
+  , metadata_revision :: !MetadataRevIx
   , uploaded_at       :: !UTCTime
   , uploader          :: !UserName
   } deriving (Eq, Show)
@@ -173,7 +173,7 @@ getBasicDescription
   :: UTCTime
     -- ^ Time of upload
   -> CabalFileText
-  -> Int
+  -> MetadataRevIx
      -- ^ Metadata revision. This will be added to the resulting
      --   @PackageBasicDescription@
   -> Either String PackageBasicDescription
@@ -225,7 +225,7 @@ servePackageBasicDescription
   -> Framework.ServerPartE Framework.Response
 servePackageBasicDescription resource userFeature preferred dpath = do
 
-  let metadataRev :: Maybe Int = lookup "revision" dpath >>= Framework.fromReqURI
+  let metadataRev :: Maybe MetadataRevIx = lookup "revision" dpath >>= Framework.fromReqURI
 
   pkgid@(PackageIdentifier name version) <- packageInPath resource dpath
   guardValidPackageName resource name
@@ -238,7 +238,7 @@ servePackageBasicDescription resource userFeature preferred dpath = do
 
     fetchDescr
       :: PackageIdentifier
-      -> Maybe Int
+      -> Maybe MetadataRevIx
       -> Framework.ServerPartE Framework.Response
     fetchDescr pkgid metadataRev = do
       guardValidPackageId resource pkgid

src/Distribution/Server/Features/Security.hs

@@ -85,7 +85,7 @@ initSecurityFeature env = do
       case pkgLatestTarball pkgInfo of
         Nothing -> []
         Just (_tarball, (uploadTime, _uploadUserId), latestRev) ->
-          [MetadataEntry (pkgInfoId pkgInfo) latestRev uploadTime]
+          [MetadataEntry (pkgInfoId pkgInfo) (TarballRevIx latestRev) uploadTime]
 
 -- | The main security feature
 --

src/Distribution/Server/Packages/Index.hs

@@ -17,6 +17,7 @@ import Distribution.Server.Framework.MemSize
 
 import Distribution.Server.Packages.Types
          ( CabalFileText(..), PkgInfo(..)
+         , TarballRevIx, MetadataRevIx
          , pkgSpecificRevision
          , pkgLatestCabalFileText, pkgLatestUploadInfo
          )
@@ -57,7 +58,7 @@ data TarIndexEntry =
     -- can also be changed (this is used during mirroring, for instance).
     --
     -- The UTCTime and userName are used as file metadata in the tarball.
-    CabalFileEntry !PackageId !RevisionNo !UTCTime !UserId !UserName
+    CabalFileEntry !PackageId !MetadataRevIx !UTCTime !UserId !UserName
 
     -- | Package metadata
     --
@@ -69,16 +70,14 @@ data TarIndexEntry =
     -- Although we do not currently allow to change the upload time for package
     -- tarballs, but I'm not sure why not (TODO) and it's conceivable we may
     -- change this, so we record the original upload time.
-  | MetadataEntry !PackageId !RevisionNo !UTCTime
+  | MetadataEntry !PackageId !TarballRevIx !UTCTime
 
     -- | Additional entries that we add to the tarball
     --
     -- This is currently used for @preferred-versions@.
   | ExtraEntry !FilePath !LazyByteString !UTCTime
   deriving (Eq, Show)
 
-type RevisionNo = Int
-
 instance MemSize TarIndexEntry where
   memSize (CabalFileEntry a b c d e) = memSize5 a b c d e
   memSize (MetadataEntry  a b c)   = memSize3 a b c

src/Distribution/Server/Packages/Metadata.hs

@@ -24,8 +24,8 @@ import qualified Hackage.Security.TUF.FileMap as Sec.FileMap
 --
 -- Revisions numbers count from 0; we use the revision number as is for the
 -- TUF file version.
-computePkgMetadata :: PkgInfo   -- ^ Package
-                   -> Int       -- ^ Tarball revision
+computePkgMetadata :: PkgInfo       -- ^ Package
+                   -> TarballRevIx  -- ^ Tarball revision
                    -> (FilePath, BS.Lazy.ByteString)
 computePkgMetadata pkg revNo = (inIndexPkgMetadata pkgId, raw)
   where
@@ -35,9 +35,9 @@ computePkgMetadata pkg revNo = (inIndexPkgMetadata pkgId, raw)
     signed       = Sec.withSignatures' [] targets
     raw          = Sec.renderJSON_NoLayout signed
 
-pkgTarballTargets :: Int -> PackageIdentifier -> PkgTarball -> Sec.Targets
+pkgTarballTargets :: TarballRevIx -> PackageIdentifier -> PkgTarball -> Sec.Targets
 pkgTarballTargets revNo pkgId pkgTarball = Sec.Targets {
-      targetsVersion     = Sec.FileVersion (fromIntegral revNo)
+      targetsVersion     = Sec.FileVersion (fromIntegral $ getTarballRevIx revNo)
     , targetsExpires     = Sec.expiresNever
     , targetsTargets     = Sec.FileMap.fromList [
                                (inRepoPkgTarGz pkgId, secFileInfo pkgTarballGz)

src/Distribution/Server/Packages/Render.hs

@@ -87,7 +87,7 @@ data PackageRender = PackageRender {
     rendChangeLog    :: Maybe (FilePath, ETag, TarEntryOffset, FilePath),
     rendReadme       :: Maybe (FilePath, ETag, TarEntryOffset, FilePath),
     rendUploadInfo   :: (UTCTime, Maybe UserInfo),
-    rendUpdateInfo   :: Maybe (Int, UTCTime, Maybe UserInfo),
+    rendUpdateInfo   :: Maybe (MetadataRevIx, UTCTime, Maybe UserInfo),
     rendPkgUri       :: String,
     rendFlags        :: [PackageFlag],
     -- rendOther contains other useful fields which are merely strings, possibly empty
@@ -127,7 +127,7 @@ doPackageRender users info = PackageRender
     , rendUpdateInfo   = let maxrevision  = pkgMaxRevision info
                              (utime, uid) = pkgLatestUploadInfo info
                              uinfo        = Users.lookupUserId uid users
-                         in if maxrevision > 0
+                         in if maxrevision > MetadataRevIx 0
                               then Just (maxrevision, utime, uinfo)
                               else Nothing
     , rendPkgUri       = pkgUri

src/Distribution/Server/Packages/Types.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable,
              StandaloneDeriving, TemplateHaskell, TypeFamilies,
              RecordWildCards #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Server.Packages.Types
@@ -17,6 +19,7 @@ module Distribution.Server.Packages.Types where
 
 import Distribution.Server.Prelude
 
+import Distribution.Server.Framework (FromReqURI(..))
 import Distribution.Server.Users.Types (UserId(..))
 import Distribution.Server.Framework.BlobStorage (BlobId, BlobId_v0, BlobStorage)
 import Distribution.Server.Framework.Instances (PackageIdentifier_v0)
@@ -34,6 +37,7 @@ import Distribution.PackageDescription
 import Distribution.PackageDescription.Parsec
          ( parseGenericPackageDescription, runParseResult )
 
+import Data.Aeson (ToJSON)
 import Data.Serialize (Serialize)
 import Data.ByteString (StrictByteString)
 import Data.ByteString.Lazy (LazyByteString)
@@ -158,6 +162,22 @@ instance Package PkgInfo where
   Utility
 -------------------------------------------------------------------------------}
 
+newtype MetadataRevIx = MetadataRevIx { getMetadataRevIx :: Int }
+  deriving newtype (Eq, Ord, Show, MemSize, Read, FromReqURI, ToJSON, Serialize)
+
+instance SafeCopy MetadataRevIx where
+    getCopy = contain Serialize.get
+    putCopy = contain . Serialize.put
+    errorTypeName _ = "MetadataRevIx"
+
+newtype TarballRevIx = TarballRevIx { getTarballRevIx :: Int }
+  deriving newtype (Eq, Ord, Show, MemSize, Read, FromReqURI, ToJSON, Serialize)
+
+instance SafeCopy TarballRevIx where
+    getCopy = contain Serialize.get
+    putCopy = contain . Serialize.put
+    errorTypeName _ = "TarballRevIx"
+
 cabalFileString :: CabalFileText -> String
 cabalFileString = unpackUTF8Strict . cabalFileByteString
 
@@ -176,14 +196,14 @@ pkgOriginalUploadUser = snd . pkgOriginalUploadInfo
 pkgLatestRevision :: PkgInfo -> (CabalFileText, UploadInfo)
 pkgLatestRevision = Vec.last . pkgMetadataRevisions
 
-pkgSpecificRevision :: PkgInfo -> Int -> Maybe (CabalFileText, UploadInfo)
-pkgSpecificRevision pkg revno = pkgMetadataRevisions pkg Vec.!? revno
+pkgSpecificRevision :: PkgInfo -> MetadataRevIx -> Maybe (CabalFileText, UploadInfo)
+pkgSpecificRevision pkg (MetadataRevIx revno) = pkgMetadataRevisions pkg Vec.!? revno
 
 pkgAllRevisionsCabalFiles :: PkgInfo -> [CabalFileText]
 pkgAllRevisionsCabalFiles = fmap fst . Vec.toList . pkgMetadataRevisions
 
-pkgSpecificTarball :: PkgInfo -> Int -> Maybe (PkgTarball, UploadInfo)
-pkgSpecificTarball pkg revno = pkgTarballRevisions pkg Vec.!? revno
+pkgSpecificTarball :: PkgInfo -> TarballRevIx -> Maybe (PkgTarball, UploadInfo)
+pkgSpecificTarball pkg (TarballRevIx revno) = pkgTarballRevisions pkg Vec.!? revno
 
 pkgAllTarballs :: PkgInfo -> [(PkgTarball, UploadInfo)]
 pkgAllTarballs = Vec.toList . pkgTarballRevisions
@@ -206,8 +226,8 @@ pkgLatestUploadUser = snd . pkgLatestUploadInfo
 pkgNumRevisions :: PkgInfo -> Int
 pkgNumRevisions = Vec.length . pkgMetadataRevisions
 
-pkgMaxRevision :: PkgInfo -> Int
-pkgMaxRevision = subtract 1 . pkgNumRevisions
+pkgMaxRevision :: PkgInfo -> MetadataRevIx
+pkgMaxRevision = MetadataRevIx . subtract 1 . pkgNumRevisions
 
 -- | The latest tarball for a package (if any)
 --
@@ -360,3 +380,4 @@ instance Migrate PkgInfo where
       }
 
 deriveSafeCopy 4 'extension ''PkgInfo
+

src/Distribution/Server/Pages/PackageFromTemplate.hs

@@ -269,7 +269,7 @@ packagePageTemplate render
       "" -> "None provided"
       x -> x
 
-    renderUpdateInfo :: Int -> UTCTime -> Maybe UserInfo -> Html
+    renderUpdateInfo :: MetadataRevIx -> UTCTime -> Maybe UserInfo -> Html
     renderUpdateInfo revisionNo utime uinfo =
         anchor ! [href revisionsURL] << ("Revision " +++ show revisionNo)
         +++ " made " +++