1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
{- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE DeriveGeneric #-}
-- | Gpg web of trust checking, using wotsap's JSON output
module Gpg.Wot where
import Gpg
import JSON
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Data.List
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
data WotStats = WotStats
{ key :: Node
, cross_sigs :: [Node]
, key_signed :: [Node]
, other_sigs :: [Node]
}
deriving (Show, Generic)
data WotPath = WotPath
{ from :: Node
, to :: Node
, xpaths :: [[Node]]
}
deriving (Show, Generic)
data Node = Node
{ kid :: String
, msd :: Double
, rank :: Integer
, uid :: String
}
deriving (Show, Generic)
-- | wotsap's json has some upper-case fields; lowercase field for parsing
jsonLower :: Value -> Value
jsonLower (Object o) = Object . M.fromList . map lowerPair . M.toList $ o
where
lowerPair (k, v) = (T.toLower k, v)
jsonLower x = x
instance FromJSON WotStats where
parseJSON = genericParseJSON defaultOptions . jsonLower
instance FromJSON WotPath where
parseJSON = genericParseJSON defaultOptions . jsonLower
instance FromJSON Node where
parseJSON = genericParseJSON defaultOptions . jsonLower
wotServer :: String
wotServer = "https://pgp.cs.uu.nl/"
downloadWotStats :: GpgKeyId -> IO (Maybe WotStats)
downloadWotStats (GpgKeyId k) = do
manager <- getGlobalManager
request <- parseRequest url
response <- httpLbs request manager
return $ decode (responseBody response)
where
url = wotServer ++ "/stats/" ++ k ++ ".json"
downloadWotPath :: GpgKeyId -> GpgKeyId -> IO (Maybe WotPath)
downloadWotPath (GpgKeyId fromid) (GpgKeyId toid) = do
manager <- getGlobalManager
request <- parseRequest url
response <- httpLbs request manager
return $ decode (responseBody response)
where
url = wotServer ++ "/paths/" ++ fromid ++ "/to/" ++ toid ++ ".json"
-- | A key that is known to be in the strong set.
--
-- This could be any key in the gpg strong set. Currently, it's
-- Joey Hess's key, which is in the strong set and belongs to the author of
-- this program, which the user must implicitly trust since they're running
-- it. But any key in the strong set would work as well; this is only used
-- to determine if other keys have a path into the strong set.
knownKeyInStrongSet :: GpgKeyId
knownKeyInStrongSet = GpgKeyId "E85A5F63B31D24C1EBF0D81CC910D9222512E3C7"
newtype StrongSetAnalysis = StrongSetAnalysis Bool
deriving (Show)
isInStrongSet :: GpgKeyId -> IO StrongSetAnalysis
isInStrongSet k = maybe (StrongSetAnalysis False) (const $ StrongSetAnalysis True)
<$> downloadWotPath k knownKeyInStrongSet
describeWot :: Maybe WotStats -> StrongSetAnalysis -> [String]
describeWot (Just ws) (StrongSetAnalysis ss)
| ss == False = [theirname ++ "'s identity cannot be verified!"]
| otherwise =
[ theirname ++ "'s identity has been verified by as many as "
++ show (length sigs) ++ " people, including:"
, intercalate ", " $ take 10 $ nub $
map (stripEmail . uid) bestconnectedsigs
, ""
, theirname ++ " is probably a real person."
]
where
theirname = wotStatName ws
sigs = cross_sigs ws ++ other_sigs ws
bestconnectedsigs = sortOn rank sigs
describeWot Nothing _ =
[ ""
, "Their identity cannot be verified!"
]
wotStatName :: WotStats -> String
wotStatName ws = stripEmail (uid (key ws))
stripEmail :: String -> String
stripEmail = unwords . takeWhile (not . ("<" `isPrefixOf`)) . words
|
