{- 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 = stripEmail (uid (key ws))
	sigs = cross_sigs ws ++ other_sigs ws
	bestconnectedsigs = sortOn rank sigs
describeWot Nothing _ =
	[ ""
	, "Their identity cannot be verified!"
	]

stripEmail :: String -> String
stripEmail = unwords . takeWhile (not . ("<" `isPrefixOf`)) . words