module Net.Beacon
( Timestamp
, Record()
, version
, frequency
, timeStamp
, seedValue
, previousOutputValue
, signatureValue
, outputValue
, statusCode
, getLastRecord
, getCurrentRecord
, getPreviousRecord
, getNextRecord
, getStartChainRecord
) where
import Control.Monad
import Text.XML.Light.Input
import Text.XML.Light.Proc
import Text.XML.Light.Types
import qualified Data.ByteString.Lazy as B
import Network.HTTP.Conduit (simpleHttp)
import Numeric
data Record =
Record
{
version :: String
, frequency :: Int
, timeStamp :: Int
, seedValue :: B.ByteString
, previousOutputValue :: B.ByteString
, signatureValue :: B.ByteString
, outputValue :: B.ByteString
, statusCode :: Int
} deriving (Show, Eq)
type Timestamp = Int
getLastRecord :: IO (Maybe Record)
getLastRecord = do
x <- simpleHttp "https://beacon.nist.gov/rest/record/last"
return $ getRecord x
getCurrentRecord :: Timestamp -> IO (Maybe Record)
getCurrentRecord ts = do
x <- simpleHttp $ "http://beacon.nist.gov/rest/record/" ++ (show ts)
return $ getRecord x
getPreviousRecord :: Timestamp -> IO (Maybe Record)
getPreviousRecord ts = do
x <- simpleHttp $ "https://beacon.nist.gov/rest/record/previous/" ++ (show ts)
return $ getRecord x
getNextRecord :: Timestamp -> IO (Maybe Record)
getNextRecord ts = do
x <- simpleHttp $ "https://beacon.nist.gov/rest/record/next/" ++ (show ts)
return $ getRecord x
getStartChainRecord :: Timestamp -> IO (Maybe Record)
getStartChainRecord ts = do
x <- simpleHttp $ "https://beacon.nist.gov/rest/record/start-chain/" ++ (show ts)
return $ getRecord x
getRecord :: B.ByteString -> Maybe Record
getRecord stuff = do
xml <- parseXMLDoc stuff
let fc = findChild' xml
Record
<$> fc "version"
<*> (read <$> fc "frequency")
<*> (read <$> fc "timeStamp")
<*> (hexToBS <$> fc "seedValue")
<*> (hexToBS <$> fc "previousOutputValue")
<*> (hexToBS <$> fc "signatureValue")
<*> (hexToBS <$> fc "outputValue")
<*> (read <$> fc "statusCode")
where
findChild' xml name = strContent <$> filterChildName ((name ==) . qName) xml
hexToBS :: String -> B.ByteString
hexToBS = B.pack . go
where go (a:b:xs) =
let parses = readHex [a,b]
in case parses of
[(val,"")] -> val:(go xs)
_ -> error "parse error in hexToBS"
go [] = []
go _ = error "odd length input to hexToBS"