{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- Stability: experimental
-- Portability: portable
--
-- 'NixFetcher' is used to describe how to fetch package sources.
--
-- There are five types of fetchers overall:
--
-- 1. 'FetchGit' -- nix-prefetch-git
-- 2. 'FetchGitHub' -- nix-prefetch-git/nix-prefetch-url
-- 3. 'FetchUrl' -- nix-prefetch-url
-- 4. 'FetchTarball' -- nix-prefetch-url
-- 5. 'FetchDocker' -- nix-prefetch-docker
--
-- As you can see the type signature of 'prefetch':
-- a fetcher will be filled with the fetch result (hash) after the prefetch.
module NvFetcher.NixFetcher
  ( -- * Types
    RunFetch (..),
    ForceFetch (..),
    NixFetcher (..),
    FetchStatus (..),
    FetchResult,

    -- * Rules
    prefetchRule,
    prefetch,

    -- * Functions
    gitHubFetcher,
    pypiFetcher,
    gitHubReleaseFetcher,
    gitHubReleaseFetcher',
    gitFetcher,
    urlFetcher,
    urlFetcher',
    openVsxFetcher,
    vscodeMarketplaceFetcher,
    tarballFetcher,
  )
where

import Control.Exception (ErrorCall)
import Control.Monad (void, when)
import qualified Data.Aeson as A
import Data.Coerce (coerce)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.Shake
import GHC.Generics (Generic)
import NeatInterpolation (trimming)
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import Prettyprinter (pretty, (<+>))

--------------------------------------------------------------------------------

sha256ToSri :: Text -> Action Checksum
sha256ToSri :: Text -> Action Checksum
sha256ToSri Text
sha256 = do
  (CmdTime Double
t, Stdout (ByteString -> Text
T.decodeUtf8 -> Text
out), CmdLine String
c) <-
    Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a. Action a -> Action a
quietly (Action (CmdTime, Stdout ByteString, CmdLine)
 -> Action (CmdTime, Stdout ByteString, CmdLine))
-> Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
      [CmdOption]
-> String
-> [String]
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix" [String
"hash", String
"to-sri", String
"--type", String
"sha256", Text -> String
T.unpack Text
sha256]
  String -> Action ()
putVerbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Finishing running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", took " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
  case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
out of
    [Text
x] -> Checksum -> Action Checksum
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Checksum -> Action Checksum) -> Checksum -> Action Checksum
forall a b. (a -> b) -> a -> b
$ Text -> Checksum
forall a b. Coercible a b => a -> b
coerce Text
x
    [Text]
_ -> String -> Action Checksum
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action Checksum) -> String -> Action Checksum
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix hash to-sri: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
out

runNixPrefetchUrl :: Text -> Bool -> Maybe Text -> Action Checksum
runNixPrefetchUrl :: Text -> Bool -> Maybe Text -> Action Checksum
runNixPrefetchUrl Text
url Bool
unpack Maybe Text
name = do
  (CmdTime Double
t, Stdout (ByteString -> Text
T.decodeUtf8 -> Text
out), CmdLine String
c) <-
    Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a. Action a -> Action a
quietly (Action (CmdTime, Stdout ByteString, CmdLine)
 -> Action (CmdTime, Stdout ByteString, CmdLine))
-> Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
      [CmdOption]
-> String
-> [String]
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-url" ([String] -> Action (CmdTime, Stdout ByteString, CmdLine))
-> [String] -> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
        [Text -> String
T.unpack Text
url]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--unpack" | Bool
unpack]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"--name", Text -> String
T.unpack Text
name] | Just Text
name <- [Maybe Text
name]]
  String -> Action ()
putVerbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Finishing running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", took " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
  case (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
out of
    [Text
x] -> Text -> Action Checksum
sha256ToSri Text
x
    [Text]
_ -> String -> Action Checksum
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action Checksum) -> String -> Action Checksum
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-url: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
out

