diff --git a/cabal.project b/cabal.project index c9f7daf5a0..b1c4c70161 100644 --- a/cabal.project +++ b/cabal.project @@ -42,13 +42,14 @@ packages: , tools/api-simulations/ , tools/db/assets/ , tools/db/auto-whitelist/ - , tools/db/migrate-sso-feature-flag/ - , tools/db/service-backfill/ , tools/db/billing-team-member-backfill/ , tools/db/find-undead/ + , tools/db/inconsistencies/ + , tools/db/migrate-sso-feature-flag/ , tools/db/move-team/ , tools/db/repair-handles/ - , tools/db/inconsistencies/ + , tools/db/service-backfill/ + , tools/fedcalls/ , tools/rex/ , tools/stern/ diff --git a/changelog.d/4-docs/pr-2973 b/changelog.d/4-docs/pr-2973 new file mode 100644 index 0000000000..89fbeb8be6 --- /dev/null +++ b/changelog.d/4-docs/pr-2973 @@ -0,0 +1 @@ +Tool for dumping fed call graphs (dot/graphviz and csv); see README for details \ No newline at end of file diff --git a/nix/local-haskell-packages.nix b/nix/local-haskell-packages.nix index 387f117aa1..aea935c787 100644 --- a/nix/local-haskell-packages.nix +++ b/nix/local-haskell-packages.nix @@ -51,6 +51,7 @@ move-team = hself.callPackage ../tools/db/move-team/default.nix { inherit gitignoreSource; }; repair-handles = hself.callPackage ../tools/db/repair-handles/default.nix { inherit gitignoreSource; }; service-backfill = hself.callPackage ../tools/db/service-backfill/default.nix { inherit gitignoreSource; }; + fedcalls = hself.callPackage ../tools/fedcalls/default.nix { inherit gitignoreSource; }; rex = hself.callPackage ../tools/rex/default.nix { inherit gitignoreSource; }; stern = hself.callPackage ../tools/stern/default.nix { inherit gitignoreSource; }; } diff --git a/tools/fedcalls/.ormolu b/tools/fedcalls/.ormolu new file mode 120000 index 0000000000..157b212d7c --- /dev/null +++ b/tools/fedcalls/.ormolu @@ -0,0 +1 @@ +../../.ormolu \ No newline at end of file diff --git a/tools/fedcalls/README.md b/tools/fedcalls/README.md new file mode 100644 index 0000000000..e43f95e14a --- /dev/null +++ b/tools/fedcalls/README.md @@ -0,0 +1,31 @@ +our swaggger docs contain information about which end-points call +which federation end-points internally. this command line tool +extracts that information from the swagger json and converts it into +two files: dot (for feeding into graphviz), and csv. + +### try it out + +``` +cabal run fedcalls +ls wire-fedcalls.* # these names are hard-coded (sorry!) +dot -Tpng wire-fedcalls.dot > wire-fedcalls.png +``` + +`dot` layouts only work for small data sets (at least without tweaking). for a better one paste into [sketchvis](https://sketchviz.com/new). + +### links + +- `./example.png` +- https://sketchviz.com/new +- https://graphviz.org/doc/info/lang.html +- `/libs/wire-api/src/Wire/API/MakesFederatedCall.hs` + +### swagger-ui + +you can get the same data for the public API in the swagger-ui output. just load the page, open your javascript console, and type: + +``` +window.ui.getConfigs().showExtensions = true +``` + +then drop down on things like normal, and you'll see federated calls. diff --git a/tools/fedcalls/default.nix b/tools/fedcalls/default.nix new file mode 100644 index 0000000000..1fa52660c6 --- /dev/null +++ b/tools/fedcalls/default.nix @@ -0,0 +1,38 @@ +# WARNING: GENERATED FILE, DO NOT EDIT. +# This file is generated by running hack/bin/generate-local-nix-packages.sh and +# must be regenerated whenever local packages are added or removed, or +# dependencies are added or removed. +{ mkDerivation +, aeson +, base +, containers +, gitignoreSource +, imports +, insert-ordered-containers +, language-dot +, lib +, swagger2 +, text +, wire-api +}: +mkDerivation { + pname = "fedcalls"; + version = "1.0.0"; + src = gitignoreSource ./.; + isLibrary = false; + isExecutable = true; + executableHaskellDepends = [ + aeson + base + containers + imports + insert-ordered-containers + language-dot + swagger2 + text + wire-api + ]; + description = "Generate a dot file from swagger docs representing calls to federated instances"; + license = lib.licenses.agpl3Only; + mainProgram = "fedcalls"; +} diff --git a/tools/fedcalls/example.png b/tools/fedcalls/example.png new file mode 100644 index 0000000000..26bc63134f Binary files /dev/null and b/tools/fedcalls/example.png differ diff --git a/tools/fedcalls/fedcalls.cabal b/tools/fedcalls/fedcalls.cabal new file mode 100644 index 0000000000..2e42d6f9bb --- /dev/null +++ b/tools/fedcalls/fedcalls.cabal @@ -0,0 +1,74 @@ +cabal-version: 1.12 +name: fedcalls +version: 1.0.0 +synopsis: + Generate a dot file from swagger docs representing calls to federated instances. + +category: Network +author: Wire Swiss GmbH +maintainer: Wire Swiss GmbH +copyright: (c) 2020 Wire Swiss GmbH +license: AGPL-3 +build-type: Simple + +executable fedcalls + main-is: Main.hs + hs-source-dirs: src + default-extensions: + NoImplicitPrelude + AllowAmbiguousTypes + BangPatterns + ConstraintKinds + DataKinds + DefaultSignatures + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingStrategies + DerivingVia + EmptyCase + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + OverloadedStrings + PackageImports + PatternSynonyms + PolyKinds + QuasiQuotes + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + TypeFamilyDependencies + TypeOperators + UndecidableInstances + ViewPatterns + + ghc-options: + -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path + -funbox-strict-fields -threaded -with-rtsopts=-N -with-rtsopts=-T + -rtsopts + + build-depends: + aeson + , base + , containers + , imports + , insert-ordered-containers + , language-dot + , swagger2 + , text + , wire-api + + default-language: Haskell2010 diff --git a/tools/fedcalls/src/Main.hs b/tools/fedcalls/src/Main.hs new file mode 100644 index 0000000000..7a717e75ef --- /dev/null +++ b/tools/fedcalls/src/Main.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, 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 Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Main + ( main, + ) +where + +import Control.Exception (assert) +import Data.Aeson as A +import qualified Data.Aeson.Types as A +import qualified Data.HashMap.Strict.InsOrd as HM +import qualified Data.Map as M +import Data.Swagger + ( PathItem, + Swagger, + _operationExtensions, + _pathItemDelete, + _pathItemGet, + _pathItemHead, + _pathItemOptions, + _pathItemPatch, + _pathItemPost, + _pathItemPut, + _swaggerPaths, + ) +import Imports +import Language.Dot as D +import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes +import qualified Wire.API.Routes.Public.Brig as BrigRoutes +import qualified Wire.API.Routes.Public.Cannon as CannonRoutes +import qualified Wire.API.Routes.Public.Cargohold as CargoholdRoutes +import qualified Wire.API.Routes.Public.Galley as GalleyRoutes +import qualified Wire.API.Routes.Public.Gundeck as GundeckRoutes +import qualified Wire.API.Routes.Public.Proxy as ProxyRoutes +-- import qualified Wire.API.Routes.Internal.Cannon as CannonIRoutes +-- import qualified Wire.API.Routes.Internal.Cargohold as CargoholdIRoutes +-- import qualified Wire.API.Routes.Internal.LegalHold as LegalHoldIRoutes +import qualified Wire.API.Routes.Public.Spar as SparRoutes + +------------------------------ + +main :: IO () +main = do + writeFile "wire-fedcalls.dot" . D.renderDot . mkDotGraph $ calls + writeFile "wire-fedcalls.csv" . toCsv $ calls + +calls :: [MakesCallTo] +calls = assert (calls' == nub calls') calls' + where + calls' = mconcat $ parse <$> swaggers + +swaggers :: [Swagger] +swaggers = + [ -- TODO: introduce allSwaggerDocs in wire-api that collects these for all + -- services, use that in /services/brig/src/Brig/API/Public.hs instead of + -- doing it by hand. + + BrigRoutes.brigSwagger, -- TODO: s/brigSwagger/swaggerDoc/ like everybody else! + CannonRoutes.swaggerDoc, + CargoholdRoutes.swaggerDoc, + GalleyRoutes.swaggerDoc, + GundeckRoutes.swaggerDoc, + ProxyRoutes.swaggerDoc, + SparRoutes.swaggerDoc, + -- TODO: collect all internal apis somewhere else (brig?), and expose them + -- via an internal swagger api end-point. + + BrigIRoutes.swaggerDoc + -- CannonIRoutes.swaggerDoc, + -- CargoholdIRoutes.swaggerDoc, + -- LegalHoldIRoutes.swaggerDoc + ] + +------------------------------ + +data MakesCallTo = MakesCallTo + { -- who is calling? + sourcePath :: String, + sourceMethod :: String, + -- where does the call go? + targetComp :: String, + targetName :: String + } + deriving (Eq, Show) + +------------------------------ + +parse :: Swagger -> [MakesCallTo] +parse = + mconcat + . fmap parseOperationExtensions + . mconcat + . fmap flattenPathItems + . HM.toList + . _swaggerPaths + +-- | extract path, method, and operation extensions +flattenPathItems :: (FilePath, PathItem) -> [((FilePath, String), HM.InsOrdHashMap Text Value)] +flattenPathItems (path, item) = + filter ((/= mempty) . snd) $ + catMaybes + [ ((path, "get"),) . _operationExtensions <$> _pathItemGet item, + ((path, "put"),) . _operationExtensions <$> _pathItemPut item, + ((path, "post"),) . _operationExtensions <$> _pathItemPost item, + ((path, "delete"),) . _operationExtensions <$> _pathItemDelete item, + ((path, "options"),) . _operationExtensions <$> _pathItemOptions item, + ((path, "head"),) . _operationExtensions <$> _pathItemHead item, + ((path, "patch"),) . _operationExtensions <$> _pathItemPatch item + ] + +parseOperationExtensions :: ((FilePath, String), HM.InsOrdHashMap Text Value) -> [MakesCallTo] +parseOperationExtensions ((path, method), hm) = uncurry (MakesCallTo path method) <$> findCallsFedInfo hm + +findCallsFedInfo :: HM.InsOrdHashMap Text Value -> [(String, String)] +findCallsFedInfo hm = case A.parse parseJSON <$> HM.lookup "wire-makes-federated-call-to" hm of + Just (A.Success (fedcalls :: [(String, String)])) -> fedcalls + Just bad -> error $ "invalid extension `wire-makes-federated-call-to`: expected `[(comp, name), ...]`, got " <> show bad + Nothing -> [] + +------------------------------ + +-- | (this function can be simplified by tossing the serial numbers for nodes, but they might +-- be useful for fine-tuning the output or rendering later.) +-- +-- the layout isn't very useful on realistic data sets. maybe we can tweak it with +-- [layers](https://www.graphviz.org/docs/attr-types/layerRange/)? +mkDotGraph :: [MakesCallTo] -> D.Graph +mkDotGraph inbound = Graph StrictGraph DirectedGraph Nothing (mods <> nodes <> edges) + where + mods = + [ AttributeStatement GraphAttributeStatement [AttributeSetValue (NameId "rankdir") (NameId "LR")], + AttributeStatement NodeAttributeStatement [AttributeSetValue (NameId "shape") (NameId "rectangle")], + AttributeStatement EdgeAttributeStatement [AttributeSetValue (NameId "style") (NameId "dashed")] + ] + nodes = + [ SubgraphStatement (NewSubgraph Nothing (mkCallingNode <$> M.toList callingNodes)), + SubgraphStatement (NewSubgraph Nothing (mkCalledNode <$> M.toList calledNodes)) + ] + edges = mkEdge <$> inbound + + itemSourceNode :: MakesCallTo -> String + itemSourceNode (MakesCallTo path method _ _) = method <> " " <> path + + itemTargetNode :: MakesCallTo -> String + itemTargetNode (MakesCallTo _ _ comp name) = "[" <> comp <> "]:" <> name + + callingNodes :: Map String Integer + callingNodes = + foldl + (\mp (i, caller) -> M.insert caller i mp) + mempty + ((zip [0 ..] . nub $ itemSourceNode <$> inbound) :: [(Integer, String)]) + + calledNodes :: Map String Integer + calledNodes = + foldl + (\mp (i, called) -> M.insert called i mp) + mempty + ((zip [(fromIntegral $ M.size callingNodes) ..] . nub $ itemTargetNode <$> inbound) :: [(Integer, String)]) + + mkCallingNode :: (String, Integer) -> Statement + mkCallingNode n = + NodeStatement (mkCallingNodeId n) [] + + mkCallingNodeId :: (String, Integer) -> NodeId + mkCallingNodeId (caller, i) = + NodeId (NameId . show $ show i <> ": " <> caller) (Just (PortC CompassW)) + + mkCalledNode :: (String, Integer) -> Statement + mkCalledNode n = + NodeStatement (mkCalledNodeId n) [] + + mkCalledNodeId :: (String, Integer) -> NodeId + mkCalledNodeId (callee, i) = + NodeId (NameId . show $ show i <> ": " <> callee) (Just (PortC CompassE)) + + mkEdge :: MakesCallTo -> Statement + mkEdge item = + EdgeStatement + [ ENodeId NoEdge (mkCallingNodeId (caller, callerId)), + ENodeId DirectedEdge (mkCalledNodeId (callee, calleeId)) + ] + [] + where + caller = itemSourceNode item + callee = itemTargetNode item + callerId = fromMaybe (error "impossible") $ M.lookup caller callingNodes + calleeId = fromMaybe (error "impossible") $ M.lookup callee calledNodes + +------------------------------ + +toCsv :: [MakesCallTo] -> String +toCsv = + intercalate "\n" + . fmap (intercalate ",") + . addhdr + . fmap dolines + where + addhdr :: [[String]] -> [[String]] + addhdr = (["source method", "source path", "target component", "target name"] :) + + dolines :: MakesCallTo -> [String] + dolines (MakesCallTo spath smeth tcomp tname) = [smeth, spath, tcomp, tname]