hackage-security 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+135/−69 lines, 6 filesdep +cryptohashdep +networkdep −SHAPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptohash, network

Dependencies removed: SHA

API changes (from Hackage documentation)

Files

• hackage-security.cabal +46/−5
• src/Hackage/Security/Client.hs +19/−18
• src/Hackage/Security/Client/Repository/Remote.hs +61/−35
• src/Hackage/Security/Key.hs +3/−3
• src/Hackage/Security/TUF/FileInfo.hs +3/−5
• src/Hackage/Security/Util/JSON.hs +3/−3

@@ -1,5 +1,5 @@ name:                hackage-security-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Hackage security library description:         The hackage security library provides both server and                      client utilities for securing the Hackage package server@@ -19,7 +19,7 @@                      "Hackage.Security.Server" is the main entry point for                      servers (the typical example being @hackage-server@).                      .-                     This is a beta release. +                     This is a beta release. license:             BSD3 license-file:        LICENSE author:              Edsko de Vries@@ -33,6 +33,10 @@   description: Are we using base 4.8 or later?   manual: False +flag use-network-uri+  description: Are we using network-uri?+  manual: False+ library   -- Most functionality is exported through the top-level entry points .Client   -- and .Server; the other exported modules are intended for qualified imports.@@ -83,15 +87,14 @@                        -- so that we can compile with the version of bytestring                        -- that comes with ghc for ghc < 7.8                        bytestring        >= 0.10.2 && < 0.11,-                       Cabal             >= 1.12   && < 1.23,+                       Cabal             >= 1.12   && < 1.25,                        containers        >= 0.4    && < 0.6,                        directory         >= 1.1    && < 1.3,                        ed25519           >= 0.0    && < 0.1,                        filepath          >= 1.2    && < 1.5,                        mtl               >= 2.2    && < 2.3,-                       network-uri       >= 2.6    && < 2.7,                        parsec            >= 3.1    && < 3.2,-                       SHA               >= 1.6    && < 1.7,+                       cryptohash        >= 0.11   && < 0.12,                        -- version 0.4.2 of tar introduces TarIndex                        tar               >= 0.4.2  && < 0.5,                        time              >= 1.2    && < 1.6,@@ -134,6 +137,44 @@     build-depends: base >= 4.8   else     build-depends: old-locale >= 1.0++  -- The URI type got split out off the network package after version 2.5, and+  -- moved to a separate network-uri package. Since we don't need the rest of+  -- network here, it would suffice to rely only on network-uri:+  --+  -- > if flag(use-network-uri)+  -- >   build-depends: network-uri >= 2.6 && < 2.7+  -- > else+  -- >   build-depends: network     >= 2.5 && < 2.6+  --+  -- However, if we did the same in hackage-security-HTTP, Cabal would consider+  -- those two flag choices (hackage-security:use-network-uri and+  -- hackage-security-HTTP:use-network-uri) to be completely independent; but+  -- they aren't: if it links hackage-security against network-uri and+  -- hackage-security-HTTP against network, we will get type errors when+  -- hackage-security-HTTP tries to pass a URI to hackage-security.+  --+  -- It might seem we can solve this problem by re-exporting the URI type in+  -- hackage-security and avoid the dependency in hackage-security-HTTP+  -- altogether. However, this merely shifts the problem: hackage-security-HTTP+  -- relies on the HTTP library which--surprise!--makes the same choice between+  -- depending on network or network-uri. Cabal will not notice that we cannot+  -- build hackage-security and hackage-security-HTTP against network-uri but+  -- HTTP against network.+  --+  -- We solve the problem by explicitly relying on network-2.6 when choosing+  -- network-uri. This dependency is redundant, strictly speaking. However, it+  -- serves as a proxy for forcing flag choices: since all packages in a+  -- solution must be linked against the same version of network, having one+  -- version of network in one branch of the conditional and another version of+  -- network in the other branch forces the choice to be consistent throughout.+  -- (Note that the HTTP library does the same thing, though in this case the+  -- dependency in network is not redundant.)+  if flag(use-network-uri)+    build-depends: network-uri >= 2.6 && < 2.7,+                   network     >= 2.6 && < 2.7+  else+    build-depends: network     >= 2.5 && < 2.6    if impl(ghc >= 7.8)      other-extensions: RoleAnnotations

