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
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
(Int -> Stage -> ShowS)
-> (Stage -> String) -> ([Stage] -> ShowS) -> Show Stage
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
(Stage -> Stage -> Bool) -> (Stage -> Stage -> Bool) -> Eq Stage
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 = "STATUS"
privDataMarker :: String
privDataMarker :: String
privDataMarker = "PRIVDATA "
repoUrlMarker :: String
repoUrlMarker :: String
repoUrlMarker = "REPOURL "
gitPushMarker :: String
gitPushMarker :: String
gitPushMarker = "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 marker :: String
marker s :: 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 (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 h :: Handle
h marker :: String
marker s :: String
s = do
[String] -> IO ()
debug ["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' h :: Handle
h marker :: String
marker s :: String
s = do
Handle -> String -> IO ()
hPutStrLn Handle
h ("\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 h :: Handle
h marker :: 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 Nothing = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
go (Just l :: String
l) = case String -> String -> Maybe String
fromMarked String
marker String
l of
Nothing -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> 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 v :: String
v -> do
[String] -> IO ()
debug ["received marked", String
marker]
Maybe String -> IO (Maybe String)
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
stage marker :: String
marker a :: String -> IO ()
a = do
[String] -> IO ()
debug ["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