    -- | 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 (Read, Show, Eq)

    type Marker = String
    type Marked = String

    statusMarker :: Marker
    statusMarker = "STATUS"

    privDataMarker :: String
    privDataMarker = "PRIVDATA "

    repoUrlMarker :: String
    repoUrlMarker = "REPOURL "

    gitPushMarker :: String
    gitPushMarker = "GITPUSH"

    toMarked :: Marker -> String -> String
    toMarked = (++)

    fromMarked :: Marker -> Marked -> Maybe String
    fromMarked marker s
    	| marker `isPrefixOf` s = Just $ drop (length marker) s
    	| otherwise = Nothing

    sendMarked :: Handle -> Marker -> String -> IO ()
    sendMarked h marker s = do
    	debug ["sent marked", marker]
    	sendMarked' h marker s

    sendMarked' :: Handle -> Marker -> String -> IO ()
    sendMarked' h marker 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.
    	hPutStrLn h ("\n" ++ toMarked marker s)
    	hFlush h

    getMarked :: Handle -> Marker -> IO (Maybe String)
    getMarked h marker = go =<< catchMaybeIO (hGetLine h)
      where
    	go Nothing = return Nothing
    	go (Just l) = case fromMarked marker l of
    		Nothing -> do
    			unless (null l) $
    				hPutStrLn stderr l
    			getMarked h marker
    		Just v -> do
    			debug ["received marked", marker]
    			return (Just v)

    req :: Stage -> Marker -> (String -> IO ()) -> IO ()
    req stage marker a = do
    	debug ["requested marked", marker]
    	sendMarked' stdout statusMarker (show stage)
    	maybe noop a =<< getMarked stdin marker