newtype FetchedGit = FetchedGit {FetchedGit -> Text
sha256 :: Text}
  deriving (Int -> FetchedGit -> String -> String
[FetchedGit] -> String -> String
FetchedGit -> String
(Int -> FetchedGit -> String -> String)
-> (FetchedGit -> String)
-> ([FetchedGit] -> String -> String)
-> Show FetchedGit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FetchedGit -> String -> String
showsPrec :: Int -> FetchedGit -> String -> String
$cshow :: FetchedGit -> String
show :: FetchedGit -> String
$cshowList :: [FetchedGit] -> String -> String
showList :: [FetchedGit] -> String -> String
Show, (forall x. FetchedGit -> Rep FetchedGit x)
-> (forall x. Rep FetchedGit x -> FetchedGit) -> Generic FetchedGit
forall x. Rep FetchedGit x -> FetchedGit
forall x. FetchedGit -> Rep FetchedGit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FetchedGit -> Rep FetchedGit x
from :: forall x. FetchedGit -> Rep FetchedGit x
$cto :: forall x. Rep FetchedGit x -> FetchedGit
to :: forall x. Rep FetchedGit x -> FetchedGit
Generic, Value -> Parser [FetchedGit]
Value -> Parser FetchedGit
(Value -> Parser FetchedGit)
-> (Value -> Parser [FetchedGit]) -> FromJSON FetchedGit
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FetchedGit
parseJSON :: Value -> Parser FetchedGit
$cparseJSONList :: Value -> Parser [FetchedGit]
parseJSONList :: Value -> Parser [FetchedGit]
A.FromJSON)

runNixPrefetchGit :: Text -> Text -> Bool -> Bool -> Bool -> [Text] -> Action Checksum
runNixPrefetchGit :: Text -> Text -> Bool -> Bool -> Bool -> [Text] -> Action Checksum
runNixPrefetchGit Text
url Text
rev Bool
fetchSubmodules Bool
deepClone Bool
leaveDotGit [Text]
sparseCheckout = do
  (CmdTime Double
t, Stdout ByteString
out, CmdLine String
c) <-
    Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a. Action a -> Action a
quietly (Action (CmdTime, Stdout ByteString, CmdLine)
 -> Action (CmdTime, Stdout ByteString, CmdLine))
-> Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
      [CmdOption]
-> String
-> [String]
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-git" ([String] -> Action (CmdTime, Stdout ByteString, CmdLine))
-> [String] -> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
        [String
"--url", Text -> String
T.unpack Text
url]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--rev", Text -> String
T.unpack Text
rev]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--fetch-submodules" | Bool
fetchSubmodules]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--deepClone" | Bool
deepClone]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--leave-dotGit" | Bool
leaveDotGit]
          [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sparseCheckout then [] else [String
"--sparse-checkout", Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
sparseCheckout]
  String -> Action ()
putVerbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Finishing running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", took " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
  case ByteString -> Either String FetchedGit
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
out of
    Right (FetchedGit Text
x) -> Text -> Action Checksum
sha256ToSri Text
x
    Left String
e -> String -> Action Checksum
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action Checksum) -> String -> Action Checksum
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-git as JSON: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e

--------------------------------------------------------------------------------

runFetcher :: NixFetcher Fresh -> Action (NixFetcher Fetched)
runFetcher :: NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
runFetcher = \case
  FetchGit {Bool
[Text]
Maybe Text
Text
FetchResult Checksum 'Fresh
Version
_furl :: Text
_rev :: Version
_deepClone :: Bool
_fetchSubmodules :: Bool
_leaveDotGit :: Bool
_sparseCheckout :: [Text]
_name :: Maybe Text
_sha256 :: FetchResult Checksum 'Fresh
_furl :: forall (k :: FetchStatus). NixFetcher k -> Text
_rev :: forall (k :: FetchStatus). NixFetcher k -> Version
_deepClone :: forall (k :: FetchStatus). NixFetcher k -> Bool
_fetchSubmodules :: forall (k :: FetchStatus). NixFetcher k -> Bool
_leaveDotGit :: forall (k :: FetchStatus). NixFetcher k -> Bool
_sparseCheckout :: forall (k :: FetchStatus). NixFetcher k -> [Text]
_name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
..} -> do
    Checksum
