{-# 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 -> FilePath
defaultsUrl Github{FilePath
[FilePath]
githubPath :: Github -> [FilePath]
githubRef :: Github -> FilePath
githubRepo :: Github -> FilePath
githubOwner :: Github -> FilePath
githubPath :: [FilePath]
githubRef :: FilePath
githubRepo :: FilePath
githubOwner :: FilePath
..} = FilePath
"https://raw.githubusercontent.com/" forall a. [a] -> [a] -> [a]
++ FilePath
githubOwner forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ FilePath
githubRepo forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ FilePath
githubRef forall a. [a] -> [a] -> [a]
++ FilePath
"/" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"/" [FilePath]
githubPath

defaultsCachePath :: FilePath -> Github -> FilePath
defaultsCachePath :: FilePath -> Github -> FilePath
defaultsCachePath FilePath
dir Github{FilePath
[FilePath]
githubPath :: [FilePath]
githubRef :: FilePath
githubRepo :: FilePath
githubOwner :: FilePath
githubPath :: Github -> [FilePath]
githubRef :: Github -> FilePath
githubRepo :: Github -> FilePath
githubOwner :: Github -> FilePath
..} = [FilePath] -> FilePath
joinPath forall a b. (a -> b) -> a -> b
$
  FilePath
dir forall a. a -> [a] -> [a]
: FilePath
"defaults" forall a. a -> [a] -> [a]
: FilePath
githubOwner forall a. a -> [a] -> [a]
: FilePath
githubRepo forall a. a -> [a] -> [a]
: FilePath
githubRef forall a. a -> [a] -> [a]
: [FilePath]
githubPath

data Result = Found | NotFound | Failed Status
  deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> FilePath
$cshow :: Result -> FilePath
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)

get :: URL -> FilePath -> IO Result
get :: FilePath -> FilePath -> IO Result
get FilePath
url FilePath
file = do
  Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  Request
request <- forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest FilePath
url
  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager
  case forall body. Response body -> Status
responseStatus Response ByteString
response of
    Status Int
200 ByteString
_ -> do
      Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (ShowS
takeDirectory FilePath
file)
      FilePath -> ByteString -> IO ()
LB.writeFile FilePath
file (forall body. Response body -> body
responseBody Response ByteString
response)
      forall (m :: * -> *) a. Monad m => a -> m a
return Result
Found
    Status Int
404 ByteString
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
NotFound
    Status
status -> forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Result
Failed Status
status)

ensure :: FilePath -> FilePath -> Defaults -> IO (Either HpackError FilePath)
ensure :: FilePath -> FilePath -> Defaults -> IO (Either HpackError FilePath)
ensure FilePath
userDataDir FilePath
dir = \ case
  DefaultsGithub Github
defaults -> do
    let
      url :: FilePath
url = Github -> FilePath
defaultsUrl Github
defaults
      file :: FilePath
file = FilePath -> Github -> FilePath
defaultsCachePath FilePath
userDataDir Github
defaults
    FilePath -> FilePath -> IO Result
ensureFile FilePath
file FilePath
url forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
      Result
Found -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right FilePath
file)
      Result
NotFound -> forall {b}. FilePath -> IO (Either HpackError b)
notFound FilePath
url
      Failed Status
status -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FilePath -> Status -> HpackError
DefaultsDownloadFailed FilePath
url Status
status)
  DefaultsLocal (Local ((FilePath
dir FilePath -> ShowS
</>) -> FilePath
file)) -> do
    FilePath -> IO Bool
doesFileExist FilePath
file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
      Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right FilePath
file)
      Bool
False -> forall {b}. FilePath -> IO (Either HpackError b)
notFound FilePath
file
  where
    notFound :: FilePath -> IO (Either HpackError b)
notFound = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> HpackError
DefaultsFileNotFound

ensureFile :: FilePath -> URL -> IO Result
ensureFile :: FilePath -> FilePath -> IO Result
ensureFile FilePath
file FilePath
url = do
  FilePath -> IO Bool
doesFileExist FilePath
file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
    Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
Found
    Bool
False -> FilePath -> FilePath -> IO Result
get FilePath
url FilePath
file