1-- |
2-- Module      : Data.ASN1.Pretty
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8module Data.ASN1.Pretty
9    ( pretty
10    , PrettyType(..)
11    ) where
12
13import           Data.ASN1.Types
14import           Data.ASN1.BitArray
15import           Data.ByteArray.Encoding (convertToBase, Base(..))
16import           Data.ByteString (ByteString)
17import           Numeric (showHex)
18
19data PrettyType = Multiline Int -- Offset where to start
20                | SingleLine
21    deriving (Show,Eq)
22
23-- | Pretty Print a list of ASN.1 element
24pretty :: PrettyType -- ^ indent level in space character
25       -> [ASN1]     -- ^ stream of ASN1
26       -> String
27pretty (Multiline at) = prettyPrint at
28  where
29    indent n = replicate n ' '
30
31    prettyPrint _ []                 = ""
32    prettyPrint n (x@(Start _) : xs) = indent n     ++ p id x ++ prettyPrint (n+1) xs
33    prettyPrint n (x@(End _) : xs)   = indent (n-1) ++ p id x ++ prettyPrint (n-1) xs
34    prettyPrint n (x : xs)           = indent n     ++ p id x ++ prettyPrint n xs
35
36pretty SingleLine = prettyPrint
37  where
38    prettyPrint []                 = ""
39    prettyPrint (x@(Start _) : xs) = p id x ++ "," ++ prettyPrint xs
40    prettyPrint (x@(End _) : xs)   = p id x ++ "," ++ prettyPrint xs
41    prettyPrint (x : xs)           = p id x ++ "," ++ prettyPrint xs
42
43p :: ([Char] -> t) -> ASN1 -> t
44p put (Boolean b)                        = put ("bool: " ++ show b)
45p put (IntVal i)                         = put ("int: " ++ showHex i "")
46p put (BitString bits)                   = put ("bitstring: " ++ (hexdump $ bitArrayGetData bits))
47p put (OctetString bs)                   = put ("octetstring: " ++ hexdump bs)
48p put (Null)                             = put "null"
49p put (OID is)                           = put ("OID: " ++ show is)
50p put (Real d)                           = put ("real: " ++ show d)
51p put (Enumerated _)                     = put "enum"
52p put (Start Sequence)                   = put "{"
53p put (End Sequence)                     = put "}"
54p put (Start Set)                        = put "["
55p put (End Set)                          = put "]"
56p put (Start (Container x y))            = put ("< " ++ show x ++ " " ++ show y)
57p put (End (Container x y))              = put ("> " ++ show x ++ " " ++ show y)
58p put (ASN1String cs)                    = putCS put cs
59p put (ASN1Time TimeUTC time tz)         = put ("utctime: " ++ show time ++ " " ++ show tz)
60p put (ASN1Time TimeGeneralized time tz) = put ("generalizedtime: " ++ show time ++ " " ++ show tz)
61p put (Other tc tn x)                    = put ("other(" ++ show tc ++ "," ++ show tn ++ "," ++ show x ++ ")")
62
63putCS :: ([Char] -> t) -> ASN1CharacterString -> t
64putCS put (ASN1CharacterString UTF8 t)         = put ("utf8string:" ++ show t)
65putCS put (ASN1CharacterString Numeric bs)     = put ("numericstring:" ++ hexdump bs)
66putCS put (ASN1CharacterString Printable t)    = put ("printablestring: " ++ show t)
67putCS put (ASN1CharacterString T61 bs)         = put ("t61string:" ++ show bs)
68putCS put (ASN1CharacterString VideoTex bs)    = put ("videotexstring:" ++ hexdump bs)
69putCS put (ASN1CharacterString IA5 bs)         = put ("ia5string:" ++ show bs)
70putCS put (ASN1CharacterString Graphic bs)     = put ("graphicstring:" ++ hexdump bs)
71putCS put (ASN1CharacterString Visible bs)     = put ("visiblestring:" ++ hexdump bs)
72putCS put (ASN1CharacterString General bs)     = put ("generalstring:" ++ hexdump bs)
73putCS put (ASN1CharacterString UTF32 t)        = put ("universalstring:" ++ show t)
74putCS put (ASN1CharacterString Character bs)   = put ("characterstring:" ++ hexdump bs)
75putCS put (ASN1CharacterString BMP t)          = put ("bmpstring: " ++ show t)
76
77hexdump :: ByteString -> String
78hexdump bs = show (convertToBase Base16 bs :: ByteString)
79