-- | This module contains the evaluation logic
module Haxible.Eval
  ( AnsibleHaxl,
    runHaxible,
    runTask,
    json,
    envLoop,
    extractFact,
    traverseLoop,
    traverseInclude,
    cleanVar,
    tryRescue,
    Value,
    Vars,
  )
where

import Data.Aeson hiding (json)
import Data.Aeson.Key qualified
import Data.Aeson.KeyMap qualified
import Data.Default (def)
import Data.Functor.Identity (runIdentity)
import Data.Vector qualified
import Haxible.Connection
import Haxible.DataSource
import Haxible.Prelude
import Haxible.Report
import Haxl.Core hiding (env)
import Text.Ginger

type BlockFun = Vars -> Vars -> AnsibleHaxl [Value]

-- $setup
-- >>> let dump = putStrLn . unsafeFrom . encode

-- | Call the rescue block if the main block fails.
tryRescue :: BlockFun -> BlockFun -> BlockFun
tryRescue :: BlockFun -> BlockFun -> BlockFun
tryRescue BlockFun
main BlockFun
rescue Vars
a Vars
b = do
  Either HaxlException [Value]
res <- AnsibleHaxl [Value] -> GenHaxl () () (Either HaxlException [Value])
forall u w a. GenHaxl u w a -> GenHaxl u w (Either HaxlException a)
tryToHaxlException (BlockFun
main Vars
a Vars
b)
  case Either HaxlException [Value]
res of
    Left HaxlException
_ -> BlockFun
rescue Vars
a Vars
b
    Right [Value]
x -> [Value] -> AnsibleHaxl [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
x

-- | Evaluate template for the loop attribute when it is a string (instead of a list):
--
-- >>> envLoop "{{ hosts }}" [("hosts", [json|["frontend", "backend"]|])]
-- [String "frontend",String "backend"]
envLoop :: Text -> [(Text, Value)] -> [Value]
envLoop :: Text -> Vars -> [Value]
envLoop Text
n Vars
env = GingerContext SourcePos (Writer [Value]) [Value]
-> Template SourcePos -> [Value]
forall p h.
(ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p,
 Monoid h) =>
GingerContext p (Writer h) h -> Template p -> h
runGinger GingerContext SourcePos (Writer [Value]) [Value]
context Template SourcePos
template
  where
    lookupVar :: Text -> GVal (Run SourcePos (Writer [Value]) [Value])
lookupVar Text
var = GVal (Run SourcePos (Writer [Value]) [Value])
-> (Value -> GVal (Run SourcePos (Writer [Value]) [Value]))
-> Maybe Value
-> GVal (Run SourcePos (Writer [Value]) [Value])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GVal (Run SourcePos (Writer [Value]) [Value])
forall a. Default a => a
def Value -> GVal (Run SourcePos (Writer [Value]) [Value])
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (Text -> Vars -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
var Vars
env)
    gvarToList :: a -> t b
gvarToList a
g = case a
g.asList of
      Just t (GVal m)
xs -> case (GVal m -> Either String b) -> t (GVal m) -> Either String (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GVal m -> Either String b
forall (m :: * -> *) a. FromGVal m a => GVal m -> Either String a
fromGValEither t (GVal m)
xs of
        Right t b
x -> t b
x
        Left String
err -> String -> t b
forall a. HasCallStack => String -> a
error (String -> t b) -> String -> t b
forall a b. (a -> b) -> a -> b
$ String
"Couldn't resolve loop list: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
      Maybe (t (GVal m))
Nothing -> String -> t b
forall a. HasCallStack => String -> a
error (String -> t b) -> String -> t b
forall a b. (a -> b) -> a -> b
$ String
"Invalid loop variable: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
g

    context :: GingerContext SourcePos (Writer [Value]) [Value]
context = (Text -> GVal (Run SourcePos (Writer [Value]) [Value]))
-> (GVal (Run SourcePos (Writer [Value]) [Value]) -> [Value])
-> Maybe (Newlines [Value])
-> GingerContext SourcePos (Writer [Value]) [Value]
forall h p.
Monoid h =>
(Text -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' Text -> GVal (Run SourcePos (Writer [Value]) [Value])
lookupVar GVal (Run SourcePos (Writer [Value]) [Value]) -> [Value]
forall {a} {t :: * -> *} {m :: * -> *} {b}.
(HasField "asList" a (Maybe (t (GVal m))), Traversable t,
 FromGVal m b, Show a) =>
a -> t b
gvarToList Maybe (Newlines [Value])
forall a. Maybe a
Nothing
    template :: Template SourcePos
    template :: Template SourcePos
template = case Identity (Either ParserError (Template SourcePos))
-> Either ParserError (Template SourcePos)
forall a. Identity a -> a
runIdentity (IncludeResolver Identity
-> Maybe String
-> String
-> Identity (Either ParserError (Template SourcePos))
forall (m :: * -> *).
Monad m =>
IncludeResolver m
-> Maybe String
-> String
-> m (Either ParserError (Template SourcePos))
parseGinger (Identity (Maybe String) -> IncludeResolver Identity
forall a b. a -> b -> a
const Identity (Maybe String)
forall a. HasCallStack => a
undefined) Maybe String
forall a. Maybe a
Nothing (Text -> String
forall source target. From source target => source -> target
from Text
n)) of
      Right Template SourcePos
tmpl -> Template SourcePos
tmpl
      Left ParserError
e -> String -> Template SourcePos
forall a. HasCallStack => String -> a
error (String -> Template SourcePos) -> String -> Template SourcePos
forall a b. (a -> b) -> a -> b
$ String
"Template fail: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParserError -> String
forall a. Show a => a -> String
show ParserError
e

-- | Build the loop results:
--
-- >>> dump =<< traverseLoop (pure . String) ["a", "b"]
-- {"changed":false,"msg":"All items completed","results":["a","b"],"skipped":false}
traverseLoop :: Applicative f => (a -> f Value) -> [a] -> f Value
traverseLoop :: forall (f :: * -> *) a.
Applicative f =>
(a -> f Value) -> [a] -> f Value
traverseLoop a -> f Value
f [a]
xs = [Value] -> Value
loopResult ([Value] -> Value) -> f [Value] -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f Value) -> [a] -> f [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f Value
f [a]
xs

-- | Concat nested results
--
-- >>> dump =<< traverseInclude (\x -> pure [String x, Number 42]) ["a", "b"]
-- ["a",42,"b",42]
traverseInclude :: Applicative f => (a -> f [Value]) -> [a] -> f [Value]
traverseInclude :: forall (f :: * -> *) a.
Applicative f =>
(a -> f [Value]) -> [a] -> f [Value]
traverseInclude a -> f [Value]
f [a]
xs = [[Value]] -> [Value]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Value]] -> [Value]) -> f [[Value]] -> f [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f [Value]) -> [a] -> f [[Value]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f [Value]
f [a]
xs

-- | Extract the ansible_facts results
--
-- >>> dump $ extractFact [json|{"ansible_facts": {"key": "value"}}|]
-- "value"
--
-- Each fact are evaluated individually, so multiple result is un-expected:
--
-- >>> extractFacts [json|{"ansible_facts": {"x": 1, "y": 2}}|]
-- Left "Multiple facts found: [(\"x\",Number 1.0),(\"y\",Number 2.0)]"
extractFacts :: Value -> Either String Value
extractFacts :: Value -> Either String Value
extractFacts Value
v = case Getting (First Value) Value Value -> Value -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"ansible_facts") Value
v of
  Just (Object Object
obj) -> case Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
Data.Aeson.KeyMap.toList Object
obj of
    [(Key
_, Value
value)] -> Value -> Either String Value
forall a b. b -> Either a b
Right Value
value
    [(Key, Value)]
