{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module    : Nix.JenkinsPlugins2Nix
-- Copyright : (c) 2017 Mateusz Kowalczyk
-- License   : BSD3
--
-- Main library entry point.
module Nix.JenkinsPlugins2Nix where

import qualified Codec.Archive.Zip             as Zip
import           Control.Arrow                 ((&&&))
import           Control.Monad                 (foldM)
import qualified Control.Monad.Except          as MTL
import qualified Crypto.Hash                   as Hash
import qualified Data.ByteString.Lazy          as BSL
import           Data.Map.Strict               (Map)
import qualified Data.Map.Strict               as Map
import           Data.Monoid                   ((<>))
import           Data.Text                     (Text)
import qualified Data.Text                     as Text
import qualified Data.Text.Encoding            as Text
import qualified Data.Text.IO                  as Text
import           Data.Text.Prettyprint.Doc     (Doc)
import qualified Network.HTTP.Simple           as HTTP
import qualified Nix.Expr                      as Nix
import           Nix.Expr.Shorthands           ((@@))
import qualified Nix.JenkinsPlugins2Nix.Parser as Parser
import           Nix.JenkinsPlugins2Nix.Types
import qualified Nix.Pretty                    as Nix
import           System.IO                     (stderr)
import           Text.Printf                   (printf)

-- | Get the download URL of the plugin we're looking for.
getPluginUrl :: RequestedPlugin -> Text
getPluginUrl :: RequestedPlugin -> Text
getPluginUrl (RequestedPlugin { requested_name :: RequestedPlugin -> Text
requested_name = Text
n, requested_version :: RequestedPlugin -> Maybe Text
requested_version = Just Text
v })
  = String -> Text
Text.pack
  (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"https://updates.jenkins-ci.org/download/plugins/%s/%s/%s.hpi"
           (Text -> String
Text.unpack Text
n) (Text -> String
Text.unpack Text
v) (Text -> String
Text.unpack Text
n)
getPluginUrl (RequestedPlugin { requested_name :: RequestedPlugin -> Text
requested_name = Text
n, requested_version :: RequestedPlugin -> Maybe Text
requested_version = Maybe Text
Nothing })
  = String -> Text
Text.pack
  (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"https://updates.jenkins-ci.org/latest/%s.hpi"
           (Text -> String
Text.unpack Text
n)

-- | Download a plugin from 'getPluginUrl'.
downloadPlugin :: RequestedPlugin -> IO (Either String Plugin)
downloadPlugin :: RequestedPlugin -> IO (Either String Plugin)
downloadPlugin RequestedPlugin
p = do
  let fullUrl :: Text
fullUrl = RequestedPlugin -> Text
getPluginUrl RequestedPlugin
p
  Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Downloading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fullUrl
  Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
fullUrl
  ByteString
archiveLBS <- Response ByteString -> ByteString
forall a. Response a -> a
HTTP.getResponseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HTTP.httpLBS Request
req
  let manifestFileText :: Maybe Text
manifestFileText = (Entry -> Text) -> Maybe Entry -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (Entry -> ByteString) -> Entry -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Entry -> ByteString) -> Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
Zip.fromEntry)
                       (Maybe Entry -> Maybe Text) -> Maybe Entry -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Archive -> Maybe Entry
Zip.findEntryByPath String
"META-INF/MANIFEST.MF"
                       (Archive -> Maybe Entry) -> Archive -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ ByteString -> Archive
Zip.toArchive ByteString
archiveLBS
  case Maybe Text
manifestFileText of
    Maybe Text
Nothing -> Either String Plugin -> IO (Either String Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Plugin -> IO (Either String Plugin))
-> Either String Plugin -> IO (Either String Plugin)
forall a b. (a -> b) -> a -> b
$ String -> Either String Plugin
forall a b. a -> Either a b
Left String
"Could not find manifest file in the archive."
    Just Text
t -> Either String Plugin -> IO (Either String Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Plugin -> IO (Either String Plugin))
-> Either String Plugin -> IO (Either String Plugin)
forall a b. (a -> b) -> a -> b
$! case Text -> Either String Manifest
Parser.runParseManifest Text
t of
      Left String
err -> String -> Either String Plugin
forall a b. a -> Either a b
Left String
err
      Right Manifest
manifest' -> Plugin -> Either String Plugin
forall a b. b -> Either a b
Right (Plugin -> Either String Plugin) -> Plugin -> Either String Plugin
forall a b. (a -> b) -> a -> b
$! Plugin :: Text -> Digest SHA256 -> Manifest -> Plugin
Plugin
           -- We have to account for user not specifying the version.
           -- If they haven't, we downloaded the latest version and do
           -- not have a URL pointing at static resource. We do
           -- however have the version of the package now so we can
           -- reconstruct the URL.
        { download_url :: Text
download_url = RequestedPlugin -> Text
getPluginUrl (RequestedPlugin -> Text) -> RequestedPlugin -> Text
forall a b. (a -> b) -> a -> b
$
            RequestedPlugin
p { requested_version :: Maybe Text
requested_version = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! Manifest -> Text
plugin_version Manifest
manifest' }
        , sha256 :: Digest SHA256
sha256 = ByteString -> Digest SHA256
forall a. HashAlgorithm a => ByteString -> Digest a
Hash.hashlazy ByteString
archiveLBS
        , manifest :: Manifest
manifest = Manifest
manifest'
        }

-- | Download the given plugin as well as recursively download its dependencies.
downloadPluginsRecursive
  :: ResolutionStrategy -- ^ Decide what version of dependencies to pick.
  -> Map Text RequestedPlugin -- ^ Plugins user requested.
  -> Map Text Plugin -- ^ Already downloaded plugins.
  -> RequestedPlugin -- ^ Plugin we're going to download.
  -> MTL.ExceptT String IO (Map Text Plugin)
downloadPluginsRecursive :: ResolutionStrategy
-> Map Text RequestedPlugin
-> Map Text Plugin
-> RequestedPlugin
-> ExceptT String IO (Map Text Plugin)
downloadPluginsRecursive ResolutionStrategy
strategy Map Text RequestedPlugin
uPs Map Text Plugin
m RequestedPlugin
p = if Text -> Map Text Plugin -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (RequestedPlugin -> Text
requested_name RequestedPlugin
p) Map Text Plugin
m
  then Map Text Plugin -> ExceptT String IO (Map Text Plugin)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text Plugin
m
  else do
        -- Adjust the requested plugin based on whether it was
        -- specifically requested by the user and on resolution
        -- strategy.
    let adjustedPlugin :: RequestedPlugin
adjustedPlugin = case Text -> Map Text RequestedPlugin -> Maybe RequestedPlugin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (RequestedPlugin -> Text
requested_name RequestedPlugin
p) Map Text RequestedPlugin
uPs of
          -- This is not a user-requested plugin which means we have
          -- to decide what version we're going to grab.
          Maybe RequestedPlugin
Nothing -> case ResolutionStrategy
strategy of
            -- We're just going with whatever was in the manifest
            -- file, i.e. the thing we passed in in the first place.
            ResolutionStrategy
AsGiven -> RequestedPlugin
p
            -- It's not a user-specified plugin and we want the latest
            -- version per strategy so download the latest one.
            ResolutionStrategy
Latest  -> RequestedPlugin
p { requested_version :: Maybe Text
requested_version = Maybe Text
forall a. Maybe a
Nothing }
          -- The user has asked for this plugin explicitly so use
          -- their possibly-versioned request rather than picking
          -- based on versions listed in manifest dependencies.
          Just RequestedPlugin
userPlugin -> RequestedPlugin
userPlugin
    Plugin
plugin <- IO (Either String Plugin) -> ExceptT String IO Plugin
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
MTL.ExceptT (IO (Either String Plugin) -> ExceptT String IO Plugin)
-> IO (Either String Plugin) -> ExceptT String IO Plugin
forall a b. (a -> b) -> a -> b
$ RequestedPlugin -> IO (Either String Plugin)
downloadPlugin RequestedPlugin
adjustedPlugin
    (Map Text Plugin
 -> PluginDependency -> ExceptT String IO (Map Text Plugin))
-> Map Text Plugin
-> Set PluginDependency
-> ExceptT String IO (Map Text Plugin)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map Text Plugin
m' PluginDependency
p' -> ResolutionStrategy
-> Map Text RequestedPlugin
-> Map Text Plugin
-> RequestedPlugin
-> ExceptT String IO (Map Text Plugin)
downloadPluginsRecursive ResolutionStrategy
strategy Map Text RequestedPlugin
uPs Map Text Plugin
m' (RequestedPlugin -> ExceptT String IO (Map Text Plugin))
-> RequestedPlugin -> ExceptT String IO (Map Text Plugin)
forall a b. (a -> b) -> a -> b
$
              RequestedPlugin :: Text -> Maybe Text -> RequestedPlugin
RequestedPlugin { requested_name :: Text
requested_name = PluginDependency -> Text
plugin_dependency_name PluginDependency
p'
                              , requested_version :: Maybe Text
requested_version = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$! PluginDependency -> Text
plugin_dependency_version PluginDependency
p'
                              })
      (Text -> Plugin -> Map Text Plugin -> Map Text Plugin
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (RequestedPlugin -> Text
requested_name RequestedPlugin
p) Plugin
plugin Map Text Plugin
m)
      (Manifest -> Set PluginDependency
plugin_dependencies (Manifest -> Set PluginDependency)
-> Manifest -> Set PluginDependency
forall a b. (a -> b) -> a -> b
$ Plugin -> Manifest
manifest Plugin
plugin)

-- | Pretty-print nix expression for all the given plugins and their
-- dependencies that the user asked for.
mkExprsFor :: Config
           -> IO (Either String (Doc ann))
mkExprsFor :: Config -> IO (Either String (Doc ann))
mkExprsFor (Config { resolution_strategy :: Config -> ResolutionStrategy
resolution_strategy = ResolutionStrategy
st, requested_plugins :: Config -> [RequestedPlugin]
requested_plugins = [RequestedPlugin]
ps }) = do
  Either String [Plugin]
eplugins <- ExceptT String IO [Plugin] -> IO (Either String [Plugin])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
MTL.runExceptT (ExceptT String IO [Plugin] -> IO (Either String [Plugin]))
-> ExceptT String IO [Plugin] -> IO (Either String [Plugin])
forall a b. (a -> b) -> a -> b
$ do
    let userPlugins :: Map Text RequestedPlugin
userPlugins = [(Text, RequestedPlugin)] -> Map Text RequestedPlugin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, RequestedPlugin)] -> Map Text RequestedPlugin)
-> [(Text, RequestedPlugin)] -> Map Text RequestedPlugin
forall a b. (a -> b) -> a -> b
$ (RequestedPlugin -> (Text, RequestedPlugin))
-> [RequestedPlugin] -> [(Text, RequestedPlugin)]
forall a b. (a -> b) -> [a] -> [b]
map (RequestedPlugin -> Text
requested_name (RequestedPlugin -> Text)
-> (RequestedPlugin -> RequestedPlugin)
-> RequestedPlugin
-> (Text, RequestedPlugin)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& RequestedPlugin -> RequestedPlugin
forall a. a -> a
id) [RequestedPlugin]
ps
    Map Text Plugin
plugins <- (Map Text Plugin
 -> RequestedPlugin -> ExceptT String IO (Map Text Plugin))
-> Map Text Plugin
-> [RequestedPlugin]
-> ExceptT String IO (Map Text Plugin)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ResolutionStrategy
-> Map Text RequestedPlugin
-> Map Text Plugin
-> RequestedPlugin
-> ExceptT String IO (Map Text Plugin)
downloadPluginsRecursive ResolutionStrategy
st Map Text RequestedPlugin
userPlugins) Map Text Plugin
forall k a. Map k a
Map.empty [RequestedPlugin]
ps
    [Plugin] -> ExceptT String IO [Plugin]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Plugin] -> ExceptT String IO [Plugin])
-> [Plugin] -> ExceptT String IO [Plugin]
forall a b. (a -> b) -> a -> b
$ Map Text Plugin -> [Plugin]
forall k a. Map k a -> [a]
Map.elems Map Text Plugin
plugins
  Either String (Doc ann) -> IO (Either String (Doc ann))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Doc ann) -> IO (Either String (Doc ann)))
-> Either String (Doc ann) -> IO (Either String (Doc ann))
forall a b. (a -> b) -> a -> b
$! case Either String [Plugin]
eplugins of
    Left String
err -> String -> Either String (Doc ann)
forall a b. a -> Either a b
Left String
err
    Right [Plugin]
plugins ->
      let args :: Params NExpr
args = [(Text, Maybe NExpr)] -> Bool -> Params NExpr
Nix.mkParamset [(Text, Maybe NExpr)]
exprs Bool
False
          res :: NExpr
res = [Binding NExpr] -> NExpr
Nix.mkNonRecSet ([Binding NExpr] -> NExpr) -> [Binding NExpr] -> NExpr
forall a b. (a -> b) -> a -> b
$ (Plugin -> Binding NExpr) -> [Plugin] -> [Binding NExpr]
forall a b. (a -> b) -> [a] -> [b]
map Plugin -> Binding NExpr
formatPlugin [Plugin]
plugins
          mkJenkinsPlugin :: Binding NExpr
mkJenkinsPlugin = Text -> NExpr -> Binding NExpr
Nix.bindTo Text
"mkJenkinsPlugin" (NExpr -> Binding NExpr) -> NExpr -> Binding NExpr
forall a b. (a -> b) -> a -> b
$
            Params NExpr -> NExpr -> NExpr
Nix.mkFunction ([(Text, Maybe NExpr)] -> Bool -> Params NExpr
Nix.mkParamset
                              [ (Text
"name", Maybe NExpr
forall a. Maybe a
Nothing)
                              , (Text
"src", Maybe NExpr
forall a. Maybe a
Nothing)
                              ]
                              Bool
False) (NExpr -> NExpr) -> NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$
              Text -> NExpr
Nix.mkSym Text
"stdenv.mkDerivation" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
Nix.mkNonRecSet
                [ [NKeyName NExpr] -> SourcePos -> Binding NExpr
forall e. [NKeyName e] -> SourcePos -> Binding e
Nix.inherit [ Text -> NKeyName NExpr
forall r. Text -> NKeyName r
Nix.StaticKey Text
"name"
                              , Text -> NKeyName NExpr
forall r. Text -> NKeyName r
Nix.StaticKey Text
"src" ] SourcePos
Nix.nullPos
                , Text
"phases" Text -> NExpr -> Binding NExpr
Nix.$= Text -> NExpr
Nix.mkStr Text
"installPhase"
                , Text
"installPhase" Text -> NExpr -> Binding NExpr
Nix.$= Text -> NExpr
Nix.mkStr Text
"cp $src $out"
                ]
      in Doc ann -> Either String (Doc ann)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc ann -> Either String (Doc ann))
-> Doc ann -> Either String (Doc ann)
forall a b. (a -> b) -> a -> b
$ NExpr -> Doc ann
forall ann. NExpr -> Doc ann
Nix.prettyNix
                (NExpr -> Doc ann) -> NExpr -> Doc ann
forall a b. (a -> b) -> a -> b
$ Params NExpr -> NExpr -> NExpr
Nix.mkFunction Params NExpr
args
                (NExpr -> NExpr) -> NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ [Binding NExpr] -> NExpr -> NExpr
Nix.mkLets [Binding NExpr
mkJenkinsPlugin] NExpr
res

  where
    fetchurl :: Plugin -> Nix.NExpr
    fetchurl :: Plugin -> NExpr
fetchurl Plugin
p = Text -> NExpr
Nix.mkSym Text
"fetchurl" NExpr -> NExpr -> NExpr
@@
      [Binding NExpr] -> NExpr
Nix.mkNonRecSet [ Text
"url" Text -> NExpr -> Binding NExpr
Nix.$= Text -> NExpr
Nix.mkStr (Plugin -> Text
download_url Plugin
p)
                      , Text
"sha256" Text -> NExpr -> Binding NExpr
Nix.$= Text -> NExpr
Nix.mkStr (String -> Text
Text.pack (String -> Text)
-> (Digest SHA256 -> String) -> Digest SHA256 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> String
forall a. Show a => a -> String
show (Digest SHA256 -> Text) -> Digest SHA256 -> Text
forall a b. (a -> b) -> a -> b
$ Plugin -> Digest SHA256
sha256 Plugin
p)
                      ]

    mkBody :: Plugin -> Nix.NExpr
    mkBody :: Plugin -> NExpr
mkBody Plugin
p = Text -> NExpr
Nix.mkSym Text
"mkJenkinsPlugin" NExpr -> NExpr -> NExpr
@@
      [Binding NExpr] -> NExpr
Nix.mkNonRecSet [ Text
"name" Text -> NExpr -> Binding NExpr
Nix.$= Text -> NExpr
Nix.mkStr (Manifest -> Text
short_name (Manifest -> Text) -> Manifest -> Text
forall a b. (a -> b) -> a -> b
$ Plugin -> Manifest
manifest Plugin
p)
                      , Text
"src" Text -> NExpr -> Binding NExpr
Nix.$= Plugin -> NExpr
fetchurl Plugin
p
                      ]

    formatPlugin :: Plugin -> Nix.Binding Nix.NExpr
    formatPlugin :: Plugin -> Binding NExpr
formatPlugin Plugin
p = Manifest -> Text
short_name (Plugin -> Manifest
manifest Plugin
p) Text -> NExpr -> Binding NExpr
Nix.$= Plugin -> NExpr
mkBody Plugin
p

    exprs :: [(Text, Maybe Nix.NExpr)]
    exprs :: [(Text, Maybe NExpr)]
exprs =
      [ (Text
"stdenv", Maybe NExpr
forall a. Maybe a
Nothing)
      , (Text
"fetchurl", Maybe NExpr
forall a. Maybe a
Nothing)
      ]