-- | 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