-- Copyright (C) 2002-2004,2007 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.
module Darcs.Patch.Bundle
    ( Bundle(..)
    , makeBundle
    , parseBundle
    , interpretBundle
    , readContextFile
    , minContext
    ) where

import Darcs.Prelude

import Control.Applicative ( many, (<|>) )
import Control.Monad ( (<=<) )

import qualified Data.ByteString as B
    ( ByteString
    , breakSubstring
    , concat
    , drop
    , isPrefixOf
    , null
    , splitAt
    )
import qualified Data.ByteString.Char8 as BC
    ( break
    , dropWhile
    , pack
    )

import Darcs.Patch
    ( RepoPatch
    , ApplyState
    , showPatch
    , showContextPatch
    )
import Darcs.Patch.Bracketed ( Bracketed, unBracketedFL )
import Darcs.Patch.Commute ( Commute, commuteFL )
import Darcs.Patch.Depends ( contextPatches, splitOnTag )
import Darcs.Patch.Format ( PatchListFormat )
import Darcs.Patch.Info
    ( PatchInfo
    , displayPatchInfo
    , piTag
    , readPatchInfo
    , showPatchInfo
    )
import Darcs.Patch.Named ( Named, fmapFL_Named )
import Darcs.Patch.PatchInfoAnd
    ( PatchInfoAnd
    , info
    , n2pia
    , patchInfoAndPatch
    , unavailable
    )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanRL )
import Darcs.Patch.Read ( readPatch' )
import Darcs.Patch.Set
    ( PatchSet(..)
    , SealedPatchSet
    , Origin
    , appendPSFL
    )
import Darcs.Patch.Show ( ShowPatchBasic, ShowPatchFor(ForStorage) )
import Darcs.Patch.Witnesses.Ordered
    ( (:>)(..)
    , FL(..)
    , RL(..)
    , mapFL
    , mapFL_FL
    , mapRL
    , reverseFL
    )
import Darcs.Patch.Witnesses.Sealed ( Sealed(Sealed), seal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePEnd, unsafeCoercePStart )

import Darcs.Util.ByteString
    ( dropSpace
    , mmapFilePS
    , betweenLinesPS
    )
import Darcs.Util.Hash ( sha1PS, sha1Show )
import Darcs.Util.Parser
    ( Parser
    , lexString
    , lexWord
    , optional
    , parse
    )
import Darcs.Util.Printer
    ( Doc
    , ($$)
    , newline
    , packedString
    , renderPS
    , renderString
    , text
    , vcat
    , vsep
    )
import Darcs.Util.Tree( Tree )
import Darcs.Util.Tree.Monad( virtualTreeIO )


-- | A 'Bundle' is a context together with some patches. The context
-- consists of unavailable patches.
data Bundle rt p wX wY where
  Bundle :: (FL (PatchInfoAnd rt p) :> FL (PatchInfoAnd rt p)) wX wY
         -> Bundle rt p wX wY

-- | Interpret a 'Bundle' in the context of a 'PatchSet'. This means we
-- match up a possible tag in the context of the 'Bundle'. This fails if
-- the tag couldn't be found.
interpretBundle :: Commute p
                => PatchSet rt p Origin wT
                -> Bundle rt p wA wB
                -> Either String (PatchSet rt p Origin wB)
interpretBundle :: forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> Bundle rt p wA wB -> Either String (PatchSet rt p Origin wB)
interpretBundle PatchSet rt p Origin wT
ref (Bundle (FL (PatchInfoAnd rt p) wA wZ
context :> FL (PatchInfoAnd rt p) wZ wB
patches)) =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
PatchSet rt p wStart wX
-> FL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
appendPSFL FL (PatchInfoAnd rt p) wZ wB
patches forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> FL (PatchInfoAnd rt p) wA wB
-> Either String (PatchSet rt p Origin wB)
interpretContext PatchSet rt p Origin wT
ref FL (PatchInfoAnd rt p) wA wZ
context

-- | Create a b16 encoded SHA1 of a given a FL of named patches. This allows us
-- to ensure that the patches in a received bundle have not been modified in
-- transit.
hashBundle :: (PatchListFormat p, ShowPatchBasic p) => FL (Named p) wX wY
           -> B.ByteString
hashBundle :: forall (p :: * -> * -> *) wX wY.
(PatchListFormat p, ShowPatchBasic p) =>
FL (Named p) wX wY -> ByteString
hashBundle FL (Named p) wX wY
to_be_sent =
    SHA1 -> ByteString
sha1Show forall a b. (a -> b) -> a -> b
$ ByteString -> SHA1
sha1PS forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS forall a b. (a -> b) -> a -> b
$
        [Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL (Named p) wX wY
to_be_sent) forall a. Semigroup a => a -> a -> a
<> Doc
newline

makeBundle :: (ApplyState p ~ Tree, RepoPatch p) => Maybe (Tree IO)
           -> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wX wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Maybe (Tree IO)
-> PatchSet rt p wStart wX -> FL (Named p) wX wY -> IO Doc
makeBundle Maybe (Tree IO)
state PatchSet rt p wStart wX
repo FL (Named p) wX wY
to_be_sent
  | PatchSet rt p wStart wZ
_ :> RL (PatchInfoAnd rt p) wZ wX
context <- forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
PatchSet rt p wX wY
-> (:>) (PatchSet rt p) (RL (PatchInfoAnd rt p)) wX wY
contextPatches PatchSet rt p wStart wX
repo =
    forall {rt :: RepoType} {p :: * -> * -> *} {wX} {wY}.
RL (PatchInfoAndG rt p) wX wY -> Doc -> Doc
format RL (PatchInfoAnd rt p) wZ wX
context forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      case Maybe (Tree IO)
state of
        Just Tree IO
tree ->
          forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO (forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
ForStorage FL (Named p) wX wY
to_be_sent) Tree IO
tree
        Maybe (Tree IO)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage) FL (Named p) wX wY