xs -> String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Multiple facts found: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(Key, Value)] -> String
forall a. Show a => a -> String
show [(Key, Value)]
xs
  Maybe Value
_ -> String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Can't find ansible_facts in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
v

extractFact :: Value -> Value
extractFact :: Value -> Value
extractFact Value
v = case Value -> Either String Value
extractFacts Value
v of
  Left String
e -> String -> Value
forall a. HasCallStack => String -> a
error String
e
  Right Value
x -> Value
x

-- | Process loop results
--
-- >>> dump $ loopResult [[json|42|], [json|43|]]
-- {"changed":false,"msg":"All items completed","results":[42,43],"skipped":false}
loopResult :: [Value] -> Value
loopResult :: [Value] -> Value
loopResult [Value]
xs = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
Data.Aeson.KeyMap.fromList [(Key, Value)]
attrs
  where
    play :: [(Key, Value)]
play = case [Value]
xs of
      (Value
x : [Value]
_) -> Text -> Value -> [(Key, Value)]
forall {s}. AsValue s => Text -> s -> [(Key, Value)]
copyKey Text
"__haxible_play" Value
x [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> [(Key, Value)]
forall {s}. AsValue s => Text -> s -> [(Key, Value)]
copyKey Text
"__haxible_module" Value
x
      [Value]
_ -> []
    copyKey :: Text -> s -> [(Key, Value)]
copyKey Text
k s
x = [(Key, Value)]
-> (Value -> [(Key, Value)]) -> Maybe Value -> [(Key, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
p -> [(Text -> Key
Data.Aeson.Key.fromText Text
k, Value
p)]) (Getting (First Value) s Value -> s -> Maybe Value
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' s Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
k) s
x)
    attrs :: [(Key, Value)]
attrs =
      [ (Key
"results", Array -> Value
Array ([Value] -> Array
forall a. [a] -> Vector a
Data.Vector.fromList [Value]
xs)),
        (Key
"msg", Value
"All items completed"),
        (Key
"skipped", Bool -> Value
Bool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> (Value -> Maybe Bool) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) Value Bool -> Value -> Maybe Bool
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"skipped" ((Value -> Const (First Bool) Value)
 -> Value -> Const (First Bool) Value)
-> Getting (First Bool) Value Bool
-> Getting (First Bool) Value Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) Value Bool
forall t. AsPrimitive t => Prism' t Bool
_Bool)) [Value]
xs),
        (Key
"changed", Bool -> Value
Bool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> (Value -> Maybe Bool) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) Value Bool -> Value -> Maybe Bool
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"changed" ((Value -> Const (First Bool) Value)
 -> Value -> Const (First Bool) Value)
