    -- | 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]
    (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
    	-- 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 ("\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