mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-11-30 01:16:54 +03:00
c0714b1b3d
- Summary page has the list of all packages available (with details of the latest version) - Timeline page has the list of all entries as they appear in the index Also: - Rebuild sdists is they are missing
59 lines
1.9 KiB
Haskell
59 lines
1.9 KiB
Haskell
{-# LANGUAGE DerivingVia #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Foliage.RemoteAsset
|
|
( fetchRemoteAsset,
|
|
addFetchRemoteAssetRule,
|
|
)
|
|
where
|
|
|
|
import Control.Monad
|
|
import Data.ByteString qualified as BS
|
|
import Data.Char (isAlpha)
|
|
import Data.List (dropWhileEnd)
|
|
import Data.Maybe (fromMaybe)
|
|
import Development.Shake
|
|
import Development.Shake.Classes
|
|
import Development.Shake.FilePath
|
|
import Development.Shake.Rule
|
|
import Network.URI (URI (..), URIAuth (..), pathSegments)
|
|
import Network.URI.Orphans ()
|
|
import System.Directory (createDirectoryIfMissing)
|
|
|
|
newtype RemoteAsset = RemoteAsset URI
|
|
deriving (Show, Eq)
|
|
deriving (Hashable, Binary, NFData) via URI
|
|
|
|
type instance RuleResult RemoteAsset = FilePath
|
|
|
|
fetchRemoteAsset :: URI -> Action FilePath
|
|
fetchRemoteAsset = apply1 . RemoteAsset
|
|
|
|
addFetchRemoteAssetRule :: FilePath -> Rules ()
|
|
addFetchRemoteAssetRule cacheDir = addBuiltinRule noLint noIdentity run
|
|
where
|
|
run :: BuiltinRun RemoteAsset FilePath
|
|
run (RemoteAsset uri) old _mode = do
|
|
unless (uriQuery uri == "") $
|
|
fail $ "Query elements in URI are not supported: " <> show uri
|
|
|
|
unless (uriFragment uri == "") $
|
|
fail $ "Fragments in URI are not supported: " <> show uri
|
|
|
|
let scheme = dropWhileEnd (not . isAlpha) $ uriScheme uri
|
|
Just host = uriRegName <$> uriAuthority uri
|
|
path = cacheDir </> joinPath (scheme : host : pathSegments uri)
|
|
|
|
-- parse etag from store
|
|
let oldETag = fromMaybe BS.empty old
|
|
|
|
newETag <-
|
|
withTempFile $ \fp -> traced "curl" $ do
|
|
BS.writeFile fp oldETag
|
|
createDirectoryIfMissing True (takeDirectory path)
|
|
cmd_ Shell ["curl", "--silent", "--location", "--etag-compare", fp, "--etag-save", fp, "--output", path, show uri]
|
|
BS.readFile fp
|
|
|
|
let changed = if newETag == oldETag then ChangedRecomputeSame else ChangedRecomputeDiff
|
|
return $ RunResult {runChanged = changed, runStore = newETag, runValue = path}
|