result <- Text -> Text -> Bool -> Bool -> Bool -> [Text] -> Action Checksum
runNixPrefetchGit Text
_furl (Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
_rev) Bool
_fetchSubmodules Bool
_deepClone Bool
_leaveDotGit [Text]
_sparseCheckout
    NixFetcher 'Fetched -> Action (NixFetcher 'Fetched)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchGit {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = Checksum -> Checksum
forall a b. Coercible a b => a -> b
coerce Checksum
result, Bool
[Text]
Maybe Text
Text
Version
_furl :: Text
_rev :: Version
_deepClone :: Bool
_fetchSubmodules :: Bool
_leaveDotGit :: Bool
_sparseCheckout :: [Text]
_name :: Maybe Text
_furl :: Text
_rev :: Version
_deepClone :: Bool
_fetchSubmodules :: Bool
_leaveDotGit :: Bool
_sparseCheckout :: [Text]
_name :: Maybe Text
..}
  FetchGitHub {Bool
[Text]
Maybe Text
Text
FetchResult Checksum 'Fresh
Version
_rev :: forall (k :: FetchStatus). NixFetcher k -> Version
_deepClone :: forall (k :: FetchStatus). NixFetcher k -> Bool
_fetchSubmodules :: forall (k :: FetchStatus). NixFetcher k -> Bool
_leaveDotGit :: forall (k :: FetchStatus). NixFetcher k -> Bool
_sparseCheckout :: forall (k :: FetchStatus). NixFetcher k -> [Text]
_name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_fowner :: Text
_frepo :: Text
_rev :: Version
_deepClone :: Bool
_fetchSubmodules :: Bool
_leaveDotGit :: Bool
_sparseCheckout :: [Text]
_name :: Maybe Text
_sha256 :: FetchResult Checksum 'Fresh
_fowner :: forall (k :: FetchStatus). NixFetcher k -> Text
_frepo :: forall (k :: FetchStatus). NixFetcher k -> Text
..} -> do
    let useFetchGit :: Bool
useFetchGit = Bool
_fetchSubmodules Bool -> Bool -> Bool
|| Bool
_leaveDotGit Bool -> Bool -> Bool
|| Bool
_deepClone Bool -> Bool -> Bool
|| Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
_sparseCheckout)
        ver :: Text
ver = Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
_rev
    Checksum
result <-
      if Bool
useFetchGit
        then Text -> Text -> Bool -> Bool -> Bool -> [Text] -> Action Checksum
runNixPrefetchGit [trimming|https://github.com/$_fowner/$_frepo|] (Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
_rev) Bool
_fetchSubmodules Bool
_deepClone Bool
_leaveDotGit [Text]
_sparseCheckout
        else Text -> Bool -> Maybe Text -> Action Checksum
runNixPrefetchUrl [trimming|https://github.com/$_fowner/$_frepo/archive/$ver.tar.gz|] Bool
True Maybe Text
forall a. Monoid a => a
mempty
    NixFetcher 'Fetched -> Action (NixFetcher 'Fetched)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchGitHub {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = FetchResult Checksum 'Fetched
Checksum
result, Bool
[Text]
Maybe Text
Text
Version
_rev :: Version
_deepClone :: Bool
_fetchSubmodules :: Bool
_leaveDotGit :: Bool
_sparseCheckout :: [Text]
_name :: Maybe Text
_fowner :: Text
_frepo :: Text
_rev :: Version
_deepClone :: Bool
_fetchSubmodules :: Bool
_leaveDotGit :: Bool
_sparseCheckout :: [Text]
_name :: Maybe Text
_fowner :: Text
_frepo :: Text
..}
  FetchUrl {Maybe Text
Text
FetchResult Checksum 'Fresh
_furl :: forall (k :: FetchStatus). NixFetcher k -> Text
_name :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_furl :: Text
_name :: Maybe Text
_sha256 :: FetchResult Checksum 'Fresh
..} -> do
    Checksum
result <- Text -> Bool -> Maybe Text -> Action Checksum
runNixPrefetchUrl Text
_furl Bool
False Maybe Text
_name
    NixFetcher 'Fetched -> Action (NixFetcher 'Fetched)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchUrl {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = FetchResult Checksum 'Fetched
Checksum
result, Maybe Text
Text
_furl :: Text
_name :: Maybe Text
_furl :: Text
_name :: Maybe Text
..}
  FetchTarball {Text
FetchResult Checksum 'Fresh
_furl :: forall (k :: FetchStatus). NixFetcher k -> Text
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_furl :: Text
_sha256 :: FetchResult Checksum 'Fresh
..} -> do
    Checksum
