Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Initial report display works

  • Loading branch information...
commit e2377132dc15f8b268dacd45bd6093d412e9e7ae 1 parent 699f97f
Stephen Paul Weber authored
Showing with 99 additions and 16 deletions.
  1. +1 −4 Application.hs
  2. +75 −3 Records.hs
  3. +0 −8 Sqlite3.hs
  4. +23 −1 view/report.mustache
5 Application.hs
View
@@ -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")]
78 Records.hs
View
@@ -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"
8 Sqlite3.hs
View
@@ -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
24 view/report.mustache
View
@@ -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>
Please sign in to comment.
Something went wrong with that request. Please try again.