@@ -270,31 +270,32 @@            -> Either VerificationError (Trusted FileInfo)            -> IO () updateRoot rep mNow isRetry cachedInfo eFileInfo = do-    (_newRoot :: Trusted Root, newRootFile) <- evalContT $-      getRemoteFile+    rootReallyChanged <- evalContT $ do+      (_newRoot :: Trusted Root, rootTempFile) <- getRemoteFile         rep         cachedInfo         isRetry         mNow         (RemoteRoot (eitherToMaybe eFileInfo)) -    rootReallyChanged <-+      -- NOTE: It is important that we do this check within the evalContT,+      -- because the temporary file will be deleted once we leave its scope.       case eFileInfo of-         Right _ ->-           -- We are downloading the root info because the hash in the snapshot-           -- changed. In this case the root definitely changed.-           return True-         Left _e -> do-           -- We are downloading the root because of a verification error. In-           -- this case the root info may or may not have changed. In most cases-           -- it would suffice to compare the file version now; however, in the-           -- (exceptional) circumstance where the root info has changed but-           -- the file version has not, this would result in the same infinite-           -- loop described above. Hence, we must compare file hashes, and they-           -- must be computed on the raw file, not the parsed file.-           oldRootFile <- repGetCachedRoot rep-           oldRootInfo <- DeclareTrusted <$> computeFileInfo oldRootFile-           not <$> verifyFileInfo newRootFile oldRootInfo+        Right _ ->+          -- We are downloading the root info because the hash in the snapshot+          -- changed. In this case the root definitely changed.+          return True+        Left _e -> liftIO $ do+          -- We are downloading the root because of a verification error. In+          -- this case the root info may or may not have changed. In most cases+          -- it would suffice to compare the file version now; however, in the+          -- (exceptional) circumstance where the root info has changed but+          -- the file version has not, this would result in the same infinite+          -- loop described above. Hence, we must compare file hashes, and they+          -- must be computed on the raw file, not the parsed file.+          oldRootFile <- repGetCachedRoot rep+          oldRootInfo <- DeclareTrusted <$> computeFileInfo oldRootFile+          not <$> verifyFileInfo rootTempFile oldRootInfo      when rootReallyChanged $ clearCache rep 

@@ -18,8 +18,8 @@ module Hackage.Security.Client.Repository.Remote (     -- * Top-level API     withRepository-  , AllowContentCompression(..)-  , WantCompressedIndex(..)+  , RepoOpts(..)+  , defaultRepoOpts      -- * File sizes   , FileSize(..)   , fileSizeWithinBounds@@ -110,22 +110,38 @@   Top-level API -------------------------------------------------------------------------------} --- | Should we allow HTTP content compression?+-- | Repository options with a reasonable default ----- Since content compression happens before signature verification, users who--- are concerned about potential exploits of the decompression algorithm may--- prefer to disallow content compression.-data AllowContentCompression =-    AllowContentCompression-  | DisallowContentCompression+-- Clients should use 'defaultRepositoryOpts' and override required settings.+data RepoOpts = RepoOpts {+      -- | Should we allow HTTP content compression?+      --+      -- Since content compression happens before signature verification, users+      -- who are concerned about potential exploits of the decompression+      -- algorithm may prefer to disallow content compression.+      repoAllowContentCompression :: Bool --- | Do we want to a copy of the compressed index?------ This is important for mirroring clients only.-data WantCompressedIndex =-    WantCompressedIndex-  | DontNeedCompressedIndex+      -- | Do we want to a copy of the compressed index?+      --+      -- This is important for mirroring clients only.+    , repoWantCompressedIndex :: Bool +      -- | Allow additional mirrors?+      --+      -- If this is set to True (default), in addition to the (out-of-band)+      -- specified mirrors we will also use mirrors reported by those+      -- out-of-band mirrors (that is, @mirrors.json@).+    , repoAllowAdditionalMirrors :: Bool+    }++-- | Default repository options+defaultRepoOpts :: RepoOpts+defaultRepoOpts = RepoOpts {+      repoAllowContentCompression = True+    , repoWantCompressedIndex     = False+    , repoAllowAdditionalMirrors  = True+    }+ -- | Initialize the repository (and cleanup resources afterwards) -- -- We allow to specify multiple mirrors to initialize the repository. These@@ -145,8 +161,7 @@ withRepository   :: HttpLib                 -- ^ Implementation of the HTTP protocol   -> [URI]                   -- ^ "Out of band" list of mirrors-  -> AllowContentCompression -- ^ Should we allow HTTP content compression?-  -> WantCompressedIndex     -- ^ Do we want a copy of the compressed index?+  -> RepoOpts                -- ^ Repository options   -> Cache                   -- ^ Location of local cache   -> RepoLayout              -- ^ Repository layout   -> (LogMessage -> IO ())   -- ^ Logger@@ -154,8 +169,7 @@   -> IO a withRepository httpLib                outOfBandMirrors-               allowContentCompression-               wantCompressedIndex+               repoOpts                cache                repLayout                logger@@ -170,8 +184,7 @@                                 , cfgCache    = cache                                 , cfgCaps     = caps                                 , cfgLogger   = logger-                                , cfgCompress = allowContentCompression-                                , cfgWantGz   = wantCompressedIndex+                                , cfgOpts     = repoOpts                                 }     callback Repository {         repWithRemote    = withRemote remoteConfig selectedMirror@@ -179,7 +192,11 @@       , repGetCachedRoot = Cache.getCachedRoot cache       , repClearCache    = Cache.clearCache    cache       , repGetFromIndex  = Cache.getFromIndex  cache (repoIndexLayout repLayout)-      , repWithMirror    = withMirror httpLib selectedMirror logger outOfBandMirrors+      , repWithMirror    = withMirror httpLib+                                      selectedMirror+                                      logger+                                      outOfBandMirrors+                                      repoOpts       , repLog           = logger       , repLayout        = repLayout       , repDescription   = "Remote repository at " ++ show outOfBandMirrors@@ -250,7 +267,7 @@     defaultHeaders = concat [         [ HttpRequestNoTransform ]       , [ HttpRequestContentCompression-        | AllowContentCompression <- [cfgCompress]+        | repoAllowContentCompression cfgOpts         ]       ] @@ -260,10 +277,18 @@            -> SelectedMirror         -- ^ MVar indicating currently mirror            -> (LogMessage -> IO ())  -- ^ Logger            -> [URI]                  -- ^ Out-of-band mirrors+           -> RepoOpts               -- ^ Repository options            -> Maybe [Mirror]         -- ^ TUF mirrors            -> IO a                   -- ^ Callback            -> IO a-withMirror HttpLib{..} selectedMirror logger oobMirrors tufMirrors callback =+withMirror HttpLib{..}+           selectedMirror+           logger+           oobMirrors+           repoOpts+           tufMirrors+           callback+           =     go orderedMirrors   where     go :: [URI] -> IO a@@ -283,7 +308,12 @@      -- TODO: We will want to make the construction of this list configurable.     orderedMirrors :: [URI]-    orderedMirrors = nub $ oobMirrors ++ maybe [] (map mirrorUrlBase) tufMirrors+    orderedMirrors = nub $ concat [+        oobMirrors+      , if repoAllowAdditionalMirrors repoOpts+          then maybe [] (map mirrorUrlBase) tufMirrors+          else []+      ]      select :: URI -> IO a -> IO a     select uri =@@ -335,11 +365,8 @@       (RemoteIndex pf fs)  -> return (pf, fs)      -- If the client wants the compressed index, we have no choice-    case cfgWantGz of-      WantCompressedIndex ->-        exit $ CannotUpdate hasGz UpdateNotUsefulWantsCompressed-      DontNeedCompressedIndex ->-        return ()+    when (repoWantCompressedIndex cfgOpts) $+      exit $ CannotUpdate hasGz UpdateNotUsefulWantsCompressed      -- Server must have uncompressed index available     hasUn <- case formatsMember FUn formats of@@ -368,9 +395,9 @@     localSize   <- liftIO $ getFileSize cachedIndex     let infoGz = formatsLookup hasGz formats         infoUn = formatsLookup hasUn formats-        estCompFactor = case (canCompress, cfgCompress) of-                          (True, AllowContentCompression) -> 10-                          _otherwise                      -> 1+        estCompFactor = if canCompress && repoAllowContentCompression cfgOpts+                          then 10+                          else 1         estUpdateSize = (fileLength' infoUn - fromIntegral localSize)                           `div` estCompFactor     unless (estUpdateSize < fileLength' infoGz) $@@ -593,8 +620,7 @@     , cfgCache    :: Cache     , cfgCaps     :: ServerCapabilities     , cfgLogger   :: LogMessage -> IO ()-    , cfgCompress :: AllowContentCompression-    , cfgWantGz   :: WantCompressedIndex+    , cfgOpts     :: RepoOpts     }  {-------------------------------------------------------------------------------

@@ -26,10 +26,10 @@   ) where  import Control.Monad-import Data.Digest.Pure.SHA import Data.Functor.Identity import Data.Typeable (Typeable) import Text.JSON.Canonical+import qualified Crypto.Hash          as CH import qualified Crypto.Sign.Ed25519  as Ed25519 import qualified Data.ByteString      as BS import qualified Data.ByteString.Lazy as BS.L@@ -159,8 +159,8 @@  instance HasKeyId PublicKey where   keyId = KeyId-        . showDigest-        . sha256+        . show+        . (CH.hashlazy :: BS.L.ByteString -> CH.Digest CH.SHA256)         . renderCanonicalJSON         . runIdentity         . toJSON

@@ -11,7 +11,7 @@  import Prelude hiding (lookup) import Data.Map (Map)-import Data.Digest.Pure.SHA+import qualified Crypto.Hash          as CH import qualified Data.Map             as Map import qualified Data.ByteString.Lazy as BS.L @@ -50,14 +50,12 @@ -- -- TODO: Currently this will load the entire input bytestring into memory. -- We need to make this incremental, by computing the length and all hashes--- in a single traversal over the input. However, the precise way to--- do that will depend on the hashing package we will use, and we have--- yet to pick that package.+-- in a single traversal over the input. fileInfo :: BS.L.ByteString -> FileInfo fileInfo bs = FileInfo {       fileInfoLength = FileLength . fromIntegral $ BS.L.length bs     , fileInfoHashes = Map.fromList [-          (HashFnSHA256, Hash $ showDigest (sha256 bs))+          (HashFnSHA256, Hash $ show (CH.hashlazy bs :: CH.Digest CH.SHA256))         ]     } 

@@ -29,8 +29,8 @@ import Network.URI import qualified Data.Map as Map -#if !MIN_VERSION_base(4,8,0)-import System.Locale+#if !MIN_VERSION_time(1,5,0)+import System.Locale (defaultTimeLocale) #endif  import Hackage.Security.Util.Path@@ -146,7 +146,7 @@     case parseTimeM False defaultTimeLocale "%FT%TZ" str of       Just time -> return time       Nothing   -> expected "valid date-time string" (Just str)-#if !MIN_VERSION_base(4,8,0)+#if !MIN_VERSION_time(1,5,0)     where       parseTimeM _trim = parseTime #endif