{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} module Hpack.Defaults ( ensure , Defaults(..) #ifdef TEST , Result(..) , ensureFile #endif ) where import Network.HTTP.Types import Network.HTTP.Client import Network.HTTP.Client.TLS import Data.List import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Char8 as B import System.FilePath import System.Directory import Hpack.Syntax.Defaults type URL = String 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 String 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 (URL -> Result Failed (URL -> Result) -> URL -> Result forall a b. (a -> b) -> a -> b $ URL "Error while downloading " URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ URL url URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ URL " (" URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ Status -> URL formatStatus Status status URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ URL ")") formatStatus :: Status -> String formatStatus :: Status -> URL formatStatus (Status Int code ByteString message) = Int -> URL forall a. Show a => a -> URL show Int code URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ URL " " URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ ByteString -> URL B.unpack ByteString message ensure :: FilePath -> FilePath -> Defaults -> IO (Either String FilePath) ensure :: URL -> URL -> Defaults -> IO (Either URL 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 URL URL)) -> IO (Either URL URL) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Result Found -> Either URL URL -> IO (Either URL URL) forall (m :: * -> *) a. Monad m => a -> m a return (URL -> Either URL URL forall a b. b -> Either a b Right URL file) Result NotFound -> Either URL URL -> IO (Either URL URL) forall (m :: * -> *) a. Monad m => a -> m a return (URL -> Either URL URL forall a b. a -> Either a b Left (URL -> Either URL URL) -> URL -> Either URL URL forall a b. (a -> b) -> a -> b $ URL -> URL notFound URL url) Failed URL err -> Either URL URL -> IO (Either URL URL) forall (m :: * -> *) a. Monad m => a -> m a return (URL -> Either URL URL forall a b. a -> Either a b Left URL err) DefaultsLocal (Local ((URL dir URL -> URL -> URL </>) -> URL file)) -> do URL -> IO Bool doesFileExist URL file IO Bool -> (Bool -> IO (Either URL URL)) -> IO (Either URL URL) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Bool True -> Either URL URL -> IO (Either URL URL) forall (m :: * -> *) a. Monad m => a -> m a return (URL -> Either URL URL forall a b. b -> Either a b Right URL file) Bool False -> Either URL URL -> IO (Either URL URL) forall (m :: * -> *) a. Monad m => a -> m a return (URL -> Either URL URL forall a b. a -> Either a b Left (URL -> Either URL URL) -> URL -> Either URL URL forall a b. (a -> b) -> a -> b $ URL -> URL notFound URL file) where notFound :: URL -> URL notFound URL file = URL "Invalid value for \"defaults\"! File " URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ URL file URL -> URL -> URL forall a. [a] -> [a] -> [a] ++ URL " does not exist!" 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