result <- Text -> Bool -> Maybe Text -> Action Checksum
runNixPrefetchUrl Text
_furl Bool
True Maybe Text
forall a. Monoid a => a
mempty
    NixFetcher 'Fetched -> Action (NixFetcher 'Fetched)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchTarball {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = FetchResult Checksum 'Fetched
Checksum
result, Text
_furl :: Text
_furl :: Text
..}
  FetchDocker {Maybe Bool
Maybe Text
Text
FetchResult ContainerDigest 'Fresh
FetchResult Checksum 'Fresh
_sha256 :: forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_imageName :: Text
_imageTag :: Text
_imageDigest :: FetchResult ContainerDigest 'Fresh
_sha256 :: FetchResult Checksum 'Fresh
_fos :: Maybe Text
_farch :: Maybe Text
_finalImageName :: Maybe Text
_finalImageTag :: Maybe Text
_tlsVerify :: Maybe Bool
_imageName :: forall (k :: FetchStatus). NixFetcher k -> Text
_imageTag :: forall (k :: FetchStatus). NixFetcher k -> Text
_imageDigest :: forall (k :: FetchStatus).
NixFetcher k -> FetchResult ContainerDigest k
_fos :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_farch :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_finalImageName :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_finalImageTag :: forall (k :: FetchStatus). NixFetcher k -> Maybe Text
_tlsVerify :: forall (k :: FetchStatus). NixFetcher k -> Maybe Bool
..} -> do
    (CmdTime Double
t, Stdout ByteString
out, CmdLine String
c) <-
      Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a. Action a -> Action a
quietly (Action (CmdTime, Stdout ByteString, CmdLine)
 -> Action (CmdTime, Stdout ByteString, CmdLine))
-> Action (CmdTime, Stdout ByteString, CmdLine)
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
        [CmdOption]
-> String
-> [String]
-> Action (CmdTime, Stdout ByteString, CmdLine)
forall r.
(Partial, CmdResult r) =>
[CmdOption] -> String -> [String] -> Action r
command [Bool -> CmdOption
EchoStderr Bool
False] String
"nix-prefetch-docker" ([String] -> Action (CmdTime, Stdout ByteString, CmdLine))
-> [String] -> Action (CmdTime, Stdout ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$
          [ String
"--json",
            Text -> String
T.unpack Text
_imageName,
            Text -> String
T.unpack Text
_imageTag
          ]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"--os", Text -> String
T.unpack Text
os] | Just Text
os <- [Maybe Text
_fos]]
            [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"--arch", Text -> String
T.unpack Text
arch] | Just Text
arch <- [Maybe Text
_farch]]
    String -> Action ()
putVerbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Finishing running " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", took " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Double -> String
forall a. Show a => a -> String
show Double
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"s"
    case ByteString -> Either String FetchedContainer
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
out of
      Right FetchedContainer {Text
ContainerDigest
imageDigest :: ContainerDigest
sha256 :: Text
$sel:imageDigest:FetchedContainer :: FetchedContainer -> ContainerDigest
$sel:sha256:FetchedContainer :: FetchedContainer -> Text
..} -> do
        Checksum
sri <- Text -> Action Checksum
sha256ToSri Text
sha256
        NixFetcher 'Fetched -> Action (NixFetcher 'Fetched)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FetchDocker {_sha256 :: FetchResult Checksum 'Fetched
_sha256 = FetchResult Checksum 'Fetched
Checksum
sri, _imageDigest :: FetchResult ContainerDigest 'Fetched
_imageDigest = FetchResult ContainerDigest 'Fetched
ContainerDigest
imageDigest, Maybe Bool
Maybe Text
Text
_imageName :: Text
_imageTag :: Text
_fos :: Maybe Text
_farch :: Maybe Text
_finalImageName :: Maybe Text
_finalImageTag :: Maybe Text
_tlsVerify :: Maybe Bool
_imageName :: Text
_imageTag :: Text
_fos :: Maybe Text
_farch :: Maybe Text
_finalImageName :: Maybe Text
_finalImageTag :: Maybe Text
_tlsVerify :: Maybe Bool
..}
      Left String
