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]
(Int -> ReadS Stage)
-> ReadS [Stage]
-> ReadPrec Stage
-> ReadPrec [Stage]
-> Read Stage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Stage
readsPrec :: Int -> ReadS Stage
$creadList :: ReadS [Stage]
readList :: ReadS [Stage]
$creadPrec :: ReadPrec Stage
readPrec :: ReadPrec Stage
$creadListPrec :: ReadPrec [Stage]
readListPrec :: ReadPrec [Stage]
Read, Int -> Stage -> ShowS
[Stage] -> ShowS
Stage -> String
(Int -> Stage -> ShowS)
-> (Stage -> String) -> ([Stage] -> ShowS) -> Show Stage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stage -> ShowS
showsPrec :: Int -> Stage -> ShowS
$cshow :: Stage -> String
show :: Stage -> String
$cshowList :: [Stage] -> ShowS
showList :: [Stage] -> ShowS
Show, Stage -> Stage -> Bool
(Stage -> Stage -> Bool) -> (Stage -> Stage -> Bool) -> Eq Stage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stage -> Stage -> Bool
== :: Stage -> Stage -> Bool
$c/= :: Stage -> Stage -> Bool
/= :: 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 = String -> ShowS
forall a. [a] -> [a] -> [a]
(++)
fromMarked :: Marker -> Marked -> Maybe String
fromMarked :: String -> String -> Maybe String
fromMarked String
marker String
s
| String
marker String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
marker) String
s
| Bool
otherwise = Maybe String
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" String -> ShowS
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 (Maybe String -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String -> IO (Maybe String)
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 = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
go (Just String
l) = case String -> String -> Maybe String
fromMarked String
marker String
l of
Maybe String
Nothing -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l) (IO () -> IO ()) -> IO () -> IO ()
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]
Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
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 (Stage -> String
forall a. Show a => a -> String
show Stage
stage)
IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ()
forall (m :: * -> *). Monad m => m ()
noop String -> IO ()
a (Maybe String -> IO ()) -> IO (Maybe String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> String -> IO (Maybe String)
getMarked Handle
stdin String
marker