module Propellor.Protocol where
import Data.List
import Propellor.Base
data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush | NeedPrecompiled
deriving (ReadPrec [Stage]
ReadPrec Stage
Int -> ReadS Stage
ReadS [Stage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Stage]
$creadListPrec :: ReadPrec [Stage]
readPrec :: ReadPrec Stage
$creadPrec :: ReadPrec Stage
readList :: ReadS [Stage]
$creadList :: ReadS [Stage]
readsPrec :: Int -> ReadS Stage
$creadsPrec :: Int -> ReadS Stage
Read, Int -> Stage -> ShowS
[Stage] -> ShowS
Stage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stage] -> ShowS
$cshowList :: [Stage] -> ShowS
show :: Stage -> String
$cshow :: Stage -> String
showsPrec :: Int -> Stage -> ShowS
$cshowsPrec :: Int -> Stage -> ShowS
Show, Stage -> Stage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stage -> Stage -> Bool
$c/= :: Stage -> Stage -> Bool
== :: Stage -> Stage -> Bool
$c== :: Stage -> Stage -> Bool
Eq)
type Marker = String
type Marked = String
statusMarker :: Marker
statusMarker :: String
statusMarker = String
"STATUS"
privDataMarker :: String
privDataMarker :: String
privDataMarker = String
"PRIVDATA "
repoUrlMarker :: String
repoUrlMarker :: String
repoUrlMarker = String
"REPOURL "
gitPushMarker :: String
gitPushMarker :: String
gitPushMarker = String
"GITPUSH"
toMarked :: Marker -> String -> String
toMarked :: String -> ShowS
toMarked = forall a. [a] -> [a] -> [a]
(++)
fromMarked :: Marker -> Marked -> Maybe String
fromMarked :: String -> String -> Maybe String
fromMarked String
marker String
s
| String
marker forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
marker) String
s
| Bool
otherwise = forall a. Maybe a
Nothing
sendMarked :: Handle -> Marker -> String -> IO ()
sendMarked :: Handle -> String -> String -> IO ()
sendMarked Handle
h String
marker String
s = do
[String] -> IO ()
debug [String
"sent marked", String
marker]
Handle -> String -> String -> IO ()
sendMarked' Handle
h String
marker String
s
sendMarked' :: Handle -> Marker -> String -> IO ()
sendMarked' :: Handle -> String -> String -> IO ()
sendMarked' Handle
h String
marker String
s = do
Handle -> String -> IO ()
hPutStrLn Handle
h (String
"\n" forall a. [a] -> [a] -> [a]
++ String -> ShowS
toMarked String
marker String
s)
Handle -> IO ()
hFlush Handle
h
getMarked :: Handle -> Marker -> IO (Maybe String)
getMarked :: Handle -> String -> IO (Maybe String)
getMarked Handle
h String
marker = Maybe String -> IO (Maybe String)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (Handle -> IO String
hGetLine Handle
h)
where
go :: Maybe String -> IO (Maybe String)
go Maybe String
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
go (Just String
l) = case String -> String -> Maybe String
fromMarked String
marker String
l of
Maybe String
Nothing -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l) forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
l
Handle -> String -> IO (Maybe String)
getMarked Handle
h String
marker
Just String
v -> do
[String] -> IO ()
debug [String
"received marked", String
marker]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
v)
req :: Stage -> Marker -> (String -> IO ()) -> IO ()
req :: Stage -> String -> (String -> IO ()) -> IO ()
req Stage
stage String
marker String -> IO ()
a = do
[String] -> IO ()
debug [String
"requested marked", String
marker]
Handle -> String -> String -> IO ()
sendMarked' Handle
stdout String
statusMarker (forall a. Show a => a -> String
show Stage
stage)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *). Monad m => m ()
noop String -> IO ()
a forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> String -> IO (Maybe String)
getMarked Handle
stdin String
marker