-- | This is a simple line-based protocol used for communication between
-- a local and remote propellor. It's sent over a ssh channel, and lines of
-- the protocol can be interspersed with other, non-protocol lines
-- that should be passed through to be displayed.
--
-- Avoid making backwards-incompatible changes to this protocol,
-- since propellor needs to use this protocol to update itself to new
-- versions speaking newer versions of the protocol.

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
	-- Prefix string with newline because sometimes a
	-- incomplete line has been output, and the marker needs to
	-- come at the start of a line.
	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