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

    defaultsCachePath :: FilePath -> Github -> FilePath
    defaultsCachePath :: FilePath -> Github -> FilePath
    defaultsCachePath FilePath
    dir Github{FilePath
    [FilePath]
    githubPath :: Github -> [FilePath]
    githubRef :: Github -> FilePath
    githubRepo :: Github -> FilePath
    githubOwner :: Github -> FilePath
    githubOwner :: FilePath
    githubRepo :: FilePath
    githubRef :: FilePath
    githubPath :: [FilePath]
    ..} = [FilePath] -> FilePath
    joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
    forall a b. (a -> b) -> a -> b
    $
      FilePath
    dir FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : FilePath
    "defaults" FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : FilePath
    githubOwner FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : FilePath
    githubRepo FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : FilePath
    githubRef FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : [FilePath]
    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
    $c== :: Result -> Result -> Bool
    == :: Result -> Result -> Bool
    $c/= :: Result -> Result -> Bool
    /= :: Result -> Result -> Bool
    Eq, Int -> Result -> FilePath -> FilePath
    [Result] -> FilePath -> FilePath
    Result -> FilePath
    (Int -> Result -> FilePath -> FilePath)
    -> (Result -> FilePath)
    -> ([Result] -> FilePath -> FilePath)
    -> Show Result
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Result -> FilePath -> FilePath
    showsPrec :: Int -> Result -> FilePath -> FilePath
    $cshow :: Result -> FilePath
    show :: Result -> FilePath
    $cshowList :: [Result] -> FilePath -> FilePath
    showList :: [Result] -> FilePath -> FilePath
    Show)

    get :: URL -> FilePath -> IO Result
    get :: FilePath -> FilePath -> IO Result
    get FilePath
    url FilePath
    file = do
      manager <- ManagerSettings -> IO Manager
    newManager ManagerSettings
    tlsManagerSettings
      request <- parseRequest url
      response <- httpLbs request manager
      case responseStatus response of
        Status Int
    200 ByteString
    _ -> do
          Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True (FilePath -> FilePath
    takeDirectory FilePath
    file)
          FilePath -> ByteString -> IO ()
    LB.writeFile FilePath
    file (Response ByteString -> ByteString
    forall body. Response body -> body
    responseBody Response ByteString
    response)
          Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    Found
        Status Int
    404 ByteString
    _ -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NotFound
        Status
    status -> Result -> IO Result
    forall a. a -> IO a
    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 IO Result
    -> (Result -> IO (Either HpackError FilePath))
    -> IO (Either HpackError FilePath)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
          Result
    Found -> Either HpackError FilePath -> IO (Either HpackError FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath -> Either HpackError FilePath
    forall a b. b -> Either a b
    Right FilePath
    file)
          Result
    NotFound -> FilePath -> IO (Either HpackError FilePath)
    forall {b}. FilePath -> IO (Either HpackError b)
    notFound FilePath
    url
          Failed Status
    status -> Either HpackError FilePath -> IO (Either HpackError FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HpackError -> Either HpackError FilePath
    forall a b. a -> Either a b
    Left (HpackError -> Either HpackError FilePath)
    -> HpackError -> Either HpackError FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Status -> HpackError
    DefaultsDownloadFailed FilePath
    url Status
    status)
      DefaultsLocal (Local ((FilePath
    dir FilePath -> FilePath -> FilePath
    </>) -> FilePath
    file)) -> do
        FilePath -> IO Bool
    doesFileExist FilePath
    file IO Bool
    -> (Bool -> IO (Either HpackError FilePath))
    -> IO (Either HpackError FilePath)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
          Bool
    True -> Either HpackError FilePath -> IO (Either HpackError FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath -> Either HpackError FilePath
    forall a b. b -> Either a b
    Right FilePath
    file)
          Bool
    False -> FilePath -> IO (Either HpackError FilePath)
    forall {b}. FilePath -> IO (Either HpackError b)
    notFound FilePath
    file
      where
        notFound :: FilePath -> IO (Either HpackError b)
    notFound = Either HpackError b -> IO (Either HpackError b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either HpackError b -> IO (Either HpackError b))
    -> (FilePath -> Either HpackError b)
    -> FilePath
    -> 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)
    -> (FilePath -> HpackError) -> FilePath -> Either HpackError b
    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 IO Bool -> (Bool -> IO Result) -> IO Result
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
        Bool
    True -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    Found
        Bool
    False -> FilePath -> FilePath -> IO Result
    get FilePath
    url FilePath
    file