{-# 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.Types import Network.HTTP.Client import Network.HTTP.Client.TLS 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 -> [Char] defaultsUrl Github{[Char] [[Char]] githubPath :: Github -> [[Char]] githubRef :: Github -> [Char] githubRepo :: Github -> [Char] githubOwner :: Github -> [Char] githubPath :: [[Char]] githubRef :: [Char] githubRepo :: [Char] githubOwner :: [Char] ..} = [Char] "https://raw.githubusercontent.com/" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] githubOwner [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] "/" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] githubRepo [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] "/" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] githubRef [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] "/" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] -> [[Char]] -> [Char] forall a. [a] -> [[a]] -> [a] intercalate [Char] "/" [[Char]] githubPath defaultsCachePath :: FilePath -> Github -> FilePath defaultsCachePath :: [Char] -> Github -> [Char] defaultsCachePath [Char] dir Github{[Char] [[Char]] githubPath :: [[Char]] githubRef :: [Char] githubRepo :: [Char] githubOwner :: [Char] githubPath :: Github -> [[Char]] githubRef :: Github -> [Char] githubRepo :: Github -> [Char] githubOwner :: Github -> [Char] ..} = [[Char]] -> [Char] joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char] forall a b. (a -> b) -> a -> b $ [Char] dir [Char] -> [[Char]] -> [[Char]] forall a. a -> [a] -> [a] : [Char] "defaults" [Char] -> [[Char]] -> [[Char]] forall a. a -> [a] -> [a] : [Char] githubOwner [Char] -> [[Char]] -> [[Char]] forall a. a -> [a] -> [a] : [Char] githubRepo [Char] -> [[Char]] -> [[Char]] forall a. a -> [a] -> [a] : [Char] githubRef [Char] -> [[Char]] -> [[Char]] forall a. a -> [a] -> [a] : [[Char]] 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 -> [Char] -> [Char] [Result] -> [Char] -> [Char] Result -> [Char] (Int -> Result -> [Char] -> [Char]) -> (Result -> [Char]) -> ([Result] -> [Char] -> [Char]) -> Show Result forall a. (Int -> a -> [Char] -> [Char]) -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a showList :: [Result] -> [Char] -> [Char] $cshowList :: [Result] -> [Char] -> [Char] show :: Result -> [Char] $cshow :: Result -> [Char] showsPrec :: Int -> Result -> [Char] -> [Char] $cshowsPrec :: Int -> Result -> [Char] -> [Char] Show) get :: URL -> FilePath -> IO Result get :: [Char] -> [Char] -> IO Result get [Char] url [Char] file = do Manager manager <- ManagerSettings -> IO Manager newManager ManagerSettings tlsManagerSettings Request request <- [Char] -> IO Request forall (m :: * -> *). MonadThrow m => [Char] -> m Request parseRequest [Char] 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 -> [Char] -> IO () createDirectoryIfMissing Bool True ([Char] -> [Char] takeDirectory [Char] file) [Char] -> ByteString -> IO () LB.writeFile [Char] 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 ([Char] -> Result Failed ([Char] -> Result) -> [Char] -> Result forall a b. (a -> b) -> a -> b $ [Char] "Error while downloading " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] url [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] " (" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ Status -> [Char] formatStatus Status status [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] ")") formatStatus :: Status -> String formatStatus :: Status -> [Char] formatStatus (Status Int code ByteString message) = Int -> [Char] forall a. Show a => a -> [Char] show Int code [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] " " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ ByteString -> [Char] B.unpack ByteString message ensure :: FilePath -> FilePath -> Defaults -> IO (Either String FilePath) ensure :: [Char] -> [Char] -> Defaults -> IO (Either [Char] [Char]) ensure [Char] userDataDir [Char] dir = \ case DefaultsGithub Github defaults -> do let url :: [Char] url = Github -> [Char] defaultsUrl Github defaults file :: [Char] file = [Char] -> Github -> [Char] defaultsCachePath [Char] userDataDir Github defaults [Char] -> [Char] -> IO Result ensureFile [Char] file [Char] url IO Result -> (Result -> IO (Either [Char] [Char])) -> IO (Either [Char] [Char]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Result Found -> Either [Char] [Char] -> IO (Either [Char] [Char]) forall (m :: * -> *) a. Monad m => a -> m a return ([Char] -> Either [Char] [Char] forall a b. b -> Either a b Right [Char] file) Result NotFound -> Either [Char] [Char] -> IO (Either [Char] [Char]) forall (m :: * -> *) a. Monad m => a -> m a return ([Char] -> Either [Char] [Char] forall a b. a -> Either a b Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char] forall a b. (a -> b) -> a -> b $ [Char] -> [Char] notFound [Char] url) Failed [Char] err -> Either [Char] [Char] -> IO (Either [Char] [Char]) forall (m :: * -> *) a. Monad m => a -> m a return ([Char] -> Either [Char] [Char] forall a b. a -> Either a b Left [Char] err) DefaultsLocal (Local (([Char] dir [Char] -> [Char] -> [Char] </>) -> [Char] file)) -> do [Char] -> IO Bool doesFileExist [Char] file IO Bool -> (Bool -> IO (Either [Char] [Char])) -> IO (Either [Char] [Char]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Bool True -> Either [Char] [Char] -> IO (Either [Char] [Char]) forall (m :: * -> *) a. Monad m => a -> m a return ([Char] -> Either [Char] [Char] forall a b. b -> Either a b Right [Char] file) Bool False -> Either [Char] [Char] -> IO (Either [Char] [Char]) forall (m :: * -> *) a. Monad m => a -> m a return ([Char] -> Either [Char] [Char] forall a b. a -> Either a b Left ([Char] -> Either [Char] [Char]) -> [Char] -> Either [Char] [Char] forall a b. (a -> b) -> a -> b $ [Char] -> [Char] notFound [Char] file) where notFound :: [Char] -> [Char] notFound [Char] file = [Char] "Invalid value for \"defaults\"! File " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] file [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] " does not exist!" ensureFile :: FilePath -> URL -> IO Result ensureFile :: [Char] -> [Char] -> IO Result ensureFile [Char] file [Char] url = do [Char] -> IO Bool doesFileExist [Char] 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 -> [Char] -> [Char] -> IO Result get [Char] url [Char] file