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 )
data Bundle rt p wX wY where
Bundle :: (FL (PatchInfoAnd rt p) :> FL (PatchInfoAnd rt p)) wX wY
-> Bundle rt p wX wY
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
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)
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)
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
minContext :: (RepoPatch p)
=> PatchSet rt p wStart wB
-> 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')
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
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-----"