Defaults.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Hpack.Defaults (
  ensure
, Defaults(..)
#ifdef TEST
, Result(..)
, ensureFile
#endif
) where

import           Imports

import           Network.HTTP.Client
import           Network.HTTP.Client.TLS
import qualified Data.ByteString.Lazy as LB
import           System.FilePath
import           System.Directory

import           Hpack.Error
import           Hpack.Syntax.Defaults

defaultsUrl :: Github -> URL
defaultsUrl Github{..} = "https://raw.githubusercontent.com/" ++ githubOwner ++ "/" ++ githubRepo ++ "/" ++ githubRef ++ "/" ++ intercalate "/" githubPath

defaultsCachePath :: FilePath -> Github -> FilePath
defaultsCachePath dir Github{..} = joinPath $
  dir : "defaults" : githubOwner : githubRepo : githubRef : githubPath

data Result = Found | NotFound | Failed Status
  deriving (Eq, Show)

get :: URL -> FilePath -> IO Result
get url file = do
  manager <- newManager tlsManagerSettings
  request <- parseRequest url
  response <- httpLbs request manager
  case responseStatus response of
    Status 200 _ -> do
      createDirectoryIfMissing True (takeDirectory file)
      LB.writeFile file (responseBody response)
      return Found
    Status 404 _ -> return NotFound
    status -> return (Failed status)

ensure :: FilePath -> FilePath -> Defaults -> IO (Either HpackError FilePath)
ensure userDataDir dir = \ case
  DefaultsGithub defaults -> do
    let
      url = defaultsUrl defaults
      file = defaultsCachePath userDataDir defaults
    ensureFile file url >>= \ case
      Found -> return (Right file)
      NotFound -> notFound url
      Failed status -> return (Left $ DefaultsDownloadFailed url status)
  DefaultsLocal (Local ((dir </>) -> file)) -> do
    doesFileExist file >>= \ case
      True -> return (Right file)
      False -> notFound file
  where
    notFound = return . Left . DefaultsFileNotFound

ensureFile :: FilePath -> URL -> IO Result
ensureFile file url = do
  doesFileExist file >>= \ case
    True -> return Found
    False -> get url file