----------------------------------------------------------------------------- -- -- Module : Transient.Move.Services.MonitorService -- Copyright : -- License : MIT -- -- Maintainer : agocorona@gmail.com -- Stability : -- Portability : -- -- | -- ----------------------------------------------------------------------------- {-# LANGUAGE ScopedTypeVariables #-} module Main where import Transient.Internals import Transient.Move.Internals import Transient.Move.Utils import Transient.Move.Services import Control.Applicative import Control.Monad.IO.Class import Control.Exception(SomeException(..)) import Control.Concurrent import Control.Monad import Data.List import System.Process import System.Directory import Data.Monoid main = keep . runCloud $ do runService monitorService 3000 $ \(ident,service,num) -> do return () !> ("RUNSERVICE",ident, service, num) nodes <- local $ findInNodes service >>= return . take num -- onAll $ liftIO $ print ("NODES",nodes) let n= num - length nodes if n==0 then return nodes else return nodes <> requestInstall ident service n where requestInstall :: String -> Service -> Int -> Cloud [ Node] requestInstall ident service num= do ns <- local getEqualNodes -- return () !> ("equal",ns) auth <- callNodes' ns (<>) mempty $ localIO $ authorizeService ident service >>= \x -> return [x] -- return () !> auth let nodes = map fst $ filter snd $ zip ns auth nnodes= length nodes pernode= num `div` nnodes lacking= num `rem` nnodes (nodes1,nodes2)= splitAt lacking nodes -- return () !> (pernode,lacking,nodes1,nodes2) rs <- callNodes' nodes1 (<>) mempty (installHere ident service (pernode+1)) <> callNodes' nodes2 (<>) mempty (installHere ident service pernode) local $ addNodes rs return rs -- !> ("MONITOR RETURN---------------------------------->", rs) -- installIt = installHere ident service <|> installThere ident service installHere :: String -> Service -> Int -> Cloud [ Node] installHere ident service n= local $ replicateM n installOne where installOne= do port <- liftIO freePort install service port return () !> "INSTALLED" thisNode <- getMyNode let node= Node (nodeHost thisNode) port Nothing service -- node to be published nodelocal= Node "localhost" port Nothing [("externalNode", show $ node{nodeServices=[]})] -- local node addNodes [node{nodeServices=("localNode", show nodelocal{nodeServices=[]}):nodeServices node},nodelocal ] return node {nodeServices= nodeServices node ++ [("relay",show thisNode{nodeServices=[]})]} `catcht` \(e :: SomeException) -> liftIO (putStr "INSTALLLLLLLLLLLLLLL2222222: " >> print e) >> empty -- nodeService node@(Node h _ _ _) port service= Node h port Nothing $ service -- ++ [("relay",show $node{nodeServices=[]}) install :: Service -> Int -> TransIO () install service port= do -- return () !> "IIIIIIIIIIIIIIINSTALL" install' `catcht` \(e :: SomeException) -> liftIO (putStr "INSTALL error: " >> print e) >> empty where install'= do let host= "localhost" program <- return (lookup "executable" service) `onNothing` empty -- return () !> ("program",program) tryExec program host port <|> tryDocker service host port program <|> do tryInstall service ; tryExec program host port emptyIfNothing :: Maybe a -> TransIO a emptyIfNothing = Transient . return tryInstall :: Service -> TransIO () tryInstall service = do package <- emptyIfNothing (lookup "package" service) install package where install package | "git:" `isPrefixOf` package= installGit package | "https://github.com" `isPrefixOf` package = installGit package | "http://github.com" `isPrefixOf` package = installGit package tryDocker service host port program= do image <- emptyIfNothing $ lookup "image" service path <- Transient $ liftIO $ findExecutable "docker" -- return empty if not found liftIO $ callProcess path ["run", image,"-p"," start/"++host++"/"++ show port++ " " ++ program] tryExec program host port= do path <- Transient $ liftIO $ findExecutable program -- !> ("findExecutable", program) spawnProgram program host port -- !>"spawn" where spawnProgram program host port= liftIO $ do let prog = pathExe program host port putStr "executing: " >> putStrLn prog let createprostruct= shell prog createProcess $ createprostruct ; return () threadDelay 2000000 -- return() !> ("INSTALLED", program) where pathExe program host port= program ++ " -p start/" ++ show (host ::String) ++"/" ++ show (port ::Int) ++ " > "++ program ++ host ++ show port ++ ".log" installGit package = liftIO $ do let packagename = name package when (null packagename) $ error $ "source for \""++package ++ "\" not found" callProcess "git" ["clone",package] liftIO $ putStr package >> putStrLn " cloned" setCurrentDirectory packagename callProcess "cabal" ["install","--force-reinstalls"] setCurrentDirectory ".." where name url= slash . slash . slash $ slash url where slash= tail1 . dropWhile (/='/') tail1 []=[] tail1 x= tail x