Permalink
Browse files

JSON and prettier

  • Loading branch information...
1 parent e237713 commit b8667539dd2761cb0d1bcdba40129e1f4433a7f7 @singpolyma committed Mar 23, 2013
Showing with 50 additions and 6 deletions.
  1. +16 −3 Application.hs
  2. +24 −1 Records.hs
  3. +10 −2 view/report.mustache
View
@@ -1,9 +1,13 @@
module Application where
+import Data.List (intercalate)
import Data.String (fromString)
+import Data.Maybe (fromMaybe)
+import Network.HTTP.Accept (selectAcceptType)
+import Network.Wai.Parse (parseRequestBody, parseHttpAccept)
import Network.Wai (Request(..), Response(..), Application)
import Network.HTTP.Types (ok200, notFound404, seeOther303, badRequest400, notAcceptable406, Status, ResponseHeaders)
-import Network.Wai.Util (string, stringHeaders)
+import Network.Wai.Util (string, stringHeaders, json)
import Web.PathPieces (PathPiece(..))
import Data.Base58Address (RippleAddress)
import Control.Error (readMay)
@@ -40,7 +44,16 @@ on404 _ = string notFound404 [] "Not Found"
reportFor :: Connection -> RippleAddress -> Application
reportFor db adr req = do
- 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)
+ assertions <- liftIO $ query db (fromString "SELECT `from`, `fromFingerprint`, `to`, `at`, `asserted`, `assertion` FROM assertions WHERE `to` = ?") [adr]
+ case acceptType of
+ "text/html" ->
+ return $ responseTextBuilder ok200 headers (viewReport htmlEscape $ Report adr assertions)
+ "application/json" ->
+ json ok200 [] (Report adr assertions)
+ _ -> string notAcceptable406 [] (intercalate "\n" supportedTypes)
where
Just headers = stringHeaders [("Content-Type", "text/html; charset=utf8")]
+ acceptType = fromMaybe (head supportedTypes) acceptType'
+ acceptType' = (selectAcceptType supportedTypes . parseHttpAccept) =<<
+ lookup (fromString "Accept") (requestHeaders req)
+ supportedTypes = ["text/html", "application/json"]
View
@@ -14,6 +14,9 @@ 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 qualified Data.Aeson as Aeson
+import qualified Data.Text as T
+import qualified Data.ByteString.Base64.Lazy as B64
import Assertion
@@ -32,17 +35,29 @@ data Report = Report {
}
deriving (Show, Eq)
+instance Aeson.ToJSON Report where
+ toJSON (Report adr asserts) = Aeson.object [
+ (Aeson..=) (T.pack "for") (T.pack $ show adr),
+ (Aeson..=) (T.pack "assertions") asserts
+ ]
+
data FormattedAssertionRow = FormattedAssertionRow {
at8601 :: String,
atHuman :: String,
keyId :: String,
+ signedAssertion :: String,
row :: [AssertionRow]
}
deriving (Show, Eq)
+instance Aeson.ToJSON FormattedAssertionRow where
+ toJSON = Aeson.toJSON . head . row
+
formatAssertionRow :: AssertionRow -> FormattedAssertionRow
-formatAssertionRow row = FormattedAssertionRow iso8601 human keyId [row]
+formatAssertionRow row =
+ FormattedAssertionRow iso8601 human keyId signed [row]
where
+ signed = map (toEnum.fromEnum) $ LZ.unpack $ B64.encode $ encode $ assertion row
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)
@@ -57,6 +72,14 @@ data AssertionRow = AssertionRow {
}
deriving (Show, Eq)
+instance Aeson.ToJSON AssertionRow where
+ toJSON (AssertionRow from _ _ at asserted assertion) = Aeson.object [
+ (Aeson..=) (T.pack "from") (B64.encode $ encode from),
+ (Aeson..=) (T.pack "at") at,
+ (Aeson..=) (T.pack "asserted") (show asserted),
+ (Aeson..=) (T.pack "signedAssertion") (B64.encode $ encode assertion)
+ ]
+
instance FromRow FormattedAssertionRow where
fromRow = fmap formatAssertionRow fromRow
View
@@ -1,6 +1,7 @@
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
+ <base href="http://rippleunion.com/" />
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Ripple Union Credit Report for {{address}}</title>
@@ -32,17 +33,24 @@
.rippleAddress {
font-size: 0.5em;
}
+
+ a[rel=enclosure] img {
+ position: relative;
+ top: 4px;
+ }
</style>
</head>
<body>
- <h1><img src="http://rippleunion.com/logo.png" alt="Ripple Union" /> Credit Report for <span class="rippleAddress">{{address}}</span></h1>
+ <h1><img src="/logo.png" alt="Ripple Union" /> Credit Report for <span class="rippleAddress">{{address}}</span></h1>
<ul>
{{#assertions}}
<li>
+ <a href="data:application/pgp-encrypted;base64,{{signedAssertion}}" rel="enclosure"><img src="http://www.famfamfam.com/lab/icons/mini/icons/arrow_down.gif" alt="download signed assertion" title="download signed assertion" /></a>
+
<time datetime="{{at8601}}">{{atHuman}}</time> —
- <a href="http://singpolyma.net:11371/pks/lookup?op=vindex&search=0x{{#row}}{{fromFingerprint}}{{/row}}">{{keyId}}</a>
+ <a href="http://singpolyma.net:11371/pks/lookup?op=vindex&amp;search=0x{{#row}}{{fromFingerprint}}{{/row}}">{{keyId}}</a>
asserted that this address
{{#row}}
{{asserted}}

0 comments on commit b866753

Please sign in to comment.