diff --git a/hackage-server.cabal b/hackage-server.cabal index af153e5b8..8da1867b6 100644 --- a/hackage-server.cabal +++ b/hackage-server.cabal @@ -112,7 +112,7 @@ common defaults , scientific -- other dependencies shared by most components build-depends: - , aeson ^>= 1.5 + , aeson ^>= 2.0.3.0 , Cabal ^>= 3.4.1.0 , fail ^>= 4.9.0 -- we use Control.Monad.Except, introduced in mtl-2.2.1 @@ -361,7 +361,7 @@ library lib-server , acid-state ^>= 0.16 , async ^>= 2.2.1 -- requires bumping http-io-streams - , attoparsec ^>= 0.13 + , attoparsec ^>= 0.14.4 , base16-bytestring ^>= 1.0 -- requires bumping http-io-streams , base64-bytestring ^>= 1.1 diff --git a/src/Distribution/Server/Features/Core.hs b/src/Distribution/Server/Features/Core.hs index d40241c03..a2811c3e1 100644 --- a/src/Distribution/Server/Features/Core.hs +++ b/src/Distribution/Server/Features/Core.hs @@ -23,9 +23,10 @@ module Distribution.Server.Features.Core ( -- stdlib import qualified Codec.Compression.GZip as GZip import Data.Aeson (Value (..)) +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap import Data.ByteString.Lazy (ByteString) import qualified Data.Foldable as Foldable -import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) @@ -688,8 +689,8 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..} -- in particular, we use objects for the packages so that we can add -- additional fields later without (hopefully) breaking clients let json = flip map list $ \str -> - Object . HashMap.fromList $ [ - (Text.pack "packageName", String (Text.pack str)) + Object . KeyMap.fromList $ [ + (Key.fromString "packageName", String (Text.pack str)) ] return . toResponse $ Array (Vec.fromList json) @@ -727,10 +728,10 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..} let revisions = pkgMetadataRevisions pkginfo revisionToObj rev (_, (utime, uid)) = let uname = userIdToName users uid in - Object $ HashMap.fromList - [ (Text.pack "number", Number (fromIntegral rev)) - , (Text.pack "user", String (Text.pack (display uname))) - , (Text.pack "time", String (Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" utime))) + Object $ KeyMap.fromList + [ (Key.fromString "number", Number (fromIntegral rev)) + , (Key.fromString "user", String (Text.pack (display uname))) + , (Key.fromString "time", String (Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" utime))) ] revisionsJson = Array $ Vec.imap revisionToObj revisions return (toResponse revisionsJson) diff --git a/src/Distribution/Server/Features/PackageCandidates.hs b/src/Distribution/Server/Features/PackageCandidates.hs index 9c59b13f0..cb56d54a1 100644 --- a/src/Distribution/Server/Features/PackageCandidates.hs +++ b/src/Distribution/Server/Features/PackageCandidates.hs @@ -43,15 +43,15 @@ import Distribution.Version import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T -import qualified Data.ByteString.Lazy as BS (ByteString, toStrict) -import qualified Text.XHtml.Strict as XHtml -import Text.XHtml.Strict ((<<), (!)) -import Data.Aeson (Value (..), object, toJSON, (.=)) - -import Data.Function (fix) -import Data.List (find, intersperse) -import Data.Time.Clock (getCurrentTime) -import qualified Data.Vector as Vec +import qualified Data.ByteString.Lazy as BS (ByteString, toStrict) +import qualified Text.XHtml.Strict as XHtml +import Text.XHtml.Strict ((<<), (!)) +import Data.Aeson (Value (..), object, toJSON, (.=)) +import qualified Data.Aeson.Key as Key +import Data.Function (fix) +import Data.List (find, intersperse) +import Data.Time.Clock (getCurrentTime) +import qualified Data.Vector as Vec data PackageCandidatesFeature = PackageCandidatesFeature { @@ -281,10 +281,10 @@ candidatesFeature ServerEnv{serverBlobStore = store} users <- queryGetUserDb let lupUserName uid = (uid, fmap Users.userName (Users.lookupUserId uid users)) - let pvs = [ object [ T.pack "version" .= (T.pack . display . packageVersion . candInfoId) p - , T.pack "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball - , T.pack "time" .= (fst . snd) tarball - , T.pack "uploader" .= (lupUserName . snd . snd) tarball + let pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p + , Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball + , Key.fromString "time" .= (fst . snd) tarball + , Key.fromString "uploader" .= (lupUserName . snd . snd) tarball ] | p <- pkgs , let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p @@ -304,11 +304,14 @@ candidatesFeature ServerEnv{serverBlobStore = store} where cpiToJSON :: [CandPkgInfo] -> Value cpiToJSON [] = Null -- should never happen - cpiToJSON pkgs = object [ T.pack "name" .= pn, T.pack "candidates" .= pvs ] + cpiToJSON pkgs = object + [ Key.fromString "name" .= pn + , Key.fromString "candidates" .= pvs + ] where pn = T.pack . display . pkgName . candInfoId . head $ pkgs - pvs = [ object [ T.pack "version" .= (T.pack . display . packageVersion . candInfoId) p - , T.pack "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball + pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p + , Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball ] | p <- pkgs , let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p diff --git a/src/Distribution/Server/Features/PackageInfoJSON/State.hs b/src/Distribution/Server/Features/PackageInfoJSON/State.hs index be95f6cbd..0cc8b8576 100644 --- a/src/Distribution/Server/Features/PackageInfoJSON/State.hs +++ b/src/Distribution/Server/Features/PackageInfoJSON/State.hs @@ -15,8 +15,9 @@ import Control.Monad.Reader (ask, asks) import qualified Control.Monad.State as State import qualified Data.Aeson as Aeson import Data.Aeson ((.=), (.:)) +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap import Data.Acid (Query, Update, makeAcidic) -import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import Data.Monoid (Sum(..)) import qualified Data.Text as T @@ -85,30 +86,30 @@ instance SafeCopy PackageBasicDescription where instance Aeson.ToJSON PackageBasicDescription where toJSON PackageBasicDescription {..} = Aeson.object - [ T.pack "license" .= Pretty.prettyShow pbd_license - , T.pack "copyright" .= pbd_copyright - , T.pack "synopsis" .= pbd_synopsis - , T.pack "description" .= pbd_description - , T.pack "author" .= pbd_author - , T.pack "homepage" .= pbd_homepage - , T.pack "metadata_revision" .= pbd_metadata_revision + [ Key.fromString "license" .= Pretty.prettyShow pbd_license + , Key.fromString "copyright" .= pbd_copyright + , Key.fromString "synopsis" .= pbd_synopsis + , Key.fromString "description" .= pbd_description + , Key.fromString "author" .= pbd_author + , Key.fromString "homepage" .= pbd_homepage + , Key.fromString "metadata_revision" .= pbd_metadata_revision ] instance Aeson.FromJSON PackageBasicDescription where parseJSON = Aeson.withObject "PackageBasicDescription" $ \obj -> do - pbd_version' <- obj .: T.pack "license" + pbd_version' <- obj .: Key.fromString "license" let parseEitherLicense t = Parsec.simpleParsec t <|> fmap licenseToSPDX (simpleParse t) case parseEitherLicense pbd_version' of Nothing -> fail $ concat ["Could not parse version: \"", pbd_version', "\""] Just pbd_license -> do - pbd_copyright <- obj .: T.pack "copyright" - pbd_synopsis <- obj .: T.pack "synopsis" - pbd_description <- obj .: T.pack "description" - pbd_author <- obj .: T.pack "author" - pbd_homepage <- obj .: T.pack "homepage" - pbd_metadata_revision <- obj .: T.pack "metadata_revision" + pbd_copyright <- obj .: Key.fromString "copyright" + pbd_synopsis <- obj .: Key.fromString "synopsis" + pbd_description <- obj .: Key.fromString "description" + pbd_author <- obj .: Key.fromString "author" + pbd_homepage <- obj .: Key.fromString "homepage" + pbd_metadata_revision <- obj .: Key.fromString "metadata_revision" return $ PackageBasicDescription {..} @@ -161,14 +162,13 @@ instance Aeson.FromJSON PackageVersions where parseJSON = Aeson.withObject "PackageVersions" $ \obj -> fmap PackageVersions $ traverse (parsePair) - $ HashMap.toList obj + $ KeyMap.toList obj where parsePair (vStr, vStatus) = - (,) <$> parseVersion vStr <*> parseStatus vStatus + (,) <$> parseVersion (Key.toString vStr) <*> parseStatus vStatus - parseVersion verText = - let verString = T.unpack verText - in case simpleParse verString of + parseVersion verString = + case simpleParse verString of Just ver -> return ver Nothing -> fail $ concat ["Could not parse \"" , verString ++ "\" as Version. " diff --git a/src/Distribution/Server/Features/PreferredVersions.hs b/src/Distribution/Server/Features/PreferredVersions.hs index 63c0677a1..99af9dfca 100644 --- a/src/Distribution/Server/Features/PreferredVersions.hs +++ b/src/Distribution/Server/Features/PreferredVersions.hs @@ -28,18 +28,19 @@ import Distribution.Package import Distribution.Version import Distribution.Text -import Data.Function (fix) -import Data.List (intercalate, find) -import Data.Maybe (isJust, fromMaybe, catMaybes) -import Data.Time.Clock (getCurrentTime) -import Control.Arrow (second) -import Control.Applicative (optional) -import qualified Data.Map as Map +import Control.Arrow (first, second) +import Control.Applicative (optional) +import Data.Aeson (Value(..)) +import Data.Function (fix) +import Data.List (intercalate, find) +import Data.Maybe (isJust, fromMaybe, catMaybes) +import Data.Time.Clock (getCurrentTime) +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy.Char8 as BS (pack) -- Only used for ASCII data -import Data.Aeson (Value(..)) -import qualified Data.HashMap.Strict as HashMap -import qualified Data.Text as Text -import qualified Data.Vector as Vector +import qualified Data.Map as Map +import qualified Data.Text as Text +import qualified Data.Vector as Vector data VersionsFeature = VersionsFeature { versionsFeatureInterface :: HackageFeature, @@ -198,7 +199,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity } versionType DeprecatedVersion = "deprecated-version" versionType UnpreferredVersion = "unpreferred-version" return . toResponse . object - $ map (\(i, vs) -> (Text.pack . versionType $ i, array $ map (string . display) vs)) + $ map (\(i, vs) -> (versionType $ i, array $ map (string . display) vs)) $ Map.toList classifiedVersions handlePackagesDeprecatedGet :: DynamicPath -> ServerPartE Response @@ -234,7 +235,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity } Object o -- FIXME should just be a nested case -- or something more human friendly - | fields <- HashMap.toList o + | fields <- KeyMap.toList o , Just (Bool deprecated) <- lookup "is-deprecated" fields , Just (Array strs) <- lookup "in-favour-of" fields -- FIXME Audit this parsing -> PackageName code, suspiciously @@ -415,8 +416,8 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity } array :: [Value] -> Value array = Array . Vector.fromList -object :: [(Text.Text, Value)] -> Value -object = Object . HashMap.fromList +object :: [(String, Value)] -> Value +object = Object . KeyMap.fromList . map (first Key.fromString) string :: String -> Value string = String . Text.pack diff --git a/src/Distribution/Server/Features/Search.hs b/src/Distribution/Server/Features/Search.hs index f5f22987c..01b661075 100644 --- a/src/Distribution/Server/Features/Search.hs +++ b/src/Distribution/Server/Features/Search.hs @@ -32,6 +32,7 @@ import qualified Data.Map as Map import Control.Applicative (optional) import Data.Aeson +import qualified Data.Aeson.Key as Key data SearchFeature = SearchFeature { searchFeatureInterface :: HackageFeature, @@ -185,7 +186,7 @@ searchFeature ServerEnv{serverBaseURI} CoreFeature{..} ListFeature{getAllLists} _ -> errBadRequest "Invalid search request" [MText $ "Empty terms query"] where packageNameJSON pkgName = - object [ T.pack "name" .= unPackageName pkgName ] + object [ Key.fromString "name" .= unPackageName pkgName ] {- suggestJson :: ServerPartE Response diff --git a/src/Distribution/Server/Features/ServerIntrospect.hs b/src/Distribution/Server/Features/ServerIntrospect.hs index 9be29a110..73b70b339 100644 --- a/src/Distribution/Server/Features/ServerIntrospect.hs +++ b/src/Distribution/Server/Features/ServerIntrospect.hs @@ -14,7 +14,8 @@ import Text.XHtml.Strict , anchor, (!), href, name , ordList, unordList ) import Data.Aeson (Value(..)) -import qualified Data.HashMap.Strict as HashMap +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Vector as Vector import qualified Data.Text as Text import Data.List @@ -338,7 +339,7 @@ array :: [Value] -> Value array = Array . Vector.fromList object :: [(String, Value)] -> Value -object = Object . HashMap.fromList . map (first Text.pack) +object = Object . KeyMap.fromList . map (first Key.fromString) string :: String -> Value string = String . Text.pack diff --git a/src/Distribution/Server/Features/Votes.hs b/src/Distribution/Server/Features/Votes.hs index 2ab1584d3..2720a02fb 100644 --- a/src/Distribution/Server/Features/Votes.hs +++ b/src/Distribution/Server/Features/Votes.hs @@ -21,9 +21,10 @@ import Distribution.Package import Distribution.Text import Data.Aeson +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Map as Map import qualified Data.Text as T -import qualified Data.HashMap.Strict as HashMap import Control.Arrow (first) import qualified Text.XHtml.Strict as X @@ -212,7 +213,7 @@ votesFeature ServerEnv{..} -- Use to construct a list of tuples that can be toJSON'd objectL :: [(String, Value)] -> Value -objectL = Object . HashMap.fromList . map (first T.pack) +objectL = Object . KeyMap.fromList . map (first Key.fromString) -- Use inside an objectL to transform strings into json values string :: String -> Value diff --git a/src/Distribution/Server/Framework/HtmlFormWrapper.hs b/src/Distribution/Server/Framework/HtmlFormWrapper.hs index a6241ce74..48a968618 100644 --- a/src/Distribution/Server/Framework/HtmlFormWrapper.hs +++ b/src/Distribution/Server/Framework/HtmlFormWrapper.hs @@ -13,7 +13,8 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS8 import qualified Data.Aeson as JSON import qualified Data.Text as T -import qualified Data.HashMap.Strict as HMap +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KeyMap import Control.Concurrent.MVar import Distribution.Server.Framework.HappstackUtils (showContentType) @@ -181,23 +182,26 @@ parsePathTmpl v = parseKey parseJVal s = JSON.decode (BS8.pack s) accumJPaths :: [JPath] -> Maybe JSON.Value -accumJPaths js = foldr (\j r v -> case insertJPath j v of - Nothing -> Nothing - Just v' -> r v') Just js JSON.Null +accumJPaths js = f JSON.Null + where + f :: JSON.Value -> Maybe JSON.Value + f = foldr (\ j r -> insertJPath j >=> r) Just js insertJPath :: JPath -> JSON.Value -> Maybe JSON.Value + insertJPath (JField f p) JSON.Null = do v <- insertJPath p JSON.Null - return (JSON.object [(f, v)]) + return (JSON.object [(Key.fromText f, v)]) insertJPath (JField f p) (JSON.Object obj) = do - case HMap.lookup f obj of + let k = Key.fromText f + case KeyMap.lookup k obj of Nothing -> do v <- insertJPath p JSON.Null - return (JSON.Object (HMap.insert f v obj)) + return (JSON.Object (KeyMap.insert k v obj)) Just v0 -> do v <- insertJPath p v0 - return (JSON.Object (HMap.insert f v obj)) + return (JSON.Object (KeyMap.insert k v obj)) insertJPath (JVal v) JSON.Null = return v insertJPath _ _ = Nothing