haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 04:08:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge pull request #151 from fpco/lts-5

Browse Source 
Upgrade to lts-5
This commit is contained in:
Michael Snoyman 2016-02-03 10:43:46 +02:00
commit c50899bd65
7 changed files with 81 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Handler/Feed.hs
View File

@ -28,6 +28,7 @@ mkFeed mBranch snaps = do
, feedEntryUpdated = UTCTime (snapshotCreated snap) 0
, feedEntryTitle = prettyName (snapshotName snap) (snapshotGhc snap)
, feedEntryContent = content
, feedEntryEnclosure = Nothing
}
updated <-
case entries of
@ -42,6 +43,7 @@ mkFeed mBranch snaps = do
, feedLanguage = "en"
, feedUpdated = updated
, feedEntries = entries
, feedLogo = Nothing
}
where
branchTitle NightlyBranch = "Nightly"

24
Handler/StackageHome.hs
View File

@ -13,7 +13,7 @@ import Stackage.Database
import Stackage.Database.Types (isLts)
import Stackage.Snapshot.Diff
getStackageHomeR :: SnapName -> Handler Html
getStackageHomeR :: SnapName -> Handler TypedContent
getStackageHomeR name = do
Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
previousSnapName <- fromMaybe name . map snd <$> snapshotBefore (snapshotName snapshot)
@ -22,12 +22,26 @@ getStackageHomeR name = do
exact = False
in $(widgetFile "hoogle-form")
packageCount <- getPackageCount sid
defaultLayout $ do
setTitle $ toHtml $ snapshotTitle snapshot
packages <- getPackages sid
$(widgetFile "stackage-home")
packages <- getPackages sid
selectRep $ do
provideRep $ do
defaultLayout $ do
setTitle $ toHtml $ snapshotTitle snapshot
$(widgetFile "stackage-home")
provideRep $ pure $ toJSON $ SnapshotInfo snapshot packages
where strip x = fromMaybe x (stripSuffix "." x)
data SnapshotInfo
= SnapshotInfo { snapshot :: Snapshot
, packages :: [PackageListingInfo]
}
instance ToJSON SnapshotInfo where
toJSON SnapshotInfo{..} = object [ "snapshot" .= snapshot
, "packages" .= packages
]
getStackageDiffR :: SnapName -> SnapName -> Handler TypedContent
getStackageDiffR name1 name2 = do
Entity sid1 _ <- lookupSnapshot name1 >>= maybe notFound return

15
Stackage/Database.hs
View File

@ -129,6 +129,13 @@ Deprecated
UniqueDeprecated package
|]
instance A.ToJSON Snapshot where
toJSON Snapshot{..} =
A.object [ "name" A..= snapshotName
, "ghc" A..= snapshotGhc
, "created" A..= formatTime defaultTimeLocale "%F" snapshotCreated
]
_hideUnusedWarnings
:: ( SnapshotPackageId
, SchemaId
@ -490,6 +497,14 @@ data PackageListingInfo = PackageListingInfo
, pliIsCore :: !Bool
}
instance A.ToJSON PackageListingInfo where
toJSON PackageListingInfo{..} =
A.object [ "name" A..= pliName
, "version" A..= pliVersion
, "synopsis" A..= pliSynopsis
, "isCore" A..= pliIsCore
]
getPackages :: GetStackageDatabase m => SnapshotId -> m [PackageListingInfo]
getPackages sid = liftM (map toPLI) $ run $ do
E.select $ E.from $ \(p,sp) -> do

43
Stackage/Database/Cron.hs
View File

@ -21,12 +21,15 @@ import Control.Monad.State.Strict (StateT, get, put)
import Network.HTTP.Types (status200)
import Data.Streaming.Network (bindPortTCP)
import Network.AWS (Credentials (Discover),
Region (NorthVirginia), getEnv,
send, sourceFileIO, envManager)
import Network.AWS.Data (toBody)
import Network.AWS.S3 (ObjectCannedACL (PublicRead),
poACL,
putObject)
Region (NorthVirginia), newEnv,
send, chunkedFile, defaultChunkSize,
envManager, runAWS)
import Control.Monad.Trans.AWS (trying, _Error)
import Network.AWS.Data.Body (toBody)
import Network.AWS.S3 (ObjectCannedACL (OPublicRead),
poACL, putObject,
BucketName(BucketName),
ObjectKey(ObjectKey))
import Control.Lens (set, view)
import qualified Data.Conduit.Binary as CB
import Data.Conduit.Zlib (WindowBits (WindowBits),
@ -154,37 +157,37 @@ stackageServerCron = do
void $ catchIO (bindPortTCP 17834 "127.0.0.1") $ \_ ->
error $ "cabal loader process already running, exiting"
env <- getEnv NorthVirginia Discover
let upload :: FilePath -> Text -> IO ()
env <- newEnv NorthVirginia Discover
let upload :: FilePath -> ObjectKey -> IO ()
upload fp key = do
let fpgz = fp <.> "gz"
runResourceT $ sourceFile fp
$$ compress 9 (WindowBits 31)
=$ CB.sinkFile fpgz
body <- sourceFileIO fpgz
body <- chunkedFile defaultChunkSize fpgz
let po =
set poACL (Just PublicRead)
$ putObject body "haddock.stackage.org" key
putStrLn $ "Uploading: " ++ key
eres <- runResourceT $ send env po
set poACL (Just OPublicRead)
$ putObject "haddock.stackage.org" key body
putStrLn $ "Uploading: " ++ tshow key
eres <- runResourceT $ runAWS env $ trying _Error $ send po
case eres of
Left e -> error $ show (fp, key, e)
Right _ -> putStrLn "Success"
let dbfp = fromText keyName
createStackageDatabase dbfp
upload (encodeString dbfp) keyName
upload (encodeString dbfp) (ObjectKey keyName)
db <- openStackageDatabase dbfp
do
snapshots <- runReaderT snapshotsJSON db
let key = "snapshots.json" :: Text
let key = ObjectKey "snapshots.json"
po =
set poACL (Just PublicRead)
$ putObject (toBody snapshots) "haddock.stackage.org" key
putStrLn $ "Uploading: " ++ key
eres <- runResourceT $ send env po
set poACL (Just OPublicRead)
$ putObject (BucketName "haddock.stackage.org") key (toBody snapshots)
putStrLn $ "Uploading: " ++ tshow key
eres <- runResourceT $ runAWS env $ trying _Error $ send po
case eres of
Left e -> error $ show (key, e)
Right _ -> putStrLn "Success"
@ -199,7 +202,7 @@ stackageServerCron = do
mfp' <- createHoogleDB db manager name
forM_ mfp' $ \fp -> do
let key = hoogleKey name
upload fp key
upload fp (ObjectKey key)
let dest = unpack key
createTree $ parent (fromString dest)
rename (fromString fp) (fromString dest)

3
Stackage/Database/Types.hs
View File

@ -26,6 +26,9 @@ isNightly SNNightly{} = True
instance ToJSONKey SnapName where
toJSONKey = toPathPiece
instance ToJSON SnapName where
toJSON = String . toPathPiece
instance PersistField SnapName where
toPersistValue = toPersistValue . toPathPiece
fromPersistValue v = do

5
stack.yaml
View File

@ -1,7 +1,4 @@
resolver: lts-3.9
extra-deps:
- these-0.6.1.0
- barrier-0.1.0
resolver: lts-5.1
image:
container:
name: snoyberg/stackage-server

36
stackage-server.cabal
View File

@ -90,9 +90,9 @@ library
build-depends:
base >= 4.8 && < 4.9
, aeson >= 0.8 && < 0.9
, aeson-extra >= 0.2 && < 0.3
, aws >= 0.12 && < 0.13
, aeson >= 0.9 && < 0.10
, aeson-extra >= 0.3 && < 0.4
, aws >= 0.13 && < 0.14
, barrier >= 0.1 && < 0.2
, base16-bytestring >= 0.1 && < 0.2
, blaze-markup >= 0.7 && < 0.8
@ -106,7 +106,7 @@ library
, cryptohash-conduit >= 0.1.1 && < 0.2
, data-default >= 0.5 && < 0.6
, directory >= 1.2 && < 1.3
, email-validate >= 2.1 && < 2.2
, email-validate >= 2.2 && < 2.3
, esqueleto >= 2.4 && < 2.5
, exceptions >= 0.8 && < 0.9
, fast-logger >= 2.4 && < 2.5
@ -125,15 +125,15 @@ library
, shakespeare >= 2.0 && < 2.1
, system-fileio >= 0.3 && < 0.4
, system-filepath >= 0.4 && < 0.5
, tar >= 0.4 && < 0.5
, tar >= 0.5 && < 0.6
, template-haskell >= 2.10 && < 2.11
, temporary-rc >= 1.2 && < 1.3
, text >= 1.2 && < 1.3
, these >= 0.6 && < 0.7
, wai >= 3.0 && < 3.1
, wai >= 3.2 && < 3.3
, wai-extra >= 3.0 && < 3.1
, wai-logger >= 2.2 && < 2.3
, warp >= 3.1 && < 3.2
, warp >= 3.2 && < 3.3
, xml-conduit >= 1.3 && < 1.4
, yaml >= 0.8 && < 0.9
, yesod >= 1.4 && < 1.5
@ -142,12 +142,12 @@ library
, yesod-form >= 1.4 && < 1.5
, yesod-newsfeed
, yesod-static >= 1.5 && < 1.6
, zlib >= 0.5 && < 0.6
, zlib >= 0.6 && < 0.7
, unordered-containers >= 0.2 && < 0.3
, hashable >= 1.2 && < 1.3
, Cabal >= 1.22 && < 1.23
, lifted-base >= 0.2 && < 0.3
, mono-traversable >= 0.9 && < 0.10
, mono-traversable >= 0.10 && < 0.11
, time >= 1.5 && < 1.6
, process >= 1.2 && < 1.3
, old-locale >= 1.0 && < 1.1
@ -158,14 +158,14 @@ library
, formatting >= 6.2 && < 6.3
, blaze-html >= 0.8 && < 0.9
, haddock-library >= 1.2.0 && < 1.3
, async >= 2.0 && < 2.1
, async >= 2.1 && < 2.2
, yesod-gitrepo >= 0.2 && < 0.3
, hoogle >= 4.2 && < 4.3
, spoon >= 0.3 && < 0.4
, deepseq >= 1.4 && < 1.5
, deepseq-generics >= 0.1 && < 0.2
, auto-update >= 0.1 && < 0.2
, stackage-types >= 1.1 && < 1.2
, stackage-types >= 1.2 && < 1.3
, stackage-build-plan >= 0.1.1 && < 0.2
, yesod-sitemap >= 1.4 && < 1.5
, streaming-commons >= 0.1 && < 0.2
@ -175,11 +175,11 @@ library
, stackage-metadata >= 0.3 && < 0.4
, filepath >= 1.4 && < 1.5
, http-client >= 0.4 && < 0.5
, http-types >= 0.8 && < 0.9
, amazonka >= 0.3 && < 0.4
, amazonka-core >= 0.3 && < 0.4
, amazonka-s3 >= 0.3 && < 0.4
, lens >= 4.12 && < 4.13
, http-types >= 0.9 && < 0.10
, amazonka >= 1.3 && < 1.4
, amazonka-core >= 1.3 && < 1.4
, amazonka-s3 >= 1.3 && < 1.4
, lens >= 4.13 && < 4.14
executable stackage-server
if flag(library-only)
@ -211,14 +211,14 @@ test-suite test
build-depends: base >= 4.8 && < 4.9
, stackage-server
, yesod-test >= 1.4 && < 1.5
, yesod-test >= 1.5 && < 1.6
, yesod-core >= 1.4 && < 1.5
, yesod >= 1.4 && < 1.5
, persistent >= 2.2 && < 2.3
, resourcet >= 1.1.6 && < 1.2
, monad-logger >= 0.3.13 && < 0.4
, transformers >= 0.4 && < 0.5
, hspec >= 2.1 && < 2.2
, hspec >= 2.2 && < 2.3
, classy-prelude-yesod >= 0.12 && < 0.13
, mtl >= 2.2 && < 2.3
, mwc-random >= 0.13 && < 0.14