-> Getting (First Bool) Value Bool
-> Getting (First Bool) Value Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) Value Bool
forall t. AsPrimitive t => Prism' t Bool
_Bool)) [Value]
xs)
      ]
        [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Key, Value)]
play

runTask :: Vars -> Text -> Value -> Vars -> Vars -> AnsibleHaxl Value
runTask :: Vars -> Text -> Value -> Vars -> Vars -> AnsibleHaxl Value
runTask Vars
playAttrs Text
module_ Value
moduleObject Vars
taskAttrs Vars
baseTaskVars =
  Value -> Value
addModule (Value -> Value) -> AnsibleHaxl Value -> AnsibleHaxl Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaskReq Value -> AnsibleHaxl Value
forall u (r :: * -> *) a w.
(DataSource u r, Request r a) =>
r a -> GenHaxl u w a
dataFetch (TaskCall -> TaskReq Value
RunTask (TaskCall {Vars
$sel:playAttrs:TaskCall :: Vars
playAttrs :: Vars
playAttrs, Value
$sel:moduleObject:TaskCall :: Value
moduleObject :: Value
moduleObject, Vars
$sel:taskAttrs:TaskCall :: Vars
taskAttrs :: Vars
taskAttrs, Vars
$sel:taskVars:TaskCall :: Vars
taskVars :: Vars
taskVars, Text
$sel:module_:TaskCall :: Text
module_ :: Text
module_}))
  where
    addModule :: Value -> Value
addModule = \case
      Object Object
obj -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Data.Aeson.KeyMap.insert Key
"__haxible_module" (Text -> Value
String Text
module_) Object
obj
      Value
x -> Value
x
    taskVars :: Vars
taskVars = ((Text, Value) -> Vars) -> Vars -> Vars
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Value) -> Vars
checkManyHost Vars
baseTaskVars
    -- When a task run on many host, we register a single variable with all the results,
    -- thus when accessing the variable, we need to lookup the current host result.
    checkManyHost :: (Text, Value) -> Vars
checkManyHost (Text
k, Value
v)
      | Getting (First Bool) Value Bool -> Value -> Maybe Bool
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"__haxible_multi_hosts" ((Value -> Const (First Bool) Value)
 -> Value -> Const (First Bool) Value)
-> Getting (First Bool) Value Bool
-> Getting (First Bool) Value Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) Value Bool
forall t. AsPrimitive t => Prism' t Bool
_Bool) Value
v Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True =
          let many_k :: Text
many_k = Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"__haxible"
           in [ (Text
k, Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"{{ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
many_k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[ansible_host] }}"),
                (Text
many_k, Value -> Value
cleanVar Value
v)
              ]
      | Bool
otherwise = [(Text
k, Value -> Value
cleanVar Value
v)]

runHaxible :: FilePath -> FilePath -> AnsibleHaxl [Value] -> IO ()
runHaxible :: String -> String -> AnsibleHaxl [Value] -> IO ()
runHaxible String
inventory String
playPath AnsibleHaxl [Value]
action = Int -> String -> (Connections -> IO ()) -> IO ()
withConnections Int
5 String
inventory ((Connections -> IO ()) -> IO ())
-> (Connections -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connections
connections -> do
  State TaskReq
ansibleState <- Connections -> IO (State TaskReq)
initHaxibleState Connections
connections
  Env () ()
ansibleEnv <- StateStore -> () -> IO (Env () ())
forall u w. StateStore -> u -> IO (Env u w)
initEnv (State TaskReq -> StateStore -> StateStore
forall (f :: * -> *).
StateKey f =>
State f -> StateStore -> StateStore
stateSet State TaskReq
ansibleState StateStore
stateEmpty) ()
  [Value]
xs <- Env () () -> AnsibleHaxl [Value] -> IO [Value]
forall u w a. Env u w -> GenHaxl u w a -> IO a
runHaxl Env () ()
ansibleEnv AnsibleHaxl [Value]
action
  (Value -> IO ()) -> [Value] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> IO ()
putStrLn (String -> IO ()) -> (Value -> String) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom (ByteString -> String) -> (Value -> ByteString) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode) [Value]
xs
  case [Value] -> Maybe (NonEmpty Value)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Value]
xs of
    Just NonEmpty Value
res -> do
      String -> String -> IO ()
writeFile (String
playName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".plantuml") (Text -> String
forall source target. From source target => source -> target
from (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ NonEmpty Value -> Text
Haxible.Report.reportTiming NonEmpty Value
res)
    Maybe (NonEmpty Value)
Nothing -> String -> IO ()
putStrLn String
"\nEmpty results :("
  where
    (String
playName, String
_) = String -> (String, String)
splitExtension String
playPath