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
123
124
125
126
127
128
129
130
131
132
133
|
{- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
{-# 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.Text as T
#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.KeyMap as AM
import qualified Data.Aeson.Key as AK
#else
import qualified Data.HashMap.Strict as M
#endif
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
#if MIN_VERSION_aeson(2, 0, 0)
jsonLower (Object o) = Object . AM.mapKeyVal lowerKey id $ o
where lowerKey = AK.fromText . T.toLower . AK.toText
#else
jsonLower (Object o) = Object . M.fromList . map lowerPair . M.toList $ o
where
lowerPair (k, v) = (T.toLower k, v)
#endif
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
|
