    {-# 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{..} = "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
    forall a. [a] -> [a] -> [a]
    ++ URL
    githubRepo URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ "/" URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ URL
    githubRef URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ "/" URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ URL -> [URL] -> URL
    forall a. [a] -> [[a]] -> [a]
    intercalate "/" [URL]
    githubPath

    defaultsCachePath :: FilePath -> Github -> FilePath
    defaultsCachePath :: URL -> Github -> URL
    defaultsCachePath dir :: URL
    dir Github{..} = [URL] -> URL
    joinPath ([URL] -> URL) -> [URL] -> URL
    forall a b. (a -> b) -> a -> b
    $
      URL
    dir URL -> [URL] -> [URL]
    forall a. a -> [a] -> [a]
    : "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 :: 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 200 _ -> 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 404 _ -> Result -> IO Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NotFound
        status :: 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
    $ "Error while downloading " URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ URL
    url URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ " (" URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ Status -> URL
    formatStatus Status
    status URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ ")")

    formatStatus :: Status -> String
    formatStatus :: Status -> URL
    formatStatus (Status code :: Int
    code message :: ByteString
    message) = Int -> URL
    forall a. Show a => a -> URL
    show Int
    code URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ " " 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 userDataDir :: URL
    userDataDir dir :: URL
    dir = \ case
      DefaultsGithub defaults :: 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
          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)
          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 err :: 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
          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)
          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 file :: URL
    file = "Invalid value for \"defaults\"! File " URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ URL
    file URL -> URL -> URL
    forall a. [a] -> [a] -> [a]
    ++ " does not exist!"

    ensureFile :: FilePath -> URL -> IO Result
    ensureFile :: URL -> URL -> IO Result
    ensureFile file :: URL
    file url :: 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
        True -> Result -> IO Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    Found
        False -> URL -> URL -> IO Result
    get URL
    url URL
    file