content: module Pier.Core.Download
      ( askDownload
      , Download(..)
      , downloadRules
      ) where
  
  import Control.Monad (unless)
  import Development.Shake
  import Development.Shake.Classes
  import Development.Shake.FilePath
  import GHC.Generics
  import Network.HTTP.Client
  import Network.HTTP.Client.TLS
  import Network.HTTP.Types.Status
  
  import qualified Data.ByteString.Char8 as BC
  import qualified Data.ByteString.Lazy as L
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as T
  
  import Pier.Core.Artifact
  import Pier.Core.Internal.Directory
  import Pier.Core.Internal.Store
  import Pier.Core.Persistent
  
  -- | Downloads @downloadUrlPrefix / downloadName@ to
  -- @downloadFilePrefix / downloadName@.
  -- Everything is stored in `~/.pier/downloads`.
  data Download = Download
      { downloadUrlPrefix :: String
      , downloadName :: FilePath
      }
      deriving (Typeable, Eq, Generic)
  
  instance Show Download where
      show d = "Download " ++ show (downloadName d)
              ++ " from " ++ show (downloadUrlPrefix d)
  
  instance Hashable Download
  instance Binary Download
  instance NFData Download
  
  type instance RuleResult Download = Artifact
  
  askDownload :: Download -> Action Artifact
  askDownload = askPersistent
  
  downloadRules :: Maybe SharedCache -> Rules ()
  downloadRules sharedCache = do
      manager <- liftIO $ newManager tlsManagerSettings
      addPersistent $ \d -> do
      h <- makeHash . T.encodeUtf8 . T.pack
              $ "download: " ++ show d
      let name = downloadName d
      let msg = "Downloading " ++ name
      createArtifacts sharedCache h [msg] $ \tmpDir -> do
          let out = tmpDir </> name
          createParentIfMissing out
          putNormal msg
          liftIO $ do
              let url = downloadUrlPrefix d ++ "/" ++ downloadName d
              req <- parseRequest url
              resp <- httpLbs req manager
              unless (statusIsSuccessful . responseStatus $ resp)
                  $ error $ "Unable to download " ++ show url
                          ++ "\nStatus: " ++ showStatus (responseStatus resp)
              liftIO . L.writeFile out . responseBody $ resp
      return $ builtArtifact h name
    where
      showStatus s = show (statusCode s) ++ " " ++ BC.unpack (statusMessage s)
  