to_be_sent)
  where
    format :: RL (PatchInfoAndG rt p) wX wY -> Doc -> Doc
format RL (PatchInfoAndG rt p) wX wY
context Doc
patches =
      String -> Doc
text String
""
      Doc -> Doc -> Doc
$$ String -> Doc
text String
"New patches:"
      Doc -> Doc -> Doc
$$ String -> Doc
text String
""
      Doc -> Doc -> Doc
$$ Doc
patches
      Doc -> Doc -> Doc
$$ String -> Doc
text String
""
      Doc -> Doc -> Doc
$$ String -> Doc
text String
"Context:"
      Doc -> Doc -> Doc
$$ String -> Doc
text String
""
      Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
ForStorage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info) RL (PatchInfoAndG rt p) wX wY
context)
      Doc -> Doc -> Doc
$$ String -> Doc
text String
"Patch bundle hash:"
      Doc -> Doc -> Doc
$$ ByteString -> Doc
packedString (forall (p :: * -> * -> *) wX wY.
(PatchListFormat p, ShowPatchBasic p) =>
FL (Named p) wX wY -> ByteString
hashBundle FL (Named p) wX wY
to_be_sent)
      Doc -> Doc -> Doc
$$ String -> Doc
text String
""

hashFailureMessage :: String
hashFailureMessage :: String
hashFailureMessage =
  String
"Patch bundle failed hash!\n\
  \This probably means that the patch has been corrupted by a mailer.\n\
  \The most likely culprit is CRLF newlines."

parseBundle :: RepoPatch p
            => B.ByteString -> Either String (Sealed (Bundle rt p wX))
parseBundle :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
ByteString -> Either String (Sealed (Bundle rt p wX))
parseBundle =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse forall (rt :: RepoType) (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Sealed (Bundle rt p wX))
pUnsignedBundle forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropInitialTrash forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decodeGpgClearsigned
  where
    dropInitialTrash :: ByteString -> ByteString
dropInitialTrash ByteString
s =
      case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break (forall a. Eq a => a -> a -> Bool
== Char
'\n') (ByteString -> ByteString
dropSpace ByteString
s) of
        (ByteString
line,ByteString
rest)
          | ByteString
contextName ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
line Bool -> Bool -> Bool
|| ByteString
patchesName ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
line -> ByteString
s
          | ByteString -> Bool
B.null ByteString
rest -> ByteString
rest
          | Bool
otherwise -> ByteString -> ByteString
dropInitialTrash ByteString
rest

pUnsignedBundle :: forall rt p wX. RepoPatch p => Parser (Sealed (Bundle rt p wX))
pUnsignedBundle :: forall (rt :: RepoType) (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Sealed (Bundle rt p wX))
pUnsignedBundle = forall {rt :: RepoType} {wX}.
Parser ByteString (Sealed (Bundle rt p wX))
pContextThenPatches forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {rt :: RepoType} {wX}.
Parser ByteString (Sealed (Bundle rt p wX))
pPatchesThenContext
  where
    packBundle :: [PatchInfo]
-> FL (Named (Bracketed p)) wZ wX -> Sealed (Bundle rt p wX)
packBundle [PatchInfo]
context FL (Named (Bracketed p)) wZ wX
patches =
      forall (a :: * -> *) wX. a wX -> Sealed a
Sealed forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(:>) (FL (PatchInfoAnd rt p)) (FL (PatchInfoAnd rt p)) wX wY
-> Bundle rt p wX wY
Bundle forall a b. (a -> b) -> a -> b
$ (forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> FL (PatchInfoAnd rt p) wX wY
unavailablePatchesFL (forall a. [a] -> [a]
reverse [PatchInfo]
context)) forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
        (forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wA wB (q :: * -> * -> *) wC wD.
(FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named forall (p :: * -> * -> *) wX wY. BracketedFL p wX wY -> FL p wX wY
unBracketedFL) FL (Named (Bracketed p)) wZ wX
patches)
    -- Is this a legacy format?
    pContextThenPatches :: Parser ByteString (Sealed (Bundle rt p wX))
pContextThenPatches = do
      [PatchInfo]
context <- Parser [PatchInfo]
pContext
      Sealed FL (Named (Bracketed p)) Any wX
patches <- forall (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Sealed (FL (Named (Bracketed p)) wX))
pPatches
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {p :: * -> * -> *} {wZ} {wX} {rt :: RepoType} {wX}.
[PatchInfo]
-> FL (Named (Bracketed p)) wZ wX -> Sealed (Bundle rt p wX)
packBundle [PatchInfo]
context FL (Named (Bracketed p)) Any wX
patches
    pPatchesThenContext :: Parser ByteString (Sealed (Bundle rt p wX))
pPatchesThenContext = do
      Sealed FL (Named (Bracketed p)) Any wX
patches <- forall (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Sealed (FL (Named (Bracketed p)) wX))
pPatches
      [PatchInfo]
context <- Parser [PatchInfo]
pContext
      Maybe ByteString
mBundleHash <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString
pBundleHash
      case Maybe ByteString
mBundleHash of
        Just ByteString
bundleHash -> do
          let realHash :: ByteString
realHash = forall (p :: * -> * -> *) wX wY.
(PatchListFormat p, ShowPatchBasic p) =>
FL (Named p) wX wY -> ByteString
hashBundle FL (Named (Bracketed p)) Any wX
patches
          if ByteString
realHash forall a. Eq a => a -> a -> Bool
== ByteString
bundleHash
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {p :: * -> * -> *} {wZ} {wX} {rt :: RepoType} {wX}.
[PatchInfo]
-> FL (Named (Bracketed p)) wZ wX -> Sealed (Bundle rt p wX)
packBundle [PatchInfo]
context FL (Named (Bracketed p)) Any wX
patches
            else forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
hashFailureMessage
        Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {p :: * -> * -> *} {wZ} {wX} {rt :: RepoType} {wX}.
[PatchInfo]
-> FL (Named (Bracketed p)) wZ wX -> Sealed (Bundle rt p wX)
packBundle [PatchInfo]
context FL (Named (Bracketed p)) Any wX
patches

pBundleHash :: Parser B.ByteString
pBundleHash :: Parser ByteString
pBundleHash = ByteString -> Parser ()
lexString ByteString
bundleHashName forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
lexWord

bundleHashName :: B.ByteString
bundleHashName :: ByteString
bundleHashName = String -> ByteString
BC.pack String
"Patch bundle hash:"

unavailablePatchesFL :: [PatchInfo] -> FL (PatchInfoAnd rt p) wX wY
unavailablePatchesFL :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> FL (PatchInfoAnd rt p) wX wY
unavailablePatchesFL = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (a :: * -> * -> *) wX wX wZ.
a wX wX -> FL a wX wZ -> FL a wX wZ
(:>:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {rt :: RepoType} {p :: * -> * -> *} {wA} {wB}.
PatchInfo -> PatchInfoAndG rt p wA wB
piUnavailable) (forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
  where
    piUnavailable :: PatchInfo -> PatchInfoAndG rt p wA wB
piUnavailable PatchInfo
i = forall (p :: * -> * -> *) wA wB (rt :: RepoType).
PatchInfo -> Hopefully p wA wB -> PatchInfoAndG rt p wA wB
patchInfoAndPatch PatchInfo
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) wX wY. String -> Hopefully a wX wY
unavailable forall a b. (a -> b) -> a -> b
$
      String
"Patch not stored in patch bundle:\n" forall a. [a] -> [a] -> [a]
++ Doc -> String
renderString (PatchInfo -> Doc
displayPatchInfo PatchInfo
i)

pContext :: Parser [PatchInfo]
pContext :: Parser [PatchInfo]
pContext = ByteString -> Parser ()
lexString ByteString
contextName forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser PatchInfo
readPatchInfo

contextName :: B.ByteString
contextName :: ByteString
contextName = String -> ByteString
BC.pack String
"Context:"

pPatches :: RepoPatch p => Parser (Sealed (FL (Named (Bracketed p)) wX))
pPatches :: forall (p :: * -> * -> *) wX.
RepoPatch p =>
Parser (Sealed (FL (Named (Bracketed p)) wX))
pPatches = ByteString -> Parser ()
lexString ByteString
patchesName forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'

patchesName :: B.ByteString
patchesName :: ByteString
patchesName = String -> ByteString
BC.pack String
"New patches:"

readContextFile :: Commute p
                => PatchSet rt p Origin wX
                -> FilePath
                -> IO (SealedPatchSet rt p Origin)
readContextFile :: forall (p :: * -> * -> *) (rt :: RepoType) wX.
Commute p =>
PatchSet rt p Origin wX
-> String -> IO (SealedPatchSet rt p Origin)
readContextFile PatchSet rt p Origin wX
ref = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> *) wX. a wX -> Sealed a
Sealed forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {wB}. ByteString -> IO (PatchSet rt p Origin wB)
parseAndInterpret forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
mmapFilePS)
  where
    parseAndInterpret :: ByteString -> IO (PatchSet rt p Origin wB)
parseAndInterpret =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> FL (PatchInfoAnd rt p) wA wB
-> Either String (PatchSet rt p Origin wB)
interpretContext PatchSet rt p Origin wX
ref forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
ByteString -> Either String (FL (PatchInfoAnd rt p) wX wY)
parseContextFile)

-- | Interpret a context file in the context of a 'PatchSet'. This means we
-- match up a possible tag. This fails if the tag couldn't be found.
interpretContext :: Commute p
                 => PatchSet rt p Origin wT
                 -> FL (PatchInfoAnd rt p) wA wB
                 -> Either String (PatchSet rt p Origin wB)
interpretContext :: forall (p :: * -> * -> *) (rt :: RepoType) wT wA wB.
Commute p =>
PatchSet rt p Origin wT
-> FL (PatchInfoAnd rt p) wA wB
-> Either String (PatchSet rt p Origin wB)
interpretContext PatchSet rt p Origin wT
ref FL (PatchInfoAnd rt p) wA wB
context =
  case FL (PatchInfoAnd rt p) wA wB
context of
    PatchInfoAnd rt p wA wY
tag :>: FL (PatchInfoAnd rt p) wY wB
rest
      | Just String
tagname <- PatchInfo -> Maybe String
piTag (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wA wY
tag) ->
        case forall (p :: * -> * -> *) (rt :: RepoType) wStart wX.
Commute p =>
PatchInfo
-> PatchSet rt p wStart wX -> Maybe (PatchSet rt p wStart wX)
splitOnTag (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAnd rt p wA wY
tag) PatchSet rt p Origin wT
ref of
          Maybe (PatchSet rt p Origin wT)
Nothing ->
            forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Cannot find tag " forall a. [a] -> [a] -> [a]
++ String
tagname forall a. [a] -> [a] -> [a]
++ String
" from context in our repo"
          Just (PatchSet RL (Tagged rt p) Origin wX
ts RL (PatchInfoAnd rt p) wX wT
_) ->
            forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
ts (forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wY wB
rest))
    FL (PatchInfoAnd rt p) wA wB
_ -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet forall (a :: * -> * -> *) wX. RL a wX wX
NilRL (forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) wA wB
context))

parseContextFile :: B.ByteString
                 -> Either String (FL (PatchInfoAnd rt p) wX wY)
parseContextFile :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
ByteString -> Either String (FL (PatchInfoAnd rt p) wX wY)
parseContextFile =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse forall {rt :: RepoType} {p :: * -> * -> *} {wX} {wY}.
Parser ByteString (FL (PatchInfoAnd rt p) wX wY)
pUnsignedContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decodeGpgClearsigned
  where
    pUnsignedContext :: Parser ByteString (FL (PatchInfoAnd rt p) wX wY)
pUnsignedContext = forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
[PatchInfo] -> FL (PatchInfoAnd rt p) wX wY
unavailablePatchesFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [PatchInfo]
pContext

-- | Minimize the context of an 'FL' of patches to be packed into a bundle.
minContext :: (RepoPatch p)
           => PatchSet rt p wStart wB -- context to be minimized
           -> FL (PatchInfoAnd rt p) wB wC
           -> Sealed ((PatchSet rt p :> FL (PatchInfoAnd rt p)) wStart)
minContext :: forall (p :: * -> * -> *) (rt :: RepoType) wStart wB wC.
RepoPatch p =>
PatchSet rt p wStart wB
-> FL (PatchInfoAnd rt p) wB wC
-> Sealed ((:>) (PatchSet rt p) (FL (PatchInfoAnd rt p)) wStart)
minContext (PatchSet RL (Tagged rt p) Origin wX
behindTag RL (PatchInfoAnd rt p) wX wB
topCommon) FL (PatchInfoAnd rt p) wB wC
to_be_sent =
  case forall (p :: * -> * -> *) (q :: * -> * -> *) wX wY.
Commute p =>
(forall wA wB. (:>) p q wA wB -> Maybe ((:>) q p wA wB))
-> (:>) (RL p) q wX wY -> (:>) (RL p) (q :> RL p) wX wY
genCommuteWhatWeCanRL forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RL (PatchInfoAnd rt p) wX wB
topCommon forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wB wC
to_be_sent) of
    (RL (PatchInfoAnd rt p) wX wZ
c :> FL (PatchInfoAnd rt p) wZ wZ
to_be_sent' :> RL (PatchInfoAnd rt p) wZ wC
_) -> forall (a :: * -> *) wX. a wX -> Sealed a
seal (forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
RL (Tagged rt p) Origin wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p Origin wY
PatchSet RL (Tagged rt p) Origin wX
behindTag RL (PatchInfoAnd rt p) wX wZ
c forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PatchInfoAnd rt p) wZ wZ
to_be_sent') 

-- TODO shouldn't we verify the signature? That is, pipe the input through
-- "gpg --verify -o-"? This would also let gpg handle their own mangling.

-- | Decode gpg clearsigned file content.
decodeGpgClearsigned :: B.ByteString -> B.ByteString
decodeGpgClearsigned :: ByteString -> ByteString
decodeGpgClearsigned ByteString
input =
  case ByteString -> ByteString -> ByteString -> Maybe ByteString
betweenLinesPS ByteString
startSignedName ByteString
endSignedName ByteString
input of
    Maybe ByteString
Nothing -> ByteString
input
    Just ByteString
signed -> ByteString -> ByteString
removeGpgDashes (ByteString -> ByteString
dropHashType ByteString
signed)
  where
    -- Note that B.concat is optimized to avoid unnecessary work, in particular
    -- concatenating slices that were originally adjacent involves no extra
    -- copying, and allocation of the result buffer is done only once.
    removeGpgDashes :: ByteString -> ByteString
removeGpgDashes = [ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitGpgDashes
    splitGpgDashes :: ByteString -> [ByteString]
splitGpgDashes ByteString
s =
      case ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
newline_dashes ByteString
s of
        (ByteString
before, ByteString
rest)
          | ByteString -> Bool
B.null ByteString
rest -> [ByteString
s]
          | (ByteString
keep, ByteString
after) <- Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
2 ByteString
rest ->
              ByteString
before forall a. a -> [a] -> [a]
: ByteString
keep forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
splitGpgDashes (Int -> ByteString -> ByteString
B.drop Int
2 ByteString
after)
    newline_dashes :: ByteString
newline_dashes = String -> ByteString
BC.pack String
"\n- -"
    dropHashType :: ByteString -> ByteString
dropHashType ByteString
s =
      case ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
hashTypeName ByteString
s of
        (ByteString
_, ByteString
rest)
          | ByteString -> Bool
B.null ByteString
rest -> ByteString
s
          | Bool
otherwise -> ByteString -> ByteString
dropSpace forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BC.dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') ByteString
rest
    hashTypeName :: ByteString
hashTypeName = String -> ByteString
BC.pack String
"Hash:"
    startSignedName :: ByteString
startSignedName = String -> ByteString
BC.pack String
"-----BEGIN PGP SIGNED MESSAGE-----"
    endSignedName :: ByteString
endSignedName = String -> ByteString
BC.pack String
"-----BEGIN PGP SIGNATURE-----"