e -> String -> Action (NixFetcher 'Fetched)
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action (NixFetcher 'Fetched))
-> String -> Action (NixFetcher 'Fetched)
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nix-prefetch-docker as JSON: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e

data FetchedContainer = FetchedContainer
  { FetchedContainer -> ContainerDigest
imageDigest :: ContainerDigest,
    FetchedContainer -> Text
sha256 :: Text
  }
  deriving (Int -> FetchedContainer -> String -> String
[FetchedContainer] -> String -> String
FetchedContainer -> String
(Int -> FetchedContainer -> String -> String)
-> (FetchedContainer -> String)
-> ([FetchedContainer] -> String -> String)
-> Show FetchedContainer
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FetchedContainer -> String -> String
showsPrec :: Int -> FetchedContainer -> String -> String
$cshow :: FetchedContainer -> String
show :: FetchedContainer -> String
$cshowList :: [FetchedContainer] -> String -> String
showList :: [FetchedContainer] -> String -> String
Show, (forall x. FetchedContainer -> Rep FetchedContainer x)
-> (forall x. Rep FetchedContainer x -> FetchedContainer)
-> Generic FetchedContainer
forall x. Rep FetchedContainer x -> FetchedContainer
forall x. FetchedContainer -> Rep FetchedContainer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FetchedContainer -> Rep FetchedContainer x
from :: forall x. FetchedContainer -> Rep FetchedContainer x
$cto :: forall x. Rep FetchedContainer x -> FetchedContainer
to :: forall x. Rep FetchedContainer x -> FetchedContainer
Generic, Value -> Parser [FetchedContainer]
Value -> Parser FetchedContainer
(Value -> Parser FetchedContainer)
-> (Value -> Parser [FetchedContainer])
-> FromJSON FetchedContainer
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FetchedContainer
parseJSON :: Value -> Parser FetchedContainer
$cparseJSONList :: Value -> Parser [FetchedContainer]
parseJSONList :: Value -> Parser [FetchedContainer]
A.FromJSON)

pypiUrl :: Text -> Version -> Text
pypiUrl :: Text -> Version -> Text
pypiUrl Text
pypi (Version -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  let h :: Text
h = Char -> Text -> Text
T.cons (Partial => Text -> Char
Text -> Char
T.head Text
pypi) Text
""
   in [trimming|https://pypi.org/packages/source/$h/$pypi/$pypi-$ver.tar.gz|]

--------------------------------------------------------------------------------

-- | Rules of nix fetcher
prefetchRule :: Rules ()
prefetchRule :: Rules ()
prefetchRule = Rules (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
-> Rules ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rules (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
 -> Rules ())
-> Rules (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$
  (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
-> Rules (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache ((RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
 -> Rules (RunFetch -> Action (Maybe (NixFetcher 'Fetched))))
-> (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
-> Rules (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
forall a b. (a -> b) -> a -> b
$ \(RunFetch ForceFetch
force NixFetcher 'Fresh
f) -> do
    Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ForceFetch
force ForceFetch -> ForceFetch -> Bool
forall a. Eq a => a -> a -> Bool
== ForceFetch
ForceFetch) Action ()
alwaysRerun
    String -> Action ()
putInfo (String -> Action ())
-> (Doc Any -> String) -> Doc Any -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> Action ()) -> Doc Any -> Action ()
forall a b. (a -> b) -> a -> b
$ Doc Any
"#" Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixFetcher 'Fresh -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. NixFetcher 'Fresh -> Doc ann
pretty NixFetcher 'Fresh
f
    Bool
keepGoing <- Action Bool
nvcheckerKeepGoing
    if Bool
keepGoing
      then -- If fetch failed, always rerun and return Nothing
      Action (Maybe (NixFetcher 'Fetched))
-> (ErrorCall -> Action (Maybe (NixFetcher 'Fetched)))
-> Action (Maybe (NixFetcher 'Fetched))
forall e a. Exception e => Action a -> (e -> Action a) -> Action a
actionCatch ((NixFetcher 'Fetched -> Maybe (NixFetcher 'Fetched))
-> Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NixFetcher 'Fetched -> Maybe (NixFetcher 'Fetched)
forall a. a -> Maybe a
Just (Action (NixFetcher 'Fetched)
 -> Action (Maybe (NixFetcher 'Fetched)))
-> (Action (NixFetcher 'Fetched) -> Action (NixFetcher 'Fetched))
-> Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action (NixFetcher 'Fetched) -> Action (NixFetcher 'Fetched)
forall a. Action a -> Action a
withRetry (Action (NixFetcher 'Fetched)
 -> Action (Maybe (NixFetcher 'Fetched)))
-> Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
runFetcher NixFetcher 'Fresh
f) ((ErrorCall -> Action (Maybe (NixFetcher 'Fetched)))
 -> Action (Maybe (NixFetcher 'Fetched)))
-> (ErrorCall -> Action (Maybe (NixFetcher 'Fetched)))
-> Action (Maybe (NixFetcher 'Fetched))
forall a b. (a -> b) -> a -> b
$ \(ErrorCall
e :: ErrorCall) -> do
        Action ()
alwaysRerun
        String -> Action ()
putError (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ ErrorCall -> String
forall a. Show a => a -> String
show ErrorCall
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nKeep going..."
        Maybe (NixFetcher 'Fetched) -> Action (Maybe (NixFetcher 'Fetched))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NixFetcher 'Fetched)
forall a. Maybe a
Nothing
      else (NixFetcher 'Fetched -> Maybe (NixFetcher 'Fetched))
-> Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NixFetcher 'Fetched -> Maybe (NixFetcher 'Fetched)
forall a. a -> Maybe a
Just (Action (NixFetcher 'Fetched)
 -> Action (Maybe (NixFetcher 'Fetched)))
-> (Action (NixFetcher 'Fetched) -> Action (NixFetcher 'Fetched))
-> Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action (NixFetcher 'Fetched) -> Action (NixFetcher 'Fetched)
forall a. Action a -> Action a
withRetry (Action (NixFetcher 'Fetched)
 -> Action (Maybe (NixFetcher 'Fetched)))
-> Action (NixFetcher 'Fetched)
-> Action (Maybe (NixFetcher 'Fetched))
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fresh -> Action (NixFetcher 'Fetched)
runFetcher NixFetcher 'Fresh
f

-- | Run nix fetcher
prefetch :: NixFetcher Fresh -> ForceFetch -> Action (Maybe (NixFetcher Fetched))
prefetch :: NixFetcher 'Fresh
-> ForceFetch -> Action (Maybe (NixFetcher 'Fetched))
prefetch NixFetcher 'Fresh
f ForceFetch
force = RunFetch -> Action (Maybe (NixFetcher 'Fetched))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (RunFetch -> Action (Maybe (NixFetcher 'Fetched)))
-> RunFetch -> Action (Maybe (NixFetcher 'Fetched))
forall a b. (a -> b) -> a -> b
$ ForceFetch -> NixFetcher 'Fresh -> RunFetch
RunFetch ForceFetch
force NixFetcher 'Fresh
f

--------------------------------------------------------------------------------

-- | Create a fetcher from git url
gitFetcher :: Text -> PackageFetcher
gitFetcher :: Text -> PackageFetcher
gitFetcher Text
furl Version
rev = Text
-> Version
-> Bool
-> Bool
-> Bool
-> [Text]
-> Maybe Text
-> FetchResult Checksum 'Fresh
-> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text
-> Version
-> Bool
-> Bool
-> Bool
-> [Text]
-> Maybe Text
-> FetchResult Checksum k
-> NixFetcher k
FetchGit Text
furl Version
rev Bool
False Bool
True Bool
False [] Maybe Text
forall a. Maybe a
Nothing ()

-- | Create a fetcher from github repo
gitHubFetcher ::
  -- | owner and repo
  (Text, Text) ->
  PackageFetcher
gitHubFetcher :: (Text, Text) -> PackageFetcher
gitHubFetcher (Text
owner, Text
repo) Version
rev = Text
-> Text
-> Version
-> Bool
-> Bool
-> Bool
-> [Text]
-> Maybe Text
-> FetchResult Checksum 'Fresh
-> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text
-> Text
-> Version
-> Bool
-> Bool
-> Bool
-> [Text]
-> Maybe Text
-> FetchResult Checksum k
-> NixFetcher k
FetchGitHub Text
owner Text
repo Version
rev Bool
False Bool
False Bool
False [] Maybe Text
forall a. Maybe a
Nothing ()

-- | Create a fetcher from pypi
pypiFetcher :: Text -> PackageFetcher
pypiFetcher :: Text -> PackageFetcher
pypiFetcher Text
p Version
v = Text -> NixFetcher 'Fresh
urlFetcher (Text -> NixFetcher 'Fresh) -> Text -> NixFetcher 'Fresh
forall a b. (a -> b) -> a -> b
$ Text -> Version -> Text
pypiUrl Text
p Version
v

-- | Create a fetcher from github release
gitHubReleaseFetcher ::
  -- | owner and repo
  (Text, Text) ->
  -- | file name
  Text ->
  PackageFetcher
gitHubReleaseFetcher :: (Text, Text) -> Text -> PackageFetcher
gitHubReleaseFetcher (Text
owner, Text
repo) Text
fp = (Text, Text) -> (Version -> Text) -> PackageFetcher
gitHubReleaseFetcher' (Text
owner, Text
repo) ((Version -> Text) -> PackageFetcher)
-> (Version -> Text) -> PackageFetcher
forall a b. (a -> b) -> a -> b
$ Text -> Version -> Text
forall a b. a -> b -> a
const Text
fp

-- | Create a fetcher from github release
gitHubReleaseFetcher' ::
  -- | owner and repo
  (Text, Text) ->
  -- | file name computed from version
  (Version -> Text) ->
  PackageFetcher
gitHubReleaseFetcher' :: (Text, Text) -> (Version -> Text) -> PackageFetcher
gitHubReleaseFetcher' (Text
owner, Text
repo) Version -> Text
f (Version -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  let fp :: Text
fp = Version -> Text
f (Version -> Text) -> Version -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Version
forall a b. Coercible a b => a -> b
coerce Text
ver
   in Text -> NixFetcher 'Fresh
urlFetcher
        [trimming|https://github.com/$owner/$repo/releases/download/$ver/$fp|]

-- | Create a fetcher from url
urlFetcher :: Text -> NixFetcher Fresh
urlFetcher :: Text -> NixFetcher 'Fresh
urlFetcher Text
url = Text
-> Maybe Text -> FetchResult Checksum 'Fresh -> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl Text
url Maybe Text
forall a. Maybe a
Nothing ()

-- | Create a fetcher from url specifying the file name
urlFetcher' :: Text -> Maybe Text -> NixFetcher Fresh
urlFetcher' :: Text -> Maybe Text -> NixFetcher 'Fresh
urlFetcher' Text
url Maybe Text
name = Text
-> Maybe Text -> FetchResult Checksum 'Fresh -> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl Text
url Maybe Text
name ()

-- | Create a fetcher from openvsx
openVsxFetcher ::
  -- | publisher and extension name
  (Text, Text) ->
  PackageFetcher
openVsxFetcher :: (Text, Text) -> PackageFetcher
openVsxFetcher (Text
publisher, Text
extName) (Version -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  Text
-> Maybe Text -> FetchResult Checksum 'Fresh -> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl
    [trimming|https://open-vsx.org/api/$publisher/$extName/$ver/file/$publisher.$extName-$ver.vsix|]
    (Text -> Maybe Text
forall a. a -> Maybe a
Just [trimming|$extName-$ver.zip|])
    ()

-- | Create a fetcher from vscode marketplace
vscodeMarketplaceFetcher ::
  -- | publisher and extension name
  (Text, Text) ->
  PackageFetcher
vscodeMarketplaceFetcher :: (Text, Text) -> PackageFetcher
vscodeMarketplaceFetcher (Text
publisher, Text
extName) (Version -> Text
forall a b. Coercible a b => a -> b
coerce -> Text
ver) =
  Text
-> Maybe Text -> FetchResult Checksum 'Fresh -> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text -> Maybe Text -> FetchResult Checksum k -> NixFetcher k
FetchUrl
    [trimming|https://$publisher.gallery.vsassets.io/_apis/public/gallery/publisher/$publisher/extension/$extName/$ver/assetbyname/Microsoft.VisualStudio.Services.VSIXPackage|]
    (Text -> Maybe Text
forall a. a -> Maybe a
Just [trimming|$extName-$ver.zip|])
    ()

-- | Create a fetcher from url, using fetchTarball
tarballFetcher :: Text -> NixFetcher Fresh
tarballFetcher :: Text -> NixFetcher 'Fresh
tarballFetcher Text
url = Text -> FetchResult Checksum 'Fresh -> NixFetcher 'Fresh
forall (k :: FetchStatus).
Text -> FetchResult Checksum k -> NixFetcher k
FetchTarball Text
url ()