Initial report display works

Application.hs

@@ -23,9 +23,6 @@ instance PathPiece RippleAddress where
 	fromPathPiece = readMay . T.unpack
 	toPathPiece = T.pack . show
 
-instance ToField RippleAddress where
-	toField adr = toField (show adr)
-
 htmlEscape :: String -> String
 htmlEscape = concatMap escChar
 	where
@@ -43,7 +40,7 @@ on404 _ = string notFound404 [] "Not Found"
 
 reportFor :: Connection -> RippleAddress -> Application
 reportFor db adr req = do
-		assertions <- liftIO $ query db (fromString "SELECT `to`, `from`, `type`, `time`, `signed` FROM assertions WHERE `to` = ?") [adr]
+		assertions <- liftIO $ query db (fromString "SELECT `from`, `fromFingerprint`, `to`, `at`, `asserted`, `assertion` FROM assertions WHERE `to` = ?") [adr]
 		return $ responseTextBuilder ok200 headers (viewReport htmlEscape $ Report adr assertions)
 	where
 	Just headers = stringHeaders [("Content-Type", "text/html; charset=utf8")]

Records.hs

@@ -1,15 +1,87 @@
 module Records where
 
+import Control.Applicative ((<$>), (<*>))
+import Control.Error (readMay, hush, tryHead, noteT, EitherT(..), MaybeT(..), hoistMaybe, throwT)
 import Data.Base58Address (RippleAddress)
 import qualified Data.Text.Buildable as TL
 import qualified Data.Text.Format.Types as TL
+import Database.SQLite.Simple (query, field, FromRow(..), ToRow(..))
+import Database.SQLite.Simple.ToField (ToField(..))
+import Data.Time.Clock (UTCTime)
+import Data.Binary (Binary, decodeOrFail, encode)
+import Data.Time.Format (formatTime)
+import System.Locale (defaultTimeLocale)
+import qualified Data.ByteString.Lazy as LZ
+import qualified Data.OpenPGP as OpenPGP
+import qualified Data.OpenPGP.CryptoAPI as OpenPGP
 
-import Sqlite3
+import Assertion
 
 instance TL.Buildable RippleAddress where
-	build adr = TL.build (TL.Shown adr)
+	build = TL.build . TL.Shown
+
+instance TL.Buildable AssertionType where
+	build = TL.build . TL.Shown
+
+instance ToField RippleAddress where
+	toField adr = toField (show adr)
 
 data Report = Report {
 		address :: RippleAddress,
-		assertions :: [AssertionRow]
+		assertions :: [FormattedAssertionRow]
+	}
+	deriving (Show, Eq)
+
+data FormattedAssertionRow = FormattedAssertionRow {
+		at8601 :: String,
+		atHuman :: String,
+		keyId :: String,
+		row :: [AssertionRow]
+	}
+	deriving (Show, Eq)
+
+formatAssertionRow :: AssertionRow -> FormattedAssertionRow
+formatAssertionRow row = FormattedAssertionRow iso8601 human keyId [row]
+	where
+	keyId = reverse $ take 8 $ reverse $ fromFingerprint row
+	iso8601 = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" (at row)
+	human = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" (at row)
+
+data AssertionRow = AssertionRow {
+		from :: OpenPGP.Message,
+		fromFingerprint :: String,
+		to :: RippleAddress,
+		at :: UTCTime,
+		asserted :: AssertionType,
+		assertion :: OpenPGP.Message
 	}
+	deriving (Show, Eq)
+
+instance FromRow FormattedAssertionRow where
+	fromRow = fmap formatAssertionRow fromRow
+
+instance FromRow AssertionRow where
+	fromRow = AssertionRow <$> (field >>= decodeM) <*> field <*>
+			(field >>= readM) <*> field <*> (field >>= readM) <*>
+			(field >>= decodeM)
+
+instance ToRow AssertionRow where
+	toRow row = map ($row) [
+			toField . encode . from,
+			toField . fromFingerprint,
+			toField . to,
+			toField . at,
+			toField . show . asserted,
+			toField . encode . assertion
+		]
+
+decodeM :: (Binary a, Monad m) => LZ.ByteString -> m a
+decodeM bytes = case decodeOrFail bytes of
+	Left (_,_,e) -> fail e
+	Right (_,_,x) -> return x
+
+-- | Signal read errors in some Monad (for parsing)
+readM :: (Read r, Monad m) => String -> m r
+readM s = case readMay s of
+	Just x -> return x
+	Nothing -> fail $ s ++ " is invalid"

Sqlite3.hs

@@ -25,14 +25,6 @@ data AddressAndKey = AddressAndKey RippleAddress OpenPGP.Message
 instance FromRow AddressAndKey where
 	fromRow = AddressAndKey <$> (field >>= readM) <*> (field >>= decodeM)
 
-data AssertionRow = AssertionRow RippleAddress Assertion OpenPGP.Message
-	deriving (Show, Eq)
-
-instance FromRow AssertionRow where
-	fromRow  = AssertionRow <$> (field >>= readM)
-		<*> ((,,) <$> (field >>= readM) <*> (field >>= readM) <*> field)
-		<*> (field >>= decodeM)
-
 decodeM :: (Binary a, Monad m) => LZ.ByteString -> m a
 decodeM bytes = case decodeOrFail bytes of
 	Left (_,_,e) -> fail e

view/report.mustache

@@ -16,17 +16,39 @@
 				margin-top: 2em;
 			}
 
+			body > h1 {
+				overflow: hidden;
+			}
+
 			h1 * {
 				vertical-align: middle;
 			}
 
 			h1 img {
+				float: left;
 				padding-right: 5em;
 			}
+
+			.rippleAddress {
+				font-size: 0.5em;
+			}
 		</style>
 	</head>
 
 	<body>
-		<h1><img src="logo.png" alt="Ripple Union" /> Credit Report for {{address}}</h1>
+		<h1><img src="http://rippleunion.com/logo.png" alt="Ripple Union" /> Credit Report for <span class="rippleAddress">{{address}}</span></h1>
+
+		<ul>
+		{{#assertions}}
+			<li>
+				<time datetime="{{at8601}}">{{atHuman}}</time> —
+				<a href="http://singpolyma.net:11371/pks/lookup?op=vindex&search=0x{{#row}}{{fromFingerprint}}{{/row}}">{{keyId}}</a>
+				asserted that this address
+				{{#row}}
+					{{asserted}}
+				{{/row}}
+			</li>
+		{{/assertions}}
+		</ul>
 	</body>
 </html>