starting message type generation from ccnx.dtd

GenMsg.hs

@@ -0,0 +1,20 @@
+-- Generates message types and parsing and printing functions from ccnx.dtd.
+module Main where
+
+import Text.XML.HaXml
+
+main :: IO ()
+main = readFile "ccnx.dtd" >>= gen . dtdParse "ccnx.dtd"
+
+gen :: Maybe DocTypeDecl -> IO ()
+gen Nothing = error "ccnx.dtd didn't parse"
+gen (Just (DTD _ _ decls)) = putStrLn $ unlines [ code name spec | Element (ElementDecl name spec) <- decls ]
+
+code :: String -> ContentSpec -> String
+code name spec = name ++ "  " ++ case spec of
+  EMPTY -> "EMPTY"
+  ANY   -> "ANY"
+  Mixed PCDATA -> "PCDATA"
+  Mixed (PCDATAplus names) -> "PCDATA " ++ show names
+  ContentSpec a -> show a
+

Makefile

@@ -0,0 +1,11 @@
+.PHONY: all
+all: Network/CCNx/Messages.hs Network/CCNx/CCNb.hs
+
+Network/CCNx/Messages.hs Network/CCNx/CCNb.hs: GenMsg.hs
+	runhaskell -W GenMsg.hs
+
+.PHONY: clean
+clean:
+	-#rm Network/CCNx/CCNb.hs
+	-#rm Network/CCNx/Messages.hs
+

Network/CCNx.hs

@@ -1,6 +1,14 @@
+-- | Content centric networking (CCN) is a network paradigm that
+--   places the emphasis on data (content), not host connections.
+--
+--   This library implements the CCNx protocol developed by Parc:
+--
+--   <http://www.ccnx.org/>
 module Network.CCNx
