From 50198a1906684d7e26abb3cc15cf555e1801fcab Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Fri, 8 Apr 2016 21:10:33 +0000 Subject: [PATCH] Move git protocol code away to separate package --- src/Data/Binary/Get/Local.hs | 96 --------- src/Data/Binary/Put/Local.hs | 62 ------ src/Data/Git/Local.hs | 212 ------------------- src/Data/Graph/Inductive/Local.hs | 176 --------------- src/GitPackProto.hs | 6 - src/Network/Git/Local/Ack/Put.hs | 47 ---- src/Network/Git/Local/Ack/Types.hs | 21 -- src/Network/Git/Local/Get.hs | 59 ------ src/Network/Git/Local/Put.hs | 63 ------ src/Network/Git/Local/RefDiscovery.hs | 22 -- src/Network/Git/Local/RefDiscovery/Put.hs | 67 ------ src/Network/Git/Local/RefDiscovery/Types.hs | 45 ---- src/Network/Git/Local/ShallowUpdate/Put.hs | 41 ---- src/Network/Git/Local/ShallowUpdate/Types.hs | 24 --- src/Network/Git/Local/Types.hs | 27 --- src/Network/Git/Local/UploadHaves/Get.hs | 38 ---- src/Network/Git/Local/UploadHaves/Types.hs | 23 -- src/Network/Git/Local/UploadRequest.hs | 22 -- src/Network/Git/Local/UploadRequest/Get.hs | 68 ------ src/Network/Git/Local/UploadRequest/Types.hs | 28 --- src/Vervis/Handler/Repo.hs | 11 +- src/Vervis/Ssh.hs | 35 +-- stack.yaml | 2 +- vervis.cabal | 8 +- 24 files changed, 30 insertions(+), 1173 deletions(-) delete mode 100644 src/Data/Binary/Get/Local.hs delete mode 100644 src/Data/Binary/Put/Local.hs delete mode 100644 src/Data/Git/Local.hs delete mode 100644 src/Data/Graph/Inductive/Local.hs delete mode 100644 src/Network/Git/Local/Ack/Put.hs delete mode 100644 src/Network/Git/Local/Ack/Types.hs delete mode 100644 src/Network/Git/Local/Get.hs delete mode 100644 src/Network/Git/Local/Put.hs delete mode 100644 src/Network/Git/Local/RefDiscovery.hs delete mode 100644 src/Network/Git/Local/RefDiscovery/Put.hs delete mode 100644 src/Network/Git/Local/RefDiscovery/Types.hs delete mode 100644 src/Network/Git/Local/ShallowUpdate/Put.hs delete mode 100644 src/Network/Git/Local/ShallowUpdate/Types.hs delete mode 100644 src/Network/Git/Local/Types.hs delete mode 100644 src/Network/Git/Local/UploadHaves/Get.hs delete mode 100644 src/Network/Git/Local/UploadHaves/Types.hs delete mode 100644 src/Network/Git/Local/UploadRequest.hs delete mode 100644 src/Network/Git/Local/UploadRequest/Get.hs delete mode 100644 src/Network/Git/Local/UploadRequest/Types.hs diff --git a/src/Data/Binary/Get/Local.hs b/src/Data/Binary/Get/Local.hs deleted file mode 100644 index 8ae822d..0000000 --- a/src/Data/Binary/Get/Local.hs +++ /dev/null @@ -1,96 +0,0 @@ -{- 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 Data.Binary.Get.Local - ( getHexDigit - , getHex16 - , getDecimal - --TODO i added more functions below, didnt export yet - ) -where - --- | Read an ASCII character representing a hexadecimal digit, and convert to --- the integral value of the digit (i.e. a number between 0 and 15). -getHexDigit :: Get Word8 -getHexDigit = - let fromHex w - | 48 <= w && w <= 57 = return $ w - 48 -- 0-9 - | 65 <= w && w <= 70 = return $ w - 55 -- A-F - | 97 <= w && w <= 102 = return $ w - 87 -- a-f - | otherwise = fail "Not an ASCII hex digit" - in getWord8 >>= fromHex - --- | Efficienty convert 'Word8' to 'Int'. -toInt :: Word8 -> Int -toInt w = - fromMaybe (error "Huh? Converting Word8 to Int failed!") $ - toIntegralSized w - --- | Read 4 ASCII hex digits and parse them as a hex string into the integer it --- represents. Since each hex digit is 4 bits, 4 such digits form a 16-bit --- integer (but this function reads 4 bytes which are 32 bits). --- --- The resulting 16-bit integer is returned as an 'Int' because it is used --- below with a function which takes an 'Int' parameter. -getHex16 :: Get Int -getHex16 = do - let sl n = unsafeShiftL n . toInt - hh <- sl 12 <$> getHexDigit - h <- sl 8 <$> getHexDigit - l <- sl 4 <$> getHexDigit - ll <- toInt <$> getHexDigit - return $ hh .&. h .&. l .&. ll - --- Read a string of given size representing an integer in decimal, and parse --- the integer. -getDecimal :: Num a => Int -> Get a -getDecimal len = do - s <- getByteString len - case fromDecimal s - Nothing -> fail "s doesn't represent a decimal integer" - Just n -> return n - --- | Get a word which satisfies the predicate, otherwise fail. -requireWord8 :: (Word8 -> Bool) -> Get Word8 -requireWord8 p = do - w <- getWord8 - if p w - 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 - if b == s - then return $ Just b - else return Nothing - --- | Read a bytestring of the same length as the parameter, and fail if they --- aren't equal. If equal, return the given value. -requireByteString :: ByteString -> a -> Get a -requireByteString s v = fmap isJust $ lookAheadM $ do - b <- getByteString $ length s - if b == s - then return v - else fail "Didn't get the expected bytestring" diff --git a/src/Data/Binary/Put/Local.hs b/src/Data/Binary/Put/Local.hs deleted file mode 100644 index a988734..0000000 --- a/src/Data/Binary/Put/Local.hs +++ /dev/null @@ -1,62 +0,0 @@ -{- 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 Data.Binary.Put.Local - ( putNull - , putLF - , putSpace - , putHexDigit - , putHex16 - ) -where - -putNull :: Put -putNull = putWord8 0 - -putLF :: Put -putLF = putWord8 10 - -putSpace :: Put -putSpace = putWord8 32 - --- | Efficiently convert an 'Int' between 0 and 127 to 'Word8'. -toWord8 :: Int -> Word8 -toWord8 i = - fromMaybe (error "Converting Int to Word8 failed") $ - toIntegralSized i - --- | Take an integral value of a hex digit (i.e. between 0 and 15). Put the --- ASCII character representing the digit in lowecase hexadecimal. -putHexDigit :: Word8 -> Put -putHexDigit w - | 0 <= w && w <= 9 = - | 10 <= w && w <= 15 = - | otherwise = - --- | Takes a number which must be a 16-bit non-negative integer. Generates a --- 4-byte ASCII hexadecimal representation of the number's value and puts it. -putHex16 :: Int -> Put -putHex16 n = - let (rem1, ll) = n `divMod` 16 - (rem2, l) = rem1 `divMod` 16 - (rem3, h) = rem2 `divMod` 16 - (rem4, hh) = rem3 `divMod` 16 - in if rem4 /= 0 - then fail "Hex integer to put is too large, must be 16 bit" - else do - putHexDigit $ toWord8 hh - putHexDigit $ toWord8 h - putHexDigit $ toWord8 l - putHexDigit $ toWord8 ll diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs deleted file mode 100644 index 68f90ed..0000000 --- a/src/Data/Git/Local.hs +++ /dev/null @@ -1,212 +0,0 @@ -{- 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 - - . - -} - --- | Git repo tools using the @hit@ package. -module Data.Git.Local - ( resolveNameMaybe - , resolveName - , listReferences - , loadCommits - , NodeLabel - , EdgeLabel - , CommitGraph - , rootN - , loadCommitGraphByRef - , loadCommitGraphByNameMaybe - , loadCommitGraphByName - , loadCommitsTopsort - , loadCommitsTopsortList - ) -where - -import Prelude - -import Control.Monad.IO.Class -import Data.Foldable (foldl', foldlM) -import Data.Git.Named (RefName (..)) -import Data.Git.Ref (Ref, toBinary) -import Data.Git.Repository (getCommit, resolveRevision, branchList, tagList) -import Data.Git.Revision (Revision (..)) -import Data.Git.Storage (Git) -import Data.Git.Types (Commit (..)) -import Data.Graph.Inductive.Graph (Graph (mkGraph), Node) -import Data.Graph.Inductive.PatriciaTree (Gr) -import Data.Hashable (Hashable (..)) -import Data.Maybe (catMaybes, fromMaybe) -import Data.Ord (Down (..)) - -import qualified Data.DList as D -import qualified Data.HashMap.Strict as M -import qualified Data.Set as S - -import Data.Graph.Inductive.Local - --- | For a given ref name - HEAD or branch or tag - determine its ref hash. -resolveNameMaybe :: Git -> String -> IO (Maybe Ref) -resolveNameMaybe git name = resolveRevision git $ Revision name [] - --- | For a given ref name - HEAD or branch or tag - determine its ref hash. -resolveName :: Git -> String -> IO Ref -resolveName git name = do - mref <- resolveNameMaybe git name - return $ fromMaybe (error "No such ref name in the repo") mref - --- | List the available references in a git repo, sorted by ref name. The list --- includes HEAD, branches and tags. -listReferences :: Git -> IO [(Ref, String)] -listReferences git = do - branches <- S.mapMonotonic refNameRaw <$> branchList git - tags <- S.mapMonotonic refNameRaw <$> tagList git - let names = S.toAscList $ S.insert "HEAD" $ S.union branches tags - mentries <- - traverse (\ name -> fmap (,name) <$> resolveNameMaybe git name) names - return $ catMaybes mentries - -instance Hashable Ref where - hashWithSalt salt = hashWithSalt salt . toBinary - hash = hash . toBinary - --- | Load the entire graph of commits which are ancestors of the given ref --- (and that ref itself). Fold the commit structure into a value of type @a@ --- inside monad @m@. --- --- This is a low-level function which operates on a commit tree, i.e. the same --- ref may be visited more than once (if it has more than one child commit). --- You can use the provided flexibility to implement graph algorithms over the --- commits, or build a graph using some graph library and use that library's --- tools for further processing. -loadCommits - :: MonadIO m - => Git - -- ^ Open git repository context - -> ((Ref, Commit) -> Ref -> a -> m (a, Maybe Commit)) - -- ^ Given a child commit, one of its parent commits and an @a@ value, - -- generate an updated @a@ value. The second returned value determines - -- whether traversal should proceed to the parent of the parent commit. If - -- you return 'Nothing', it won't. If you load the parent commit (e.g. with - -- 'getCommit') and return 'Just' it, traversal will proceed to its - -- parents. - -> a - -- ^ Initial value - -> Ref - -- ^ Hash of the commit whose ancestor graph should be loaded - -> Maybe Commit - -- ^ If you already read the commit for the ref passed as the previous - -- parameter, pass the commit here to avoid repeated loading of it. - -- Otherwise, pass 'Nothing' and it will be read from the repo. - -> m a -loadCommits git func val ref mcmt = readCommitMaybe ref mcmt >>= go val ref - where - readCommit = liftIO . getCommit git - readCommitMaybe r = maybe (readCommit r) return - --readRefCommit r = do - -- c <- readCommit r - -- return (r, c) - step p v r = do - (v', mc) <- func p r v - case mc of - Nothing -> return v' - Just c -> go v' r c - go v r c = foldlM (step (r, c)) v $ commitParents c - --let rs = commitParents c - --ps <- mapM readRefCommit rs - --foldlM (step (r, c)) v rs - --- | Each node in the commit graph represents a commit. -type NodeLabel = (Ref, Commit) - --- | Edges are tagged by numbers defining the order of parents of a commit. For --- each commit, the out-edges pointing to its parents are numbered according to --- the order in which the parents were specified in the 'commitParents' field. --- --- The 'Down' wrapper reverses the comparison (the 'Ord' instance), so that --- merged-from branches are inserted earlier into the sorted list than --- merged-to branches. -type EdgeLabel = Down Int - -type CommitGraph g = g NodeLabel EdgeLabel - --- | The node number of the root node in loaded commit graphs. -rootN :: Node -rootN = 1 - --- | Use 'loadCommits' to build a directed acyclic graph of commits. There is a --- single root node, which is the ref passed to this function. -loadCommitGraphByRef :: Graph g => Git -> Ref -> IO (CommitGraph g) -loadCommitGraphByRef git ref = do - let visit (_rChild, _cChild) rParent v@(nextNode, commits) = - if rParent `M.member` commits - then return (v, Nothing) - else do - cParent <- getCommit git rParent - let commits' = M.insert rParent (cParent, nextNode) commits - return ((nextNode + 1, commits'), Just cParent) - cmt <- getCommit git ref - (_, commits) <- loadCommits git visit (rootN + 1, M.empty) ref (Just cmt) - let commits' = M.insert ref (cmt, rootN) commits - nodeOf r = maybe (error "ref has no node") snd $ M.lookup r commits' - mkNode l r (c, n) = (n, (r, c)) : l - nodes = M.foldlWithKey' mkNode [] commits' - mkEdge n l (r, e) = (n, nodeOf r, e) : l - edgeNums = map Down [1..] - mkEdges l (c, n) = foldl' (mkEdge n) l $ zip (commitParents c) edgeNums - edges = M.foldl' mkEdges [] commits' - return $ mkGraph nodes edges - --- | Like 'loadCommitGraphByRef', but lets you specify a named ref, such as a --- branch or tag name. Returns 'Nothing' if ref isn't found. -loadCommitGraphByNameMaybe :: - Graph g => Git -> String -> IO (Maybe (CommitGraph g)) -loadCommitGraphByNameMaybe git name = do - mref <- resolveRevision git $ Revision name [] - case mref of - Nothing -> return Nothing - Just ref -> Just <$> loadCommitGraphByRef git ref - --- | Like 'loadCommitGraphByNameMaybe', but throws an exception if the ref name --- can't be resolved. -loadCommitGraphByName :: Graph g => Git -> String -> IO (CommitGraph g) -loadCommitGraphByName git name = do - mg <- loadCommitGraphByNameMaybe git name - case mg of - Nothing -> error "no such ref" - Just g -> return g - --- | Load a commit graph and topsort the commits. The resulting list starts --- with the last commit in the repo and ends with the initial commit. -loadCommitsTopsort - :: (ResultList l, Functor l) - => Git - -> String - -> IO (l (Ref, Commit)) -loadCommitsTopsort git name = do - let load :: IO (CommitGraph Gr) - load = loadCommitGraphByName git name - graph <- load - let mnodes = topsortUnmixOrder graph (NodeStack [rootN]) - nodes = case mnodes of - Nothing -> error "commit graph contains a cycle" - Just ns -> ns - return $ fmap (nodeLabel graph) nodes - -instance ResultList D.DList where - emptyList = D.empty - appendItem = flip D.snoc - --- | Runs 'loadCommitsTopsort' with a 'D.DList', then converts to list and --- returns it. At least at the time of writing, DList mapping and folding goes --- through a regular list anyway. -loadCommitsTopsortList :: Git -> String -> IO [(Ref, Commit)] -loadCommitsTopsortList git name = D.toList <$> loadCommitsTopsort git name diff --git a/src/Data/Graph/Inductive/Local.hs b/src/Data/Graph/Inductive/Local.hs deleted file mode 100644 index ecf3c38..0000000 --- a/src/Data/Graph/Inductive/Local.hs +++ /dev/null @@ -1,176 +0,0 @@ -{- 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 - - . - -} - --- | Graph tools for use with the @fgl@ package. -module Data.Graph.Inductive.Local - ( nodeLabel - , NodeSet (..) - , TraversalOrder (..) - , ResultList (..) - , topsortKahn - , NodeStack (..) - , topsortUnmix - , topsortUnmixOrder - ) -where - -import Prelude - -import Data.Foldable (foldl') -import Data.Graph.Inductive.Graph -import Data.List (sortBy) - --- | Find the label for a 'Node', assuming you know the node exists in the --- graph. If the node isn't found, an exception is thrown. -nodeLabel :: Graph g => g a b -> Node -> a -nodeLabel g n = - case lab g n of - Nothing -> error "node not found in graph" - Just l -> l - --- | A graph node container to be used with Kanh's topsort algorithm. -class NodeSet s where - -- | Take a graph node and a container, insert the node into it and return - -- the resulting container. - --insert :: LNode a -> s a -> s a - insertNode :: Node -> s -> s - -- | Remove a node from the container. Return the removed node and the - -- resulting container after removal. If the container is empty (i.e. there - -- is no node to remove), return 'Nothing'. - --extract :: s a -> Maybe (LNode a, s a) - extractNode :: s -> Maybe (Node, s) - --- | Specification of the order in which a node's outgoing edges should be --- traversed. -data TraversalOrder b - -- | The order in which they're listed by FGL functions. The FGL - -- documentation doesn't seem to specify the order, which means it may - -- depend entirely on the 'Graph' instance you are using. - = InOrder - -- | Reverse of 'InOrder'. - | ReverseOrder - -- | Sort the outgoing edge list before traversal, using the given ordering - -- function. It takes two pairs, each pair having a labeled node and the - -- label of the edge, and determines the order they should be visited. 'LT' - -- means the first edge is visited first. 'GT' means the second edge is - -- visited first. 'EQ' means it doesn't matter and the implementation can - -- choose arbitrarily. - | SortedOrder ((Node, b) -> (Node, b) -> Ordering) - -- | Lets you reorder the edge list in an arbitrary way before it gets - -- traversed. Note that it's up to you to make sure the list you return - -- really contains all the items of the input list. - | CustomOrder ([(Node, b)] -> [(Node, b)]) - -sortNodes :: TraversalOrder b -> [(Node, b)] -> [(Node, b)] -sortNodes InOrder = id -sortNodes ReverseOrder = reverse -sortNodes (SortedOrder f) = sortBy f -sortNodes (CustomOrder f) = f - --- | A container for storing the result of the sorting. Kahn's algorithm begins --- with an empty structure and then appends nodes to produce the result. --- Therefore almost any sequence container could work. --- --- You can also use a regular Haskell list. Implement 'append' using list --- prepend and remember to 'reverse' the list returned by the algorithm. -class ResultList l where - emptyList :: l a - appendItem :: a -> l a -> l a - --- | Flexible topological sort using Kahn's algorithm. --- --- It seems that Haskell graph libraries (and perhaps graph libraries in --- general) tend to implement topological sort using depth-first search (DFS). --- While it's probably easier (since these libraries also implement DFS), the --- result is that you pass a graph to a function and get back the sorted list. --- There is no room left for specifying variable parts of the algorithm, which --- means you can't control which topsort order (out of potentially many orders --- possible) you get. Sometimes you don't care, but sometimes you do. --- --- Kahn's algorithm has room for variations in two places: --- --- (1) When traversing a node's outgoing edges, the order in which this --- traversal happens isn't specified. --- (2) The internals of structure S, the set of nodes with no inbound edges, --- aren't specified. Therefore, so is the order in which nodes are removed --- from it. --- --- https://en.wikipedia.org/wiki/Topological_sort#Kahn.27s_algorithm -topsortKahn - :: (DynGraph g, NodeSet s, ResultList l) - => g a b - -- ^ Graph whose nodes to sort - -> s - -- ^ The set of graph nodes which don't have inbound edges - -> TraversalOrder b - -- ^ In which order to go over the outgoing edges of a node - -> Maybe (l Node) - -- ^ Topologically sorted list. For each edge from node @u@ to node @v@, - -- @u@ appears before @v@ in this list. If the graph is empty or the - -- initial node set is empty, an empty list is returned. If the graph - -- contains a cycle, 'Nothing' is returned. -topsortKahn graph set order = f graph set emptyList - where - nEdges = length . labEdges - sort = sortNodes order - visit n (g, s) m = - let g' = delEdge (n, m) g - s' = - if indeg g' m > 0 - then s - else insertNode m s - in (g', s') - f g s l = - case extractNode s of - Nothing -> - if nEdges g > 0 - then Nothing - else Just l - Just (n, s') -> - let l' = appendItem n l - children = map fst $ sort $ lsuc g n - (g', s'') = foldl' (visit n) (g, s') children - in f g' s'' l' - -newtype NodeStack = NodeStack [Node] - -instance NodeSet NodeStack where - insertNode n (NodeStack l) = NodeStack $ n : l - extractNode (NodeStack l) = - case l of - [] -> Nothing - (n:ns) -> Just (n, NodeStack ns) - --- | Topologically sort commits so that parallel lines of work, e.g. a master --- branch and a short topic branch merged into it, don't get their commits --- mixed in the sorted order. -topsortUnmix - :: (DynGraph g, ResultList l) - => g a b - -> NodeStack - -> TraversalOrder b - -> Maybe (l Node) -topsortUnmix = topsortKahn - --- | Adds an additioal constraint to 'topsortUnmix': When traversing a node's --- outgoing edges, do so using the 'Ord' instance of the labels of the edges. -topsortUnmixOrder - :: (Ord b, DynGraph g, ResultList l) - => g a b - -> NodeStack - -> Maybe (l Node) -topsortUnmixOrder graph stack = - let order (_, i) (_, j) = compare i j - in topsortUnmix graph stack (SortedOrder order) diff --git a/src/GitPackProto.hs b/src/GitPackProto.hs index 8edfec4..ee1fb21 100644 --- a/src/GitPackProto.hs +++ b/src/GitPackProto.hs @@ -300,9 +300,3 @@ instance SizedBinary RefAd where return (lim, SymRefTag name) else fail "symref too short to be a tag" --- pack protocol sequence --- --- (1) Send the ref list --- (2) Wait for input --- (2a) If got flush-pkt, close channel --- (2b) TODO CONTINUE diff --git a/src/Network/Git/Local/Ack/Put.hs b/src/Network/Git/Local/Ack/Put.hs deleted file mode 100644 index c109c33..0000000 --- a/src/Network/Git/Local/Ack/Put.hs +++ /dev/null @@ -1,47 +0,0 @@ -{- 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 deleted file mode 100644 index aa18ba7..0000000 --- a/src/Network/Git/Local/Ack/Types.hs +++ /dev/null @@ -1,21 +0,0 @@ -{- 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 deleted file mode 100644 index 2c216e9..0000000 --- a/src/Network/Git/Local/Get.hs +++ /dev/null @@ -1,59 +0,0 @@ -{- 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 - - . - -} - --- | Helpers for getting git pack protocol elements. -module Network.Git.Local.Get - ( requireFlushPkt - , attemptFlushPkt - , getDataPkt - --TODO export more stuff i added below - ) -where - -requireFlushPkt :: Get () -requireFlushPkt = requireByteString "0000" - -attemptFlushPkt :: Get Bool -attemptFlushPkt = attemptByteString "0000" - -getDataPkt :: (Int -> Get a) -> Get a -getDataPkt getPayload = do - pktLen <- getHex16 - if | pktLen == 0 -> fail "Expected regular pkt-line, got flush-pkt" - | pktLen > 65524 -> fail "pkt-len is above the maximum allowed" - | pktLen <= 4 -> fail "pkt-len is below the possible minimum" - | otherwise -> - let len = pktLen - 4 - in isolate len $ getPayload len - -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 - return [] diff --git a/src/Network/Git/Local/Put.hs b/src/Network/Git/Local/Put.hs deleted file mode 100644 index 65cce67..0000000 --- a/src/Network/Git/Local/Put.hs +++ /dev/null @@ -1,63 +0,0 @@ -{- 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 - - . - -} - --- | Helpers for putting git pack protocol elements. -module Network.Git.Local.Put - ( -- * Object ID - zeroObjId - , putObjId - -- * Capability - , putCapabilities - , lenCapabilities - -- * Pkt Line - , putFlushPkt - , putDataPkt - ) -where - -zeroObjId :: ObjId -zeroObjId = ObjId $ fromHex $ B.replicate 40 48 -- 40 times '0' - -putObjId :: ObjId -> Put -putObjId (ObjId ref) = putByteString $ toHex ref - -putCapability :: Capability -> Put -putCapability Capability = putByteString "dummy" - -lenCapability :: Capability -> Int -lenCapability Capability = 5 - -putCapabilities :: [Capability] -> Put -putCapabilities [] = return () -putCapabilities (c:cs) = do - putCapability c - traverse_ (\ d -> putSpace >> putCapability d) cs - -lenCapabilities :: [Capability] -> Int -lenCapabilities [] = 0 -lenCapabilities (c:cs) = lenCapability c + sum (map ((+ 1) . lenCapability) cs) - -putFlushPkt :: Put -putFlushPkt = putByteString "0000" - -putDataPkt :: Bool -> Int -> Put -> Put -putDataPkt addLF payloadLen payloadPut = - let len = bool id (+1) addLF $ payloadLen - in if | len == 0 = fail "tried to put an empty pkt-line" - | len > 65520 = fail "payload bigger than maximal pkt-len" - | otherwise = do - putHex16 $ len + 4 - payloadPut - when addLF $ putLF diff --git a/src/Network/Git/Local/RefDiscovery.hs b/src/Network/Git/Local/RefDiscovery.hs deleted file mode 100644 index 0a1224a..0000000 --- a/src/Network/Git/Local/RefDiscovery.hs +++ /dev/null @@ -1,22 +0,0 @@ -{- 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 - - . - -} - --- | When communication starts, the server sends the client the list of refs in --- the local repo. This is called ref advertisement. From the client side, it's --- called ref discovery. -module Network.Git.Local.RefDiscovery - ( - ) -where diff --git a/src/Network/Git/Local/RefDiscovery/Put.hs b/src/Network/Git/Local/RefDiscovery/Put.hs deleted file mode 100644 index c4e75a7..0000000 --- a/src/Network/Git/Local/RefDiscovery/Put.hs +++ /dev/null @@ -1,67 +0,0 @@ -{- 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.RefDiscovery.Put - ( putRefDiscover - ) -where - -putSymRef :: SymRef -> Put -putSymRef SymRefHead = putByteString "HEAD" -putSymRef (SymRefBranch b) = do - putByteString "refs/heads/" - putByteString b -putSymRef (SymRefTag b p) = do - putByteString "refs/tags/" - putByteString b - when p $ putByteString "^{}" - -putRefAd :: RefAd -> Put -putRefAd ad = do - putObjId $ refAdId ad - putSpace - putByteString $ refAdName ad - -lenRefAd :: RefAd -> Int -lenRefAd ad = 40 + 1 + B.length (refAdName ad) - -putRefAdLine :: RefAd -> Put -putRefAdLine ad = putDataPkt True (lenRefAd ad) $ putRefAd ad - -putRefAdCapaLine :: RefAd -> [Capability] Put -putRefAdCapaLine ad caps = - putDataPkt True (lenRefAd ad + 1 + lenCapabilities caps) $ do - putRefAd ad - putNull - putCapabilities caps - -putDummyRefAdCapaLine :: [Capability] -> Put -putDummyRefAdCapaLine = putRefAdCapaLine $ RefAd - { refAdId = zeroObjId - , refAdSym = SymRefOther - , refAdName = "capabilities^{}" - } - --- TODO: declare capabilities --- TODO: peel annotated tags (somewhere else, so that this list already gets --- the peeled tags) -putRefDiscover :: RefDiscover -> Put -putRefDiscover (RefDiscover [] caps) = do - putDummyRefAdCapaLine caps - putFlushPkt -putRefDiscover (ReDiscover (a:as) caps) = do - putRefAdCapaLine a caps - traverse_ putRefAdLine as - putFlushPkt diff --git a/src/Network/Git/Local/RefDiscovery/Types.hs b/src/Network/Git/Local/RefDiscovery/Types.hs deleted file mode 100644 index 0c4b92e..0000000 --- a/src/Network/Git/Local/RefDiscovery/Types.hs +++ /dev/null @@ -1,45 +0,0 @@ -{- 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.RefDiscovery.Types - ( - ) -where - --- | A symbolic reference which refers to an object. -data SymRef - -- | The current branch. - = SymRefHead - -- | A branch with the given name. - | SymRefBranch ByteString - -- | A tag with the given name, and whether it's a peeled tag. - | SymRefTag ByteString Bool - -- | Something else. - -- | SymRefOther - --- | A ref advertisement. Used by one side to tell the other which refs it has --- locally. -data RefAd = RefAd - { refAdId :: ObjId - , refAdSym :: SymRef - , refAdName :: ByteString - } - --- | A message which allows the client to discover what the server side has and --- supports. -data RefDiscover = RefDiscover - { rdAds :: [RefAd] - , rdCaps :: [Capability] - } diff --git a/src/Network/Git/Local/ShallowUpdate/Put.hs b/src/Network/Git/Local/ShallowUpdate/Put.hs deleted file mode 100644 index 317dd4d..0000000 --- a/src/Network/Git/Local/ShallowUpdate/Put.hs +++ /dev/null @@ -1,41 +0,0 @@ -{- 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.ShallowUpdate.Put - ( putShallowUpdate - ) -where - -putShallow :: ObjId -> Put -putShallow oid = do - let len = 7 + 1 + 40 - putDataPkt True len $ do - putByteString "shallow" - putSpace - putObjId oid - -putUnshallow :: ObjId -> Put -putUnshallow oid = do - let len = 9 + 1 + 40 - putDataPkt True len $ do - putByteString "unshallow" - putSpace - putObjId oid - -putShallowUpdate :: ShallowUpdate -> Put -putShallowUpdate su = do - traverse_ putShallow $ suShallows su - traverse_ putUnshallow $ suUnshallows su - putFlushPkt diff --git a/src/Network/Git/Local/ShallowUpdate/Types.hs b/src/Network/Git/Local/ShallowUpdate/Types.hs deleted file mode 100644 index fed93d4..0000000 --- a/src/Network/Git/Local/ShallowUpdate/Types.hs +++ /dev/null @@ -1,24 +0,0 @@ -{- 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.ShallowUpdate.Types - ( ShallowUpdate (..) - ) -where - -data ShallowUpdate = ShallowUpdate - { suShallows :: [ObjId] - , suUnshallows :: [ObjId] - } diff --git a/src/Network/Git/Local/Types.hs b/src/Network/Git/Local/Types.hs deleted file mode 100644 index b4df8fb..0000000 --- a/src/Network/Git/Local/Types.hs +++ /dev/null @@ -1,27 +0,0 @@ -{- 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.Types - ( - ) -where - --- | A git object identifier. This is a SHA-1 hash. Its common textual --- representation is a 40-byte ASCII hexadecimal string. -newtype ObjId = ObjId Ref - --- | A git protocol capability. The server uses this to tell the client what it --- does and doesn't support. -data Capability = Capability diff --git a/src/Network/Git/Local/UploadHaves/Get.hs b/src/Network/Git/Local/UploadHaves/Get.hs deleted file mode 100644 index 36525aa..0000000 --- a/src/Network/Git/Local/UploadHaves/Get.hs +++ /dev/null @@ -1,38 +0,0 @@ -{- 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 deleted file mode 100644 index e77d775..0000000 --- a/src/Network/Git/Local/UploadHaves/Types.hs +++ /dev/null @@ -1,23 +0,0 @@ -{- 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.hs b/src/Network/Git/Local/UploadRequest.hs deleted file mode 100644 index a455dd4..0000000 --- a/src/Network/Git/Local/UploadRequest.hs +++ /dev/null @@ -1,22 +0,0 @@ -{- 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 - - . - -} - --- | After the client gets the advertised refs, it decides whether it needs to --- receive updates from the server. If yes, it sends a request which specifies --- exactly what it wants to receive. -module Network.Git.Local.UploadRequest - ( - ) -where diff --git a/src/Network/Git/Local/UploadRequest/Get.hs b/src/Network/Git/Local/UploadRequest/Get.hs deleted file mode 100644 index 6385b92..0000000 --- a/src/Network/Git/Local/UploadRequest/Get.hs +++ /dev/null @@ -1,68 +0,0 @@ -{- 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.UploadRequest.Get - ( getUploadRequest - ) -where - -getFirstWant :: Get ([Capability], ObjId) -getFirstWant = getDataPkt $ \ len -> do - requireByteString "want" - requireSpace - oid <- getObjId - caps <- getCapabilities $ len - 45 - return (caps, oid) - --- unfoldM is from the monad-loops package -getWants :: Get ([Capability], [ObjId]) -getWants = do - (caps, oid) <- getFirstWant - oids <- many $ getTaggedObjId "want" - return (caps, oid:oids) - -getShallows :: Get [ObjId] -getShallows = unfoldM $ attemptTaggedObjId "shallow" - -attemptDepth :: Get (Maybe Int) -attemptDepth = lookAheadM $ getDataPkt $ \ len -> do - b <- getByteString 6 - if b == "deepen" - then do - requireSpace - d <- getByteString $ len - 7 - let mn = case B.unsnoc d of - Just (i, 10) -> fromDecimal i - _ -> fromDecimal d - case mn of - Nothing -> fail "invalid depth string" - Just n -> return $ Just n - else return Nothing - -getUploadRequest :: Get UploadRequest -getUploadRequest = do - (caps, oids) <- getWants - shls <- getShallows - mdepth <- attemptDepth - requireFlushPkt - return UploadRequest - { urCaps = caps - , urWants = oids - , urShallows = shls - , urDepth = case mdepth of - Nothing -> Nothing - Just 0 -> Nothing - Just d -> Just d - } diff --git a/src/Network/Git/Local/UploadRequest/Types.hs b/src/Network/Git/Local/UploadRequest/Types.hs deleted file mode 100644 index 33a9fc9..0000000 --- a/src/Network/Git/Local/UploadRequest/Types.hs +++ /dev/null @@ -1,28 +0,0 @@ -{- 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.UploadRequest.Types - ( UploadRequest (..) - ) -where - --- | Using this request, the client specifies which git data it wants from the --- server. -data UploadRequest = UploadRequest - { urCaps :: [Capability] - , urWants :: [ObjId] - , urShallows :: [ObjId] - , urDepth :: Maybe Int - } diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 11bb01d..9183f13 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -47,7 +47,6 @@ import System.Directory (createDirectoryIfMissing) import System.Hourglass (dateCurrent) import Data.ByteString.Char8.Local (takeLine) -import Data.Git.Local (loadCommitsTopsortList) import Vervis.Form.Repo import Vervis.Foundation import Vervis.Git (timeAgo') @@ -110,8 +109,14 @@ getRepoR user proj repo = do Entity _rid r <- getBy404 $ UniqueRepo repo pid return r path <- askRepoDir user proj repo - pairs <- liftIO $ withRepo (fromString path) $ \ git -> - loadCommitsTopsortList git $ unpack $ repoMainBranch repository + pairs <- liftIO $ withRepo (fromString path) $ \ git -> do + oid <- resolveName git $ unpack $ repoMainBranch repository + graph <- loadCommitGraphPT git [oid] + let mnodes = topsortUnmixOrder graph (NodeStack [noNodes graph]) + nodes = case mnodes of + Nothing -> error "commit graph contains a cycle" + Just ns -> ns + return $ D.toList $ fmap (nodeLabel graph) nodes now <- liftIO dateCurrent let toText = decodeUtf8With lenientDecode mkrow ref commit = diff --git a/src/Vervis/Ssh.hs b/src/Vervis/Ssh.hs index 0ee9366..094045e 100644 --- a/src/Vervis/Ssh.hs +++ b/src/Vervis/Ssh.hs @@ -13,6 +13,8 @@ - . -} +{-# LANGUAGE StandaloneDeriving #-} + module Vervis.Ssh ( runSsh ) @@ -41,17 +43,19 @@ import Vervis.Model import Vervis.Settings -- TODO: --- [x] Implement serious logging (info, warning, error, etc.) with --- monad-logger, maybe see how loggin works in the scaffolding -- [ ] See which git commands gitolite SSH supports and see if I can implement -- them with Hit (i think it was git upload-pack) +deriving instance MonadBaseControl ChannelT +deriving instance MonadLogger ChannelT + type ChannelBase = LoggingT (ReaderT ConnectionPool IO) type SessionBase = LoggingT (ReaderT ConnectionPool IO) +type UserAuthId = PersonId type Backend = SqlBackend -type Channel = ChannelT ChannelBase -type Session = SessionT SessionBase ChannelBase +type Channel = ChannelT UserAuthId ChannelBase +type Session = SessionT SessionBase UserAuthId ChannelBase type SshChanDB = ReaderT Backend Channel type SshSessDB = ReaderT Backend Session @@ -73,30 +77,31 @@ chanFail wantReply msg = do channelError $ unpack msg when wantReply channelFail -authorize :: Authorize -> Session Bool -authorize (Password _ _) = return False +authorize :: Authorize -> Session (AuthResult UserAuthId) +authorize (Password _ _) = return AuthFail authorize (PublicKey name key) = do - mkeys <- runSessDB $ do + mpk <- runSessDB $ do mp <- getBy $ UniquePersonLogin $ pack name case mp of Nothing -> return Nothing - Just (Entity pid _p) -> - fmap Just $ selectList [SshKeyPerson ==. pid] [] - case mkeys of + Just (Entity pid _p) -> do + ks <- selectList [SshKeyPerson ==. pid] [] + return $ Just (pid, ks) + case mpk of Nothing -> do $logInfoS src "Auth failed: Invalid user" - return False - Just keys -> do + return AuthFail + Just (pid, keys) -> do let eValue (Entity _ v) = v matches = (== key) . blobToKey . fromStrict . sshKeyContent . eValue case find matches keys of Nothing -> do $logInfoS src "Auth failed: No matching key found" - return False + return AuthFail Just match -> do $logInfoS src "Auth succeeded" - return True + return $ AuthSuccess pid data Action = UploadPack () deriving Show @@ -131,7 +136,7 @@ mkConfig :: AppSettings -> ConnectionPool -> LogFunc - -> IO (Config SessionBase ChannelBase) + -> IO (Config SessionBase ChannelBase UserAuthId) mkConfig settings pool logFunc = do keyPair <- keyPairFromFile $ appSshKeyFile settings return $ Config diff --git a/stack.yaml b/stack.yaml index a9c2189..6aaa413 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,7 +3,7 @@ # Specifies the GHC version and set of packages available (e.g., lts-3.5, # nightly-2015-09-21, ghc-7.10.2) -resolver: lts-5.5 +resolver: lts-5.11 # Local packages, usually specified by relative directory name packages: diff --git a/vervis.cabal b/vervis.cabal index 4b69393..6f709f0 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -34,17 +34,11 @@ flag library-only default: False library - exposed-modules: Data.Binary.Get.Local - Data.Binary.Put.Local + exposed-modules: Data.ByteString.Char8.Local Data.ByteString.Local Data.Char.Local - Data.Git.Local - Data.Graph.Inductive.Local Data.List.Local - Network.Git.Local - Network.Git.Local.Get - Network.Git.Local.Put Network.SSH.Local Vervis.Application Vervis.Field.Key