From d627f63521e14629d77c598977136cd5a51f2bb6 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 14 May 2015 18:10:26 +0300
Subject: [PATCH] Create databases in cron jobs

---
 Stackage/Database/Cron.hs | 49 +++++++++++++++++++++++++++++++++------
 stackage-server.cabal     |  4 ++++
 2 files changed, 46 insertions(+), 7 deletions(-)

diff --git a/Stackage/Database/Cron.hs b/Stackage/Database/Cron.hs
index a183428..6e7f8c7 100644
--- a/Stackage/Database/Cron.hs
+++ b/Stackage/Database/Cron.hs
@@ -12,6 +12,16 @@ import Filesystem (rename)
 import Web.PathPieces (toPathPiece)
 import Filesystem (isFile)
 import Network.HTTP.Types (status200)
+import           Network.AWS                   (Credentials (Discover),
+                                                Region (NorthVirginia), getEnv,
+                                                send, sourceFileIO)
+import           Network.AWS.S3                (ObjectCannedACL (PublicRead),
+                                                poACL,
+                                                putObject)
+import Control.Lens (set)
+import qualified Data.Conduit.Binary as CB
+import           Data.Conduit.Zlib             (WindowBits (WindowBits),
+                                                compress)
 
 filename' :: Text
 filename' = concat
@@ -24,12 +34,16 @@ keyName :: Text
 keyName = "stackage-database/" ++ filename'
 
 url :: Text
-url = "https://s3.amazonaws.com/haddock.stackage.org/" ++ keyName
+url = concat
+    [ "https://s3.amazonaws.com/haddock.stackage.org/"
+    , keyName
+    , ".gz"
+    ]
 
 -- | Provides an action to be used to refresh the file from S3.
 loadFromS3 :: IO (StackageDatabase, Manager -> IO ())
 loadFromS3 = do
-    let fp = fpFromText filename'
+    let fp = fpFromText keyName
         fptmp = fp <.> "tmp"
     req <- parseUrl $ unpack url
     let download man = withResponse req man $ \res -> do
@@ -40,10 +54,6 @@ loadFromS3 = do
     db <- openStackageDatabase fp
     return (db, download)
 
-stackageServerCron :: IO ()
-stackageServerCron = error "FIXME: stackageServerCron not implemented"
-
-
 hoogleKey :: SnapName -> Text
 hoogleKey name = concat
     [ "hoogle/"
@@ -54,7 +64,11 @@ hoogleKey name = concat
     ]
 
 hoogleUrl :: SnapName -> Text
-hoogleUrl n = "https://s3.amazonaws.com/haddock.stackage.org/" ++ hoogleKey n
+hoogleUrl n = concat
+    [ "https://s3.amazonaws.com/haddock.stackage.org/"
+    , hoogleKey n
+    , ".gz"
+    ]
 
 getHoogleDB :: Manager -> SnapName -> IO (Maybe FilePath)
 getHoogleDB man name = do
@@ -76,6 +90,27 @@ getHoogleDB man name = do
                     mapM brRead res >>= print
                     return Nothing
 
+stackageServerCron :: IO ()
+stackageServerCron = do
+    env <- getEnv NorthVirginia Discover
+    let upload fp key = do
+            let fpgz = fpToString $ fp <.> "gz"
+            runResourceT $ sourceFile fp
+                        $$ compress 9 (WindowBits 31)
+                        =$ CB.sinkFile fpgz
+            body <- sourceFileIO fpgz
+            let po = 
+                      set poACL (Just PublicRead)
+                   $  putObject body "haddock.stackage.org" key
+            eres <- runResourceT $ send env po
+            case eres of
+                Left e -> error $ show (fp, key, e)
+                Right _ -> return ()
+
+    let dbfp = fpFromText keyName
+    createStackageDatabase dbfp
+    upload dbfp keyName
+
 {-
     createStackageDatabase dbfile
 
diff --git a/stackage-server.cabal b/stackage-server.cabal
index e00d6dd..49207f2 100644
--- a/stackage-server.cabal
+++ b/stackage-server.cabal
@@ -175,6 +175,10 @@ library
                  , filepath
                  , http-client
                  , http-types
+                 , amazonka
+                 , amazonka-core
+                 , amazonka-s3
+                 , lens
 
 executable         stackage-server
     if flag(library-only)