-  ( module Network.CCNx.Messages
+  ( module Network.CCNx.CCNb
+  , module Network.CCNx.Messages
   ) where
 
+import Network.CCNx.CCNb
 import Network.CCNx.Messages
 

Network/CCNx/BinaryXML.hs

@@ -114,5 +114,4 @@ parseHeader a = ((tt, n), b)
   n = f (fromIntegral $ shiftR a2 3 .&. 0xF) 4 $ reverse a1
   f n _ [] = n
   f n s (a : b) = f (n .|. shiftL (fromIntegral a) s) (s + 7) b
-  --header = "header: " ++ concat [ printf "%02x" a | a <- take (length a - length b) a ] ++ ": " ++ show tt ++ "  " ++ show n
 

Network/CCNx/CCNb.hs

@@ -0,0 +1,227 @@
+-- | Parsing and printing the CCNx binary format (ccnb).
+module Network.CCNx.CCNb
+  ( parseCCNb
+  , printCCNb
+  ) where
+
+import Data.ByteString (ByteString)
+
+import Network.CCNx.BinaryXML
+import Network.CCNx.Messages
+
+-- | Parse a ccnb message.
+parseCCNb :: ByteString -> Message
+parseCCNb = parseMessage . parseBinaryXML
+
+parseMessage :: Block -> Message
+parseMessage a = case a of
+  DTAG i _ | tag i == Interest' -> InterestMessage $ Interest [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+  a -> error $ "unexpected block: " ++ show a
+
+-- | Print a ccnb message.
+printCCNb :: Message -> ByteString
+printCCNb a = printBinaryXML $ case a of
+  ContentObjectMessage a -> printContentObject a
+  InterestMessage      a -> printInterest      a
+
+printContentObject (ContentObject sig name signed content) =
+ DTAG (tagCode ContentObject') [printSignature sig, printName name, printSignedInfo signed, printContent content]
+
+data Tag
+  = Any'
+  | Name'
+  | Component'
+  | Certificate'
+  | Collection'
+  | CompleteName'
+  | Content'
+  | SignedInfo'
+  | ContentDigest'
+  | ContentHash'
+  | Count'
+  | Header'
+  | Interest'
+  | Key'
+  | KeyLocator'
+  | KeyName'
+  | Length'
+  | Link'
+  | LinkAuthenticator'
+  | NameComponentCount'
+  | RootDigest'
+  | Signature'
+  | Start'
+  | Timestamp'
+  | Type'
+  | Nonce'
+  | Scope'
+  | Exclude'
+  | Bloom'
+  | BloomSeed'
+  | AnswerOriginKind'
+  | Witness'
+  | SignatureBits'
+  | DigestAlgorithm'
+  | BlockSize'
+  | FreshnessSeconds'
+  | FinalBlockID'
+  | PublisherPublicKeyDigest'
+  | PublisherCertificateDigest'
+  | PublisherIssuerKeyDigest'
+  | PublisherIssuerCertificateDigest'
+  | ContentObject'
+  | WrappedKey'
+  | WrappingKeyIdentifier'
+  | WrapAlgorithm'
+  | KeyAlgorithm'
+  | Label'
+  | EncryptedKey'
+  | EncryptedNonceKey'
+  | WrappingKeyName'
+  | Action'
+  | FaceID'
+  | IPProto'
+  | Host'
+  | Port'
+  | MulticastInterface'
+  | ForwardingFlags'
+  | FaceInstance'
+  | ForwardingEntry'
+  | MulticastTTL'
+  | MinSuffixComponents'
+  | MaxSuffixComponents'
+  | ChildSelector'
+  | RepositoryInfo'
+  | Version'
+  | RepositoryVersion'
+  | GlobalPrefix'
+  | LocalName'
+  | Policy'
+  | Namespace'
+  | GlobalPrefixName'
+  | PolicyVersion'
+  | KeyValueSet'
+  | KeyValuePair'
+  | IntegerValue'
+  | DecimalValue'
+  | StringValue'
+  | BinaryValue'
+  | NameValue'
+  | Entry'
+  | ACL'
+  | ParameterizedName'
+  | Prefix'
+  | Suffix'
+  | Root'
+  | ProfileName'
+  | Parameters'
+  | CCNProtocolDataUnit'
+  deriving (Show, Eq)
+
+tagCodes :: [(Int, Tag)]
+tagCodes =
+  [ (13       , Any'                               )
+  , (14       , Name'                              )
+  , (15       , Component'                         )
+  , (16       , Certificate'                       )
+  , (17       , Collection'                        )
+  , (18       , CompleteName'                      )
+  , (19       , Content'                           )
+  , (20       , SignedInfo'                        )
+  , (21       , ContentDigest'                     )
+  , (22       , ContentHash'                       )
+  , (24       , Count'                             )
+  , (25       , Header'                            )
+  , (26       , Interest'                          )
+  , (27       , Key'                               )
+  , (28       , KeyLocator'                        )
+  , (29       , KeyName'                           )
+  , (30       , Length'                            )
+  , (31       , Link'                              )
+  , (32       , LinkAuthenticator'                 )
+  , (33       , NameComponentCount'                )
+  , (36       , RootDigest'                        )
+  , (37       , Signature'                         )
+  , (38       , Start'                             )
+  , (39       , Timestamp'                         )
+  , (40       , Type'                              )
+  , (41       , Nonce'                             )
+  , (42       , Scope'                             )
+  , (43       , Exclude'                           )
+  , (44       , Bloom'                             )
+  , (45       , BloomSeed'                         )
+  , (47       , AnswerOriginKind'                  )
+  , (53       , Witness'                           )
+  , (54       , SignatureBits'                     )
+  , (55       , DigestAlgorithm'                   )
+  , (56       , BlockSize'                         )
+  , (58       , FreshnessSeconds'                  )
+  , (59       , FinalBlockID'                      )
+  , (60       , PublisherPublicKeyDigest'          )
+  , (61       , PublisherCertificateDigest'        )
+  , (62       , PublisherIssuerKeyDigest'          )
+  , (63       , PublisherIssuerCertificateDigest'  )
+  , (64       , ContentObject'                     )
+  , (65       , WrappedKey'                        )
+  , (66       , WrappingKeyIdentifier'             )
+  , (67       , WrapAlgorithm'                     )
+  , (68       , KeyAlgorithm'                      )
+  , (69       , Label'                             )
+  , (70       , EncryptedKey'                      )
+  , (71       , EncryptedNonceKey'                 )
+  , (72       , WrappingKeyName'                   )
+  , (73       , Action'                            )
+  , (74       , FaceID'                            )
+  , (75       , IPProto'                           )
+  , (76       , Host'                              )
+  , (77       , Port'                              )
+  , (78       , MulticastInterface'                )
+  , (79       , ForwardingFlags'                   )
+  , (80       , FaceInstance'                      )
+  , (81       , ForwardingEntry'                   )
+  , (82       , MulticastTTL'                      )
+  , (83       , MinSuffixComponents'               )
+  , (84       , MaxSuffixComponents'               )
+  , (85       , ChildSelector'                     )
+  , (86       , RepositoryInfo'                    )
+  , (87       , Version'                           )
+  , (88       , RepositoryVersion'                 )
+  , (89       , GlobalPrefix'                      )
+  , (90       , LocalName'                         )
+  , (91       , Policy'                            )
+  , (92       , Namespace'                         )
+  , (93       , GlobalPrefixName'                  )
+  , (94       , PolicyVersion'                     )
+  , (95       , KeyValueSet'                       )
+  , (96       , KeyValuePair'                      )
+  , (97       , IntegerValue'                      )
+  , (98       , DecimalValue'                      )
+  , (99       , StringValue'                       )
+  , (100      , BinaryValue'                       )
+  , (101      , NameValue'                         )
+  , (102      , Entry'                             )
+  , (103      , ACL'                               )
+  , (104      , ParameterizedName'                 )
+  , (105      , Prefix'                            )
+  , (106      , Suffix'                            )
+  , (107      , Root'                              )
+  , (108      , ProfileName'                       )
+  , (109      , Parameters'                        )
+  , (17702112 , CCNProtocolDataUnit'               )
+  ]
+
+-- Tag from tag code.
+tag :: Int -> Tag
+tag a = case lookup a tagCodes of
+  Nothing -> error $ "unkown tag code: " ++ show a
+  Just t  -> t
+
+-- Code from tag.
+tagCode :: Tag -> Int
+tagCode a = case lookup a table of
+  Nothing -> error $ "unkown tag: " ++ show a
+  Just c  -> c
+  where
+  (a, b) = unzip tagCodes
+  table = zip b a
+

Network/CCNx/Messages.hs

@@ -33,12 +33,14 @@ import Data.ByteString (ByteString)
 data Message
   = ContentObjectMessage  ContentObject
   | InterestMessage Interest
+  deriving Show
 
 data ContentObject = ContentObject
   Signature
   Name
   SignedInfo
   Content
+  deriving Show
 
 type Content = ByteString
 
@@ -55,6 +57,7 @@ data SignedInfo = SignedInfo
   (Maybe FreshnessSeconds)
   (Maybe FinalBlockID)
   (Maybe KeyLocator)
+  deriving Show
 
 data Interest = Interest
   Name
@@ -66,12 +69,13 @@ data Interest = Interest
   (Maybe AnswerOriginKind)
   (Maybe Scope)
   (Maybe Nonce)
+  deriving Show
 
 type PublisherPublicKeyDigest = String
 
-data Exclude = Exclude (Maybe AnyBloom) [(Component, Maybe AnyBloom)]   
+data Exclude = Exclude (Maybe AnyBloom) [(Component, Maybe AnyBloom)]   deriving Show
 
-data AnyBloom = Any | Bloom String
+data AnyBloom = Any | Bloom String deriving Show
 
 type ChildSelector = Int
 type AnswerOriginKind = Int
@@ -86,17 +90,19 @@ type Timestamp = Int
 type FreshnessSeconds = Int
 type FinalBlockID = String
 
-data Type = DATA | ENCR | GONE | KEY | LINK | NACK
+data Type = DATA | ENCR | GONE | KEY | LINK | NACK deriving Show
 
 data KeyLocator
   = Key String
   | Certificate String
   | KeyName Name (Maybe PublisherID)
+  deriving Show
 
 data Signature = Signature
   (Maybe DigestAlgorithm)
   (Maybe Witness)
   SignatureBits
+  deriving Show
 
 type DigestAlgorithm = String
 type Witness = String
@@ -107,4 +113,5 @@ data PublisherID
   | PublisherCertificateDigest String
   | PublisherIssuerKeyDigest String
   | PublisherIssuerCertificateDigest String
+  deriving Show
 

ccnx.cabal

@@ -27,6 +27,7 @@ library
     exposed-modules:
         Network.CCNx
         Network.CCNx.BinaryXML
+        Network.CCNx.CCNb
         Network.CCNx.Messages
 
     extensions: