language-puppet 1.2 → 1.3
raw patch · 14 files changed
+69/−236 lines, 14 filesdep −hsluadep ~http-clientdep ~servantdep ~servant-client
Dependencies removed: hslua
Dependency ranges changed: http-client, servant, servant-client
Files
- CHANGELOG.markdown +7/−0
- Puppet/Daemon.hs +2/−6
- Puppet/Interpreter.hs +6/−6
- Puppet/Interpreter/IO.hs +13/−22
- Puppet/Interpreter/PrettyPrinter.hs +0/−1
- Puppet/Interpreter/Pure.hs +1/−1
- Puppet/Interpreter/Types.hs +0/−6
- Puppet/Interpreter/Utils.hs +3/−3
- Puppet/Plugins.hs +0/−165
- Puppet/Preferences.hs +0/−1
- Puppet/Utils.hs +16/−0
- PuppetDB/Remote.hs +14/−16
- README.adoc +3/−3
- language-puppet.cabal +4/−6
CHANGELOG.markdown view
@@ -1,3 +1,10 @@+#v1.3 (2016/07/11)++This release is about dependencies versions upgrades.++## Removed features+* External Lua plugins are not a thing anymore+ #v1.2 (2016/05/31) ## New features
Puppet/Daemon.hs view
@@ -16,7 +16,6 @@ import Control.Lens hiding (Strict) import qualified Data.Either.Strict as S import Data.FileCache as FileCache-import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Tuple.Strict@@ -40,7 +39,6 @@ import Puppet.OptionalTests import Puppet.Parser import Puppet.Parser.Types-import Puppet.Plugins import Puppet.PP import Puppet.Preferences import Puppet.Stats@@ -83,12 +81,10 @@ > ssh -L 8080:localhost:8080 puppet.host -} initDaemon :: Preferences IO -> IO Daemon-initDaemon pref0 = do- setupLogger (pref0 ^. prefLogLevel)+initDaemon pref = do+ setupLogger (pref ^. prefLogLevel) logDebug "initDaemon" traceEventIO "initDaemon"- luacontainer <- initLuaMaster (T.pack (pref0 ^. prefPuppetPaths.modulesPath))- let pref = pref0 & prefExtFuncs %~ HM.union luacontainer hquery <- case pref ^. prefHieraPath of Just p -> either error id <$> startHiera p Nothing -> return dummyHiera
Puppet/Interpreter.hs view
@@ -53,12 +53,12 @@ 'InterpreterState' and might not be up to date. There are only useful for coverage testing (checking dependencies for instance). -}-interpretCatalog :: (Functor m, Monad m)- => InterpreterReader m -- ^ The whole environment required for computing catalog.- -> NodeName- -> Facts- -> Container Text -- ^ Server settings- -> m (Pair (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) [Pair Priority Doc])+interpretCatalog :: Monad m+ => InterpreterReader m -- ^ The whole environment required for computing catalog.+ -> NodeName+ -> Facts+ -> Container Text -- ^ Server settings+ -> m (Pair (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])) [Pair Priority Doc]) interpretCatalog interpretReader node facts settings = do (output, _, warnings) <- interpretMonad interpretReader (initialState facts settings) (computeCatalog node) return (strictifyEither output :!: warnings)
Puppet/Interpreter/IO.hs view
@@ -10,7 +10,6 @@ , interpretMonad ) where -import Control.Concurrent.MVar import Control.Exception import Control.Lens import Control.Monad.Operational@@ -22,40 +21,35 @@ import qualified Data.Text.IO as T import Debug.Trace (traceEventIO) import GHC.Stack-import qualified Scripting.Lua as Lua import Puppet.Interpreter.PrettyPrinter () import Puppet.Interpreter.Types-import Puppet.Plugins () import Puppet.PP -defaultImpureMethods :: (Functor m, MonadIO m) => IoMethods m+defaultImpureMethods :: MonadIO m => IoMethods m defaultImpureMethods = IoMethods (liftIO currentCallStack)- (liftIO . file)- (liftIO . traceEventIO)- (\c fname args -> liftIO (runlua c fname args))+ (liftIO . file)+ (liftIO . traceEventIO) where file [] = return $ Left "" file (x:xs) = (Right <$> T.readFile (T.unpack x)) `catch` (\SomeException{} -> file xs)- runlua c fname args = liftIO $ withMVar c $ \lstt ->- catch (Right <$> Lua.callfunc lstt (T.unpack fname) args) (\e -> return $ Left $ show (e :: SomeException)) -- | The operational interpreter function-interpretMonad :: (Functor m, Monad m)- => InterpreterReader m- -> InterpreterState- -> InterpreterMonad a- -> m (Either PrettyError a, InterpreterState, InterpreterWriter)+interpretMonad :: Monad m+ => InterpreterReader m+ -> InterpreterState+ -> InterpreterMonad a+ -> m (Either PrettyError a, InterpreterState, InterpreterWriter) interpretMonad r s0 instr = let (!p, !s1) = runState (viewT instr) s0 in eval r s1 p -- The internal (not exposed) eval function-eval :: (Functor m, Monad m)- => InterpreterReader m- -> InterpreterState- -> ProgramViewT InterpreterInstr (State InterpreterState) a- -> m (Either PrettyError a, InterpreterState, InterpreterWriter)+eval :: Monad m+ => InterpreterReader m+ -> InterpreterState+ -> ProgramViewT InterpreterInstr (State InterpreterState) a+ -> m (Either PrettyError a, InterpreterState, InterpreterWriter) eval _ s (Return x) = return (Right x, s, mempty) eval r s (a :>>= k) = let runInstr = interpretMonad r s . k -- run one instruction@@ -102,6 +96,3 @@ TraceEvent e -> (r ^. readerIoMethods . ioTraceEvent) e >>= runInstr IsIgnoredModule m -> runInstr (r ^. readerIgnoredModules . contains m) IsExternalModule m -> runInstr (r ^. readerExternalModules . contains m)- CallLua c fname args -> (r ^. readerIoMethods . ioCallLua) c fname args >>= \case- Right x -> runInstr x- Left rr -> thpe (PrettyError (string rr))
Puppet/Interpreter/PrettyPrinter.hs view
@@ -139,7 +139,6 @@ Left content -> pretty (PString content) Right filena -> ttext filena pretty (ExternalFunction fn args) = pf (ttext fn) (map pretty args)- pretty (CallLua _ f args) = pf (ttext f) (map pretty args) pretty GetNodeName = pf "GetNodeName" [] pretty (HieraQuery _ q _) = pf "HieraQuery" [ttext q] pretty GetCurrentCallStack = pf "GetCurrentCallStack" []
Puppet/Interpreter/Pure.hs view
@@ -27,7 +27,7 @@ -- | Worst name ever, this is a set of pure stub for the 'ImpureMethods' -- type. impurePure :: IoMethods Identity-impurePure = IoMethods (return []) (const (return (Left "Can't read file"))) (\_ -> return ()) (\_ _ _ -> return (Left "Can't call lua"))+impurePure = IoMethods (return []) (const (return (Left "Can't read file"))) (\_ -> return ()) -- | A pure 'InterpreterReader', that can only evaluate a subset of the -- templates, and that can include only the supplied top level statements.
Puppet/Interpreter/Types.hs view
@@ -79,7 +79,6 @@ , showPos ) where -import Control.Concurrent.MVar (MVar) import Control.Exception import Control.Lens hiding (Strict) import Control.Monad.Except@@ -106,7 +105,6 @@ import Foreign.Ruby.Helpers import GHC.Generics hiding (to) import GHC.Stack-import qualified Scripting.Lua as Lua import qualified System.Log.Logger as LOG import Text.Megaparsec.Pos import Web.HttpApiData (ToHttpApiData(..))@@ -283,7 +281,6 @@ { _ioGetCurrentCallStack :: m [String] , _ioReadFile :: [Text] -> m (Either String T.Text) , _ioTraceEvent :: String -> m ()- , _ioCallLua :: MVar Lua.LuaState -> Text -> [PValue] -> m (Either String PValue) } data InterpreterInstr a where@@ -320,9 +317,6 @@ ReadFile :: [Text] -> InterpreterInstr T.Text -- Tracing events TraceEvent :: String -> InterpreterInstr ()- -- Calling Lua- CallLua :: MVar Lua.LuaState -> Text -> [PValue] -> InterpreterInstr PValue- -- | The main monad type InterpreterMonad = ProgramT InterpreterInstr (State InterpreterState)
Puppet/Interpreter/Utils.hs view
@@ -133,13 +133,13 @@ -- Logging ---warn :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m ()+warn :: MonadWriter InterpreterWriter m => Doc -> m () warn d = tell [LOG.WARNING :!: d] -debug :: (Monad m, MonadWriter InterpreterWriter m) => Doc -> m ()+debug :: MonadWriter InterpreterWriter m => Doc -> m () debug d = tell [LOG.DEBUG :!: d] -logWriter :: (Monad m, MonadWriter InterpreterWriter m) => LOG.Priority -> Doc -> m ()+logWriter :: MonadWriter InterpreterWriter m => LOG.Priority -> Doc -> m () logWriter prio d = tell [prio :!: d] -- General --
− Puppet/Plugins.hs
@@ -1,165 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-| This module is used for user plugins. It exports three functions that should-be easy to use: 'initLua', 'puppetFunc' and 'closeLua'. Right now it is used by-the "Puppet.Daemon" by initializing and destroying the Lua context for each-catalog computation. Obviously such plugins will be implemented in Lua.--Users plugins are right now limited to custom functions. The user must put them-at the exact same place as their Ruby counterparts, except the extension must be-lua instead of rb. In the file, a function called by the same name that takes a-single argument must be defined. This argument will be an array made of all the-functions arguments. If the file doesn't parse, it will be silently ignored.--Here are the things that must be kept in mind:--* Lua doesn't have integers. All numbers are double.--* All Lua associative arrays that are returned must have a "simple" type for all-the keys, as it will be converted to a string. Numbers will be directly-converted and other types will produce strange results. (currently this doesn't work at all, all associative arrays will be turned into lists, ignoring the keys)--* This currently only works for functions that must return a value. They will-have no access to the manifests data.---}-module Puppet.Plugins (initLua, initLuaMaster, puppetFunc, closeLua, getFiles) where--import Puppet.PP-import qualified Scripting.Lua as Lua-import Control.Exception-import qualified Data.HashMap.Strict as HM-import System.IO-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import qualified Data.Vector as V-import Control.Concurrent-import Control.Monad.Except-import Control.Monad.Operational (singleton)-import Data.Scientific-import qualified Data.ByteString as BS-import Control.Lens-import Debug.Trace--import Puppet.Interpreter.Types-import Puppet.Utils--instance Lua.StackValue PValue- where- push l (PString s) = Lua.push l (T.encodeUtf8 s)- push l (PBoolean b) = Lua.push l b- push l (PResourceReference rr _) = Lua.push l (T.encodeUtf8 rr)- push l (PArray arr) = Lua.push l (V.toList arr)- push l (PHash m) = do- Lua.newtable l- forM_ (HM.toList m) $ \(k,v) -> do- Lua.push l (T.encodeUtf8 k)- Lua.push l v- Lua.settable l (-3)- push l (PUndef) = Lua.push l ("undefined" :: BS.ByteString)- push l (PNumber b) = Lua.push l (fromRational (toRational b) :: Double)-- peek l n = Lua.ltype l n >>= \case- Lua.TBOOLEAN -> fmap (fmap PBoolean) (Lua.peek l n)- Lua.TSTRING -> do- cnt <- Lua.peek l n- case fmap T.decodeUtf8' cnt of- Just (Right t) -> return (Just $ PString t)- _ -> return Nothing- Lua.TNUMBER -> fmap (fmap (PNumber . fromFloatDigits)) (Lua.peek l n :: IO (Maybe Double))- Lua.TNIL -> return (Just PUndef)- Lua.TNONE -> return (Just PUndef)- Lua.TTABLE -> do- let go tidx m = do- isnext <- Lua.next l tidx- if isnext- then do- mk <- Lua.peek l (-2)- mv <- Lua.peek l (-1)- traceShow (mk, mv) $ return ()- Lua.pop l 1- case HM.insert <$> (mk >>= preview _Right . T.decodeUtf8') <*> mv <*> pure m of- Just m' -> go tidx m'- Nothing -> return Nothing- else return $ Just $ PHash m- ln <- Lua.objlen l n- if ln > 0- then fmap (PArray . V.fromList) <$> Lua.tolist l n- else do- tidx <- if n >= 0- then return n- else fmap (\top -> top + n + 1) (Lua.gettop l)- Lua.pushnil l- go tidx mempty-- _ -> return Nothing-- valuetype _ = Lua.TUSERDATA--getDirContents :: T.Text -> IO [T.Text]-getDirContents x = fmap (filter (not . T.all (=='.'))) (getDirectoryContents x)---- find files in subdirectories-checkForSubFiles :: T.Text -> T.Text -> IO [T.Text]-checkForSubFiles extension dir =- catch (fmap Right (getDirContents dir)) (\e -> return $ Left (e :: IOException)) >>= \case- Right o -> return ((map (\x -> dir <> "/" <> x) . filter (T.isSuffixOf extension)) o )- Left _ -> return []---- Find files in the module directory that are in a module subdirectory and--- finish with a specific extension-getFiles :: T.Text -> T.Text -> T.Text -> IO [T.Text]-getFiles moduledir subdir extension = fmap concat $- getDirContents moduledir- >>= mapM ( checkForSubFiles extension . (\x -> moduledir <> "/" <> x <> "/" <> subdir))--getLuaFiles :: T.Text -> IO [T.Text]-getLuaFiles moduledir = getFiles moduledir "lib/puppet/parser/luafunctions" ".lua"--loadLuaFile :: Lua.LuaState -> T.Text -> IO [T.Text]-loadLuaFile l file =- Lua.loadfile l (T.unpack file) >>= \case- 0 -> Lua.call l 0 0 >> return [takeBaseName file]- _ -> do- T.hPutStrLn stderr ("Could not load file " <> file)- return []-{-| Runs a puppet function in the 'CatalogMonad' monad. It takes a state,-function name and list of arguments. It returns a valid Puppet value.--}-puppetFunc :: (MonadThrowPos m, MonadIO m, MonadError Doc m, Monad m) => Lua.LuaState -> T.Text -> [PValue] -> m PValue-puppetFunc l fn args =- liftIO ( catch (fmap Right (Lua.callfunc l (T.unpack fn) args)) (\e -> return $ Left $ show (e :: SomeException)) ) >>= \case- Right x -> return x- Left y -> throwPosError (string y)---- | Initializes the Lua state. The argument is the modules directory. Each--- subdirectory will be traversed for functions.--- The default location is @\/lib\/puppet\/parser\/functions@.-initLua :: T.Text -> IO (Lua.LuaState, [T.Text])-initLua moduledir = do- funcfiles <- getLuaFiles moduledir- l <- Lua.newstate- Lua.openlibs l- luafuncs <- concat <$> mapM (loadLuaFile l) funcfiles- return (l , luafuncs)--initLuaMaster :: T.Text -> IO (HM.HashMap T.Text ([PValue] -> InterpreterMonad PValue))-initLuaMaster moduledir = do- (luastate, luafunctions) <- initLua moduledir- c <- newMVar luastate- let callf fname args = singleton (CallLua c fname args)- {-- r <- liftIO $ withMVar c $ \stt ->- catch (fmap Right (Lua.callfunc stt (T.unpack fname) args)) (\e -> return $ Left $ show (e :: SomeException))- case r of- Right x -> return x- Left rr -> throwPosError (string rr)- -}- return $ HM.fromList [(fname, callf fname) | fname <- luafunctions]---- | Obviously releases the Lua state.-closeLua :: Lua.LuaState -> IO ()-closeLua = Lua.close
Puppet/Preferences.hs view
@@ -26,7 +26,6 @@ import Puppet.Interpreter.Types import Puppet.NativeTypes import Puppet.NativeTypes.Helpers-import Puppet.Plugins import Puppet.Stdlib import Puppet.Paths import qualified Puppet.Puppetlabs as Puppetlabs
Puppet/Utils.hs view
@@ -10,6 +10,7 @@ , loadYamlFile , scientific2text , text2Scientific+ , getFiles , ifromList, ikeys, isingleton, ifromListWith, iunionWith, iinsertWith -- * re-export , module Data.Monoid@@ -27,6 +28,7 @@ import System.Posix.Directory.ByteString import qualified Data.Either.Strict as S import Data.Scientific+import Control.Exception import Control.Lens import Data.Aeson.Lens import qualified Data.Yaml as Y@@ -138,3 +140,17 @@ iunionWith :: (Hashable k, Eq k) => (v -> v -> v) -> HM.HashMap k v -> HM.HashMap k v -> HM.HashMap k v {-# INLINABLE iunionWith #-} iunionWith = HM.unionWith++getFiles :: T.Text -> T.Text -> T.Text -> IO [T.Text]+getFiles moduledir subdir extension = fmap concat $+ getDirContents moduledir+ >>= mapM ( checkForSubFiles extension . (\x -> moduledir <> "/" <> x <> "/" <> subdir))++checkForSubFiles :: T.Text -> T.Text -> IO [T.Text]+checkForSubFiles extension dir =+ catch (fmap Right (getDirContents dir)) (\e -> return $ Left (e :: IOException)) >>= \case+ Right o -> return ((map (\x -> dir <> "/" <> x) . filter (T.isSuffixOf extension)) o )+ Left _ -> return []++getDirContents :: T.Text -> IO [T.Text]+getDirContents x = fmap (filter (not . T.all (=='.'))) (getDirectoryContents x)
PuppetDB/Remote.hs view
@@ -1,22 +1,20 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module PuppetDB.Remote (pdbConnect) where -import Puppet.PP+import Control.Lens+import Control.Monad.Except+import Data.Proxy+import Data.Text (Text)+import Network.HTTP.Client (Manager)+import Servant.API+import Servant.Client -import Puppet.Interpreter.Types-import Network.HTTP.Client (Manager)-import Data.Text (Text)-import Control.Monad.Except-import Control.Monad.Trans.Except-import Control.Lens-import Servant.API-import Servant.Client-import Data.Aeson-import Data.Proxy+import Puppet.Interpreter.Types+import Puppet.PP type PDBAPIv3 = "nodes" :> QueryParam "query" (Query NodeField) :> Get '[JSON] [NodeInfo] :<|> "nodes" :> Capture "resourcename" Text :> "resources" :> QueryParam "query" (Query ResourceField) :> Get '[JSON] [Resource]@@ -50,5 +48,5 @@ prettyError :: ExceptT ServantError IO b -> ExceptT PrettyError IO b prettyError = mapExceptT (fmap (_Left %~ PrettyError . string. show))- q1 :: FromJSON b => (Maybe a -> Manager -> BaseUrl -> ClientM b) -> a -> ExceptT PrettyError IO b+ q1 :: (Maybe a -> Manager -> BaseUrl -> ClientM b) -> a -> ExceptT PrettyError IO b q1 f a = prettyError (f (Just a) mgr url)
README.adoc view
@@ -1,7 +1,8 @@ = Language-puppet -image:https://travis-ci.org/bartavelle/language-puppet.svg?branch=master["Build Status", link="https://travis-ci.org/bartavelle/language-puppet"] image:https://img.shields.io/hackage/v/language-puppet.svg[link="http://hackage.haskell.org/package/language-puppet"]+image:https://www.stackage.org/package/language-puppet/badge/nightly[link="https://www.stackage.org/nightly/package/language-puppet"]+image:https://travis-ci.org/bartavelle/language-puppet.svg?branch=master["Build Status", link="https://travis-ci.org/bartavelle/language-puppet"] A library to work with Puppet manifests, test them and eventually replace everything ruby. @@ -18,7 +19,7 @@ stack install ``` -There are also http://lpuppet.banquise.net/download/[binary packages available] and https://registry.hub.docker.com/u/pierrer/puppetresources[a docker images].+https://hub.docker.com/r/pierrer/language-puppet/[A docker image] is available. == Puppetresources @@ -162,4 +163,3 @@ * the deprecated `import` function is not supported (see https://github.com/bartavelle/language-puppet/issues/82[issue #82]) custom ruby functions::-Currently the only way to support your custom ruby functions is to rewrite them in Lua.
language-puppet.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-puppet-version: 1.2+version: 1.3 synopsis: Tools to parse and evaluate the Puppet DSL. description: This is a set of tools that is supposed to fill all your Puppet needs : syntax checks, catalog compilation, PuppetDB queries, simulationg of complex interactions between nodes, Puppet master replacement, and more ! homepage: http://lpuppet.banquise.net/@@ -79,7 +79,6 @@ , Puppet.NativeTypes.ZoneRecord , Puppet.Parser.Utils , Puppet.Paths- , Puppet.Plugins extensions: OverloadedStrings, BangPatterns ghc-options: -Wall -funbox-strict-fields -j1 -- ghc-prof-options: -auto-all -caf-all@@ -99,10 +98,9 @@ , formatting , hashable == 1.2.* , http-api-data == 0.2.*- , http-client == 0.4.*+ , http-client >= 0.5 && < 0.6 , hruby >= 0.3.2 && < 0.4 , hslogger == 1.2.*- , hslua >= 0.4.1 && < 0.5 , hspec , lens >= 4.12 && < 5 , lens-aeson >= 1.0@@ -117,8 +115,8 @@ , regex-pcre-builtin >= 0.94.4 , scientific >= 0.2 && < 0.4 , semigroups- , servant == 0.7.*- , servant-client == 0.7.*+ , servant == 0.8.*+ , servant-client == 0.8.* , split == 0.2.* , stm == 2.4.* , strict-base-types >= 0.3