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

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

data Result = Found | NotFound | Failed Status
  deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
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 -> URL -> URL
[Result] -> URL -> URL
Result -> URL
(Int -> Result -> URL -> URL)
-> (Result -> URL) -> ([Result] -> URL -> URL) -> Show Result
forall a.
(Int -> a -> URL -> URL)
-> (a -> URL) -> ([a] -> URL -> URL) -> Show a
showList :: [Result] -> URL -> URL
$cshowList :: [Result] -> URL -> URL
show :: Result -> URL
$cshow :: Result -> URL
showsPrec :: Int -> Result -> URL -> URL
$cshowsPrec :: Int -> Result -> URL -> URL
Show)

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

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

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