hackage-security 0.5.0.2 → 0.5.1.0
raw patch · 8 files changed
+187/−23 lines, 8 filesdep +QuickCheckdep +base16-bytestringdep +cryptohash-sha256dep −cryptohashdep ~directorynew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, base16-bytestring, cryptohash-sha256, old-time, pretty, tasty-quickcheck
Dependencies removed: cryptohash
Dependency ranges changed: directory
API changes (from Hackage documentation)
+ Hackage.Security.Util.Path: getModificationTime :: FsRoot root => Path root -> IO UTCTime
+ Text.JSON.Canonical: prettyCanonicalJSON :: JSValue -> String
Files
- ChangeLog.md +10/−0
- hackage-security.cabal +16/−3
- src/Hackage/Security/Client/Repository/Cache.hs +41/−10
- src/Hackage/Security/Key.hs +6/−3
- src/Hackage/Security/TUF/FileInfo.hs +4/−2
- src/Hackage/Security/Util/Path.hs +15/−0
- src/Text/JSON/Canonical.hs +88/−5
- tests/TestSuite.hs +7/−0
ChangeLog.md view
@@ -1,3 +1,13 @@+0.5.1.0+-------++* Fix for other local programs corrputing the 00-index.tar. Detect it+ and do a full rewrite rather than incremental append.+* New JSON pretty-printer (not canonical rendering)+* Round-trip tests for Canonical JSON parser and printers+* Minor fix for Canonical JSON parser+* Switch from cryptohash to cryptohash-sha256 to avoid new dependencies+ 0.5.0.2 ------- * Use tar 0.5.0
hackage-security.cabal view
@@ -1,5 +1,5 @@ name: hackage-security-version: 0.5.0.2+version: 0.5.1.0 synopsis: Hackage security library description: The hackage security library provides both server and client utilities for securing the Hackage package server@@ -46,6 +46,11 @@ description: Are we using network-uri? manual: False +Flag old-directory+ description: Use directory < 1.2 and old-time+ manual: False+ default: False+ library -- Most functionality is exported through the top-level entry points .Client -- and .Server; the other exported modules are intended for qualified imports.@@ -93,16 +98,18 @@ Prelude -- We support ghc 7.4 (bundled with Cabal 1.14) and up build-depends: base >= 4.5 && < 5,+ base16-bytestring >= 0.1.1 && < 0.2, base64-bytestring >= 1.0 && < 1.1, bytestring >= 0.9 && < 0.11,- Cabal >= 1.14 && < 1.25,+ Cabal >= 1.14 && < 1.26, containers >= 0.4 && < 0.6, directory >= 1.1.0.2 && < 1.3, ed25519 >= 0.0 && < 0.1, filepath >= 1.2 && < 1.5, mtl >= 2.2 && < 2.3, parsec >= 3.1 && < 3.2,- cryptohash >= 0.11 && < 0.12,+ pretty >= 1.0 && < 1.2,+ cryptohash-sha256 >= 0.11 && < 0.12, -- 0.4.2 introduces TarIndex, 0.4.4 introduces more -- functionality, 0.5.0 changes type of serialise tar >= 0.5 && < 0.6,@@ -112,6 +119,10 @@ -- whatever versions are bundled with ghc: template-haskell, ghc-prim+ if flag(old-directory)+ build-depends: directory < 1.2, old-time >= 1 && < 1.2+ else+ build-depends: directory >= 1.2 hs-source-dirs: src default-language: Haskell2010 default-extensions: DefaultSignatures@@ -218,6 +229,8 @@ tar, tasty, tasty-hunit,+ tasty-quickcheck,+ QuickCheck, temporary, time, zlib
src/Hackage/Security/Client/Repository/Cache.hs view
@@ -16,6 +16,7 @@ import Control.Exception import Control.Monad+import Data.Maybe import Codec.Archive.Tar (Entries(..)) import Codec.Archive.Tar.Index (TarIndex, IndexBuilder, TarEntryOffset) import qualified Codec.Archive.Tar as Tar@@ -58,21 +59,51 @@ downloadedCopyTo downloaded fp -- Whether or not we downloaded the compressed index incrementally, we can- -- always update the uncompressed index incrementally.+ -- update the uncompressed index incrementally (assuming the local files+ -- have not been corrupted). -- NOTE: This assumes we already updated the compressed file. unzipIndex :: typ ~ Binary => IO () unzipIndex = do createDirectoryIfMissing True (takeDirectory indexUn)- compressed <- readLazyByteString indexGz- let uncompressed = GZip.decompress compressed- withFile indexUn ReadWriteMode $ \h -> do- currentSize <- hFileSize h- let seekTo = 0 `max` (currentSize - tarTrailer)- hSeek h AbsoluteSeek seekTo- BS.L.hPut h $ BS.L.drop (fromInteger seekTo) uncompressed+ shouldTryIncremenal <- cachedIndexProbablyValid+ if shouldTryIncremenal+ then unzipIncremenal+ else unzipNonIncremenal where- indexGz = cachedIndexPath cache FGz- indexUn = cachedIndexPath cache FUn+ unzipIncremenal = do+ compressed <- readLazyByteString indexGz+ let uncompressed = GZip.decompress compressed+ withFile indexUn ReadWriteMode $ \h -> do+ currentSize <- hFileSize h+ let seekTo = 0 `max` (currentSize - tarTrailer)+ hSeek h AbsoluteSeek seekTo+ BS.L.hPut h $ BS.L.drop (fromInteger seekTo) uncompressed++ unzipNonIncremenal = do+ compressed <- readLazyByteString indexGz+ let uncompressed = GZip.decompress compressed+ withFile indexUn WriteMode $ \h ->+ BS.L.hPut h uncompressed+ void . handleDoesNotExist $+ removeFile indexIdx -- Force a full rebuild of the index too++ -- When we update the 00-index.tar we also update the 00-index.tar.idx+ -- so the expected state is that the modification time for the tar.idx+ -- is the same or later than the .tar file. But if someone modified+ -- the 00-index.tar then the modification times will be reversed. So,+ -- if the modification times are reversed then we should not do an+ -- incremental update but should rewrite the whole file.+ cachedIndexProbablyValid :: IO Bool+ cachedIndexProbablyValid =+ fmap (fromMaybe False) $+ handleDoesNotExist $ do+ tsUn <- getModificationTime indexUn+ tsIdx <- getModificationTime indexIdx+ return (tsIdx >= tsUn)++ indexGz = cachedIndexPath cache FGz+ indexUn = cachedIndexPath cache FUn+ indexIdx = cachedIndexIdxPath cache tarTrailer :: Integer tarTrailer = 1024
src/Hackage/Security/Key.hs view
@@ -29,9 +29,11 @@ import Data.Functor.Identity import Data.Typeable (Typeable) import Text.JSON.Canonical-import qualified Crypto.Hash as CH+import qualified Crypto.Hash.SHA256 as SHA256 import qualified Crypto.Sign.Ed25519 as Ed25519 import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS.C8+import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as BS.L #if !MIN_VERSION_base(4,7,0)@@ -159,8 +161,9 @@ instance HasKeyId PublicKey where keyId = KeyId- . show- . (CH.hashlazy :: BS.L.ByteString -> CH.Digest CH.SHA256)+ . BS.C8.unpack+ . Base16.encode+ . SHA256.hashlazy . renderCanonicalJSON . runIdentity . toJSON
src/Hackage/Security/TUF/FileInfo.hs view
@@ -14,9 +14,11 @@ import Prelude hiding (lookup) import Data.Map (Map)-import qualified Crypto.Hash as CH+import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.Map as Map+import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as BS.L+import qualified Data.ByteString.Char8 as BS.C8 import Hackage.Security.JSON import Hackage.Security.TUF.Common@@ -58,7 +60,7 @@ fileInfo bs = FileInfo { fileInfoLength = FileLength . fromIntegral $ BS.L.length bs , fileInfoHashes = Map.fromList [- (HashFnSHA256, Hash $ show (CH.hashlazy bs :: CH.Digest CH.SHA256))+ (HashFnSHA256, Hash $ BS.C8.unpack $ Base16.encode $ SHA256.hashlazy bs) ] }
src/Hackage/Security/Util/Path.hs view
@@ -53,6 +53,7 @@ , removeDirectory , doesFileExist , doesDirectoryExist+ , getModificationTime , removeFile , getTemporaryDirectory , getDirectoryContents@@ -84,6 +85,11 @@ import Data.List (isPrefixOf) import System.IO (IOMode(..), BufferMode(..), Handle, SeekMode(..)) import System.IO.Unsafe (unsafeInterleaveIO)+#if MIN_VERSION_directory(1,2,0)+import Data.Time (UTCTime)+#else+import System.Time (ClockTime)+#endif import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BS.L import qualified System.FilePath as FP@@ -330,6 +336,15 @@ doesDirectoryExist path = do filePath <- toAbsoluteFilePath path Dir.doesDirectoryExist filePath++#if MIN_VERSION_directory(1,2,0)+getModificationTime :: FsRoot root => Path root -> IO UTCTime+#else+getModificationTime :: FsRoot root => Path root -> IO ClockTime+#endif+getModificationTime path = do+ filePath <- toAbsoluteFilePath path+ Dir.getModificationTime filePath removeFile :: FsRoot root => Path root -> IO () removeFile path = do
src/Text/JSON/Canonical.hs view
@@ -9,7 +9,7 @@ -- -- <http://wiki.laptop.org/go/Canonical_JSON> ----- A "canonical JSON" format is provided in order to provide meaningful and+-- A \"canonical JSON\" format is provided in order to provide meaningful and -- repeatable hashes of JSON-encoded data. Canonical JSON is parsable with any -- full JSON parser, but security-conscious applications will want to verify -- that input is in canonical form before authenticating any hash or signature@@ -27,12 +27,18 @@ , Int54 , parseCanonicalJSON , renderCanonicalJSON+ , prettyCanonicalJSON ) where import Text.ParserCombinators.Parsec ( CharParser, (<|>), (<?>), many, between, sepBy , satisfy, char, string, digit, spaces , parse )+import Text.PrettyPrint hiding (char)+import qualified Text.PrettyPrint as Doc+#if !(MIN_VERSION_base(4,7,0))+import Control.Applicative ((<$>), (<$), pure, (<*>), (<*), (*>))+#endif import Control.Arrow (first) import Data.Bits (Bits) #if MIN_VERSION_base(4,7,0)@@ -68,8 +74,7 @@ -- probably define `fromInteger` to do bounds checking, give different instances -- for type classes such as `Bounded` and `FiniteBits`, etc. newtype Int54 = Int54 { int54ToInt64 :: Int64 }- deriving ( Bounded- , Enum+ deriving ( Enum , Eq , Integral , Data@@ -86,6 +91,10 @@ , Typeable ) +instance Bounded Int54 where+ maxBound = Int54 ( 2^(53 :: Int) - 1)+ minBound = Int54 (-(2^(53 :: Int) - 1))+ instance Show Int54 where show = show . int54ToInt64 @@ -93,9 +102,14 @@ readsPrec p = map (first Int54) . readsPrec p ------------------------------------------------------------------------------+-- rendering flat+-- --- | Encode as \"Canonical\" JSON.+-- | Render a JSON value in canonical form. This rendered form is canonical+-- and so allows repeatable hashes. --+-- For pretty printing, see prettyCanonicalJSON.+-- -- NB: Canonical JSON's string escaping rules deviate from RFC 7159 -- JSON which requires --@@ -111,6 +125,7 @@ -- parser" -- -- Consequently, Canonical JSON is not a proper subset of RFC 7159.+-- renderCanonicalJSON :: JSValue -> BS.ByteString renderCanonicalJSON v = BS.pack (s_value v []) @@ -149,7 +164,15 @@ . showl kvs ------------------------------------------------------------------------------+-- parsing+-- +-- | Parse a canonical JSON format string as a JSON value. The input string+-- does not have to be in canonical form, just in the \"canonical JSON\"+-- format.+--+-- Use 'renderCanonicalJSON' to convert into canonical form.+-- parseCanonicalJSON :: BS.ByteString -> Either String JSValue parseCanonicalJSON = either (Left . show) Right . parse p_value ""@@ -213,7 +236,7 @@ \" -} p_string :: CharParser () String-p_string = between (tok (char '"')) (tok (char '"')) (many p_char)+p_string = between (char '"') (tok (char '"')) (many p_char) where p_char = (char '\\' >> p_esc) <|> (satisfy (\x -> x /= '"' && x /= '\\')) @@ -270,3 +293,63 @@ manyN 0 _ = pure [] manyN n p = ((:) <$> p <*> manyN (n-1) p) <|> pure []++------------------------------------------------------------------------------+-- rendering nicely+--++-- | Render a JSON value in a reasonable human-readable form. This rendered+-- form is /not the canonical form/ used for repeatable hashes, use+-- 'renderCanonicalJSON' for that.++-- It is suitable however as an external form as any canonical JSON parser can+-- read it and convert it into the form used for repeatable hashes.+--+prettyCanonicalJSON :: JSValue -> String+prettyCanonicalJSON = render . jvalue++jvalue :: JSValue -> Doc+jvalue JSNull = text "null"+jvalue (JSBool False) = text "false"+jvalue (JSBool True) = text "true"+jvalue (JSNum n) = integer (fromIntegral (int54ToInt64 n))+jvalue (JSString s) = jstring s+jvalue (JSArray vs) = jarray vs+jvalue (JSObject fs) = jobject fs++jstring :: String -> Doc+jstring = doubleQuotes . hcat . map jchar++jchar :: Char -> Doc+jchar '"' = Doc.char '\\' <> Doc.char '"'+jchar '\\' = Doc.char '\\' <> Doc.char '\\'+jchar c = Doc.char c++jarray :: [JSValue] -> Doc+jarray = sep . punctuate' lbrack comma rbrack+ . map jvalue++jobject :: [(String, JSValue)] -> Doc+jobject = sep . punctuate' lbrace comma rbrace+ . map (\(k,v) -> sep [jstring k <> colon, nest 2 (jvalue v)])+++-- | Punctuate in this style:+--+-- > [ foo, bar ]+--+-- if it fits, or vertically otherwise:+--+-- > [ foo+-- > , bar+-- > ]+--+punctuate' :: Doc -> Doc -> Doc -> [Doc] -> [Doc]+punctuate' l _ r [] = [l <> r]+punctuate' l _ r [x] = [l <+> x <+> r]+punctuate' l p r (x:xs) = l <+> x : go xs+ where+ go [] = []+ go [y] = [p <+> y, r]+ go (y:ys) = (p <+> y) : go ys+
tests/TestSuite.hs view
@@ -8,6 +8,7 @@ import Network.URI (URI, parseURI) import Test.Tasty import Test.Tasty.HUnit+import Test.Tasty.QuickCheck import System.IO.Temp (withSystemTempDirectory) -- hackage-security@@ -27,6 +28,7 @@ import TestSuite.InMemRepository import TestSuite.PrivateKeys import TestSuite.Util.StrictMVar+import TestSuite.JSON as JSON {------------------------------------------------------------------------------- TestSuite driver@@ -50,6 +52,11 @@ , testCase "testHttpMemUpdatesAfterCron" testHttpMemUpdatesAfterCron , testCase "testHttpMemKeyRollover" testHttpMemKeyRollover , testCase "testHttpMemOutdatedTimestamp" testHttpMemOutdatedTimestamp+ ]+ , testGroup "Canonical JSON" [+ testProperty "prop_roundtrip_canonical" JSON.prop_roundtrip_canonical+ , testProperty "prop_roundtrip_pretty" JSON.prop_roundtrip_pretty+ , testProperty "prop_canonical_pretty" JSON.prop_canonical_pretty ] ]