diff --git a/src/Data/Binary/Get/Local.hs b/src/Data/Binary/Get/Local.hs index a277cc6..8ae822d 100644 --- a/src/Data/Binary/Get/Local.hs +++ b/src/Data/Binary/Get/Local.hs @@ -70,9 +70,15 @@ requireWord8 p = do then return w else fail "Word doesn't satisfy predicate" +attemptWord8 :: (Word8 -> Bool) -> Get (Maybe Word8) +attemptWord8 p = Just <$> requireWord8 p <|> pure Nothing + requireSpace :: Get () requireSpace = void $ requireWord8 (== 32) +requireNewline :: Get () +requireNewline = void $ requireWord8 (== 10) + attemptByteString :: ByteString -> Get Bool attemptByteString s = fmap isJust . lookAheadM $ do b <- getByteString $ length s diff --git a/src/Network/Git/Local/Ack/Put.hs b/src/Network/Git/Local/Ack/Put.hs new file mode 100644 index 0000000..c109c33 --- /dev/null +++ b/src/Network/Git/Local/Ack/Put.hs @@ -0,0 +1,47 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Network.Git.Local.Ack.Put + ( putAckMulti + , putAck + , putNak + ) +where + +putAckStatus :: AckStatus -> Put +putAckStatus AckContinue = putByteString "continue" +putAckStatus AckCommon = putByteString "common" +putAckStatus AckReady = putByteString "ready" + +lenAckStatus :: AckStatus -> Int +lenAckStatus AckContinue = 8 +lenAckStatus AckCommon = 6 +lenAckStatus AckReady = 5 + +putAckMulti :: ObjId -> AckStatus -> Put +putAckMulti oid as = putDataPkt True (3 + 1 + 40 + lenAckStatus as) $ do + putByteString "ACK" + putSpace + putObjId oid + putAckStatus as + +putAck :: ObjId -> Put +putAck oid = putDataPkt True (3 + 1 + 40) $ do + putByteString "ACK" + putSpace + putObjId oid + +putNak :: Put +putNak = putDataPkt True 3 $ putByteString "NAK" diff --git a/src/Network/Git/Local/Ack/Types.hs b/src/Network/Git/Local/Ack/Types.hs new file mode 100644 index 0000000..aa18ba7 --- /dev/null +++ b/src/Network/Git/Local/Ack/Types.hs @@ -0,0 +1,21 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Network.Git.Local.Ack.Types + ( AckStatus (..) + ) +where + +data AckStatus = AckContinue | AckCommon | AckReady diff --git a/src/Network/Git/Local/Get.hs b/src/Network/Git/Local/Get.hs index 8f93e12..2c216e9 100644 --- a/src/Network/Git/Local/Get.hs +++ b/src/Network/Git/Local/Get.hs @@ -41,6 +41,18 @@ getDataPkt getPayload = do getObjId :: Get ObjId getObjId = ObjId . fromHex <$> getByteString 40 +getTaggedObjId :: ByteString -> Get ObjId +getTaggedObjId tag = getDataPkt $ \ len -> + let baselen = B.length tag + 1 + 40 + in if len < baselen || baselen + 1 < len + then fail "Tagged obj id of unexpected length" + else do + requireByteString tag + requireSpace + oid <- getObjId + when (len == baselen + 1) requireNewline + return oid + getCapabilities :: Int -> Get [Capability] getCapabilities n = do getByteString n diff --git a/src/Network/Git/Local/UploadHaves/Get.hs b/src/Network/Git/Local/UploadHaves/Get.hs new file mode 100644 index 0000000..36525aa --- /dev/null +++ b/src/Network/Git/Local/UploadHaves/Get.hs @@ -0,0 +1,38 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Network.Git.Local.UploadHaves.Get + ( getUploadHaves + ) +where + +getHaves :: Get [ObjId] +getHaves = many $ getTaggedObjId "have" + +requireDone :: Get () +requireDone = getDataPkt $ \ len -> + if len < 4 || len > 5 + then fail "invalid pkt-len for a \"done\" line" + else do + requireByteString "done" + when (len == 5) requireNewline + +getUploadHaves :: Get UploadHaves +getUploadHaves = do + haves <- getHaves + requireFlushPkt <|> requireDone + return UploadHaves + { uhHave = haves + } diff --git a/src/Network/Git/Local/UploadHaves/Types.hs b/src/Network/Git/Local/UploadHaves/Types.hs new file mode 100644 index 0000000..e77d775 --- /dev/null +++ b/src/Network/Git/Local/UploadHaves/Types.hs @@ -0,0 +1,23 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Network.Git.Local.UploadHaves.Types + ( UploadHaves (..) + ) +where + +data UploadHaves = UploadHaves + { uhHave :: [ObjId] + } diff --git a/src/Network/Git/Local/UploadRequest/Get.hs b/src/Network/Git/Local/UploadRequest/Get.hs index 45ddfd7..6385b92 100644 --- a/src/Network/Git/Local/UploadRequest/Get.hs +++ b/src/Network/Git/Local/UploadRequest/Get.hs @@ -26,20 +26,11 @@ getFirstWant = getDataPkt $ \ len -> do caps <- getCapabilities $ len - 45 return (caps, oid) -attemptTaggedObjId :: ByteString -> Get (Maybe ObjId) -attemptTaggedObjId s = lookAheahM $ getDataPkt $ \ _len -> do - b <- getByteString $ length s - if b == s - then do - requireSpace - Just <$> getObjId - else return Nothing - -- unfoldM is from the monad-loops package getWants :: Get ([Capability], [ObjId]) getWants = do (caps, oid) <- getFirstWant - oids <- unfoldM $ attemptTaggedObjId "want" + oids <- many $ getTaggedObjId "want" return (caps, oid:oids) getShallows :: Get [ObjId]