{-# LANGUAGE CPP #-}

{- |
Module      : Data.ASN1.Pretty
License     : BSD-style
Copyright   : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Types and functions to pretty print ASN.1 elements.
-}

module Data.ASN1.Pretty
  ( pretty
  , PrettyType (..)
  ) where

import           Data.ASN1.BitArray ( bitArrayGetData )
import           Data.ASN1.Types
                   ( ASN1 (..), ASN1CharacterString (..)
                   , ASN1ConstructionType (..), ASN1StringEncoding (..)
                   , ASN1TimeType (..)
                   )
#if MIN_VERSION_base16(1,0,0)
import           Data.Base16.Types ( extractBase16 )
#endif
import           Data.ByteString ( ByteString )
import           Data.ByteString.Base16 ( encodeBase16' )
import           Numeric ( showHex )

-- | A helper function while base16 < 1.0 is supported.

encodeBase16 :: ByteString -> ByteString
#if MIN_VERSION_base16(1,0,0)
encodeBase16 :: ByteString -> ByteString
encodeBase16 = Base16 ByteString -> ByteString
forall a. Base16 a -> a
extractBase16 (Base16 ByteString -> ByteString)
-> (ByteString -> Base16 ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base16 ByteString
encodeBase16'
#else
encodeBase16 = encodeBase16'
#endif

-- | Type representing approaches to formatting.

data PrettyType =
    Multiline Int
    -- ^ Increase indentation following each 'Start' object and decrease

    -- following each 'End' object. The 'Int' is the initial indentation.

  | SingleLine
    -- ^ No indentation.

  deriving (PrettyType -> PrettyType -> Bool
(PrettyType -> PrettyType -> Bool)
-> (PrettyType -> PrettyType -> Bool) -> Eq PrettyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrettyType -> PrettyType -> Bool
== :: PrettyType -> PrettyType -> Bool
$c/= :: PrettyType -> PrettyType -> Bool
/= :: PrettyType -> PrettyType -> Bool
Eq, Int -> PrettyType -> ShowS
[PrettyType] -> ShowS
PrettyType -> String
(Int -> PrettyType -> ShowS)
-> (PrettyType -> String)
-> ([PrettyType] -> ShowS)
-> Show PrettyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrettyType -> ShowS
showsPrec :: Int -> PrettyType -> ShowS
$cshow :: PrettyType -> String
show :: PrettyType -> String
$cshowList :: [PrettyType] -> ShowS
showList :: [PrettyType] -> ShowS
Show)

-- | Pretty print a list of ASN.1 elements.

pretty ::
     PrettyType -- ^ The approach to formatting.

  -> [ASN1]     -- ^ Stream of ASN.1.

  -> String
pretty :: PrettyType -> [ASN1] -> String
pretty (Multiline Int
at) = Int -> [ASN1] -> String
prettyPrint Int
at
 where
  indent :: Int -> String
indent Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '

  prettyPrint :: Int -> [ASN1] -> String
prettyPrint Int
_ []                 = String
""
  prettyPrint Int
n (x :: ASN1
x@(Start ASN1ConstructionType
_) : [ASN1]
xs) = Int -> String
indent Int
n     String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> ASN1 -> String
forall t. (String -> t) -> ASN1 -> t
p ShowS
forall a. a -> a
id ASN1
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [ASN1] -> String
prettyPrint (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ASN1]
xs
  prettyPrint Int
n (x :: ASN1
x@(End ASN1ConstructionType
_) : [ASN1]
xs)   = Int -> String
indent (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> ASN1 -> String
forall t. (String -> t) -> ASN1 -> t
p ShowS
forall a. a -> a
id ASN1
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [ASN1] -> String
prettyPrint (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [ASN1]
xs
  prettyPrint Int
n (ASN1
x : [ASN1]
xs)           = Int -> String
indent Int
n     String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS -> ASN1 -> String
forall t. (String -> t) -> ASN1 -> t
p ShowS
forall a. a -> a
id ASN1
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [ASN1] -> String
prettyPrint Int
n [ASN1]
xs

pretty PrettyType
SingleLine = [ASN1] -> String
prettyPrint
 where
  prettyPrint :: [ASN1] -> String
prettyPrint []                 = String
""
  prettyPrint (x :: ASN1
x@(Start ASN1ConstructionType
_) : [ASN1]
xs) = ShowS -> ASN1 -> String
forall t. (String -> t) -> ASN1 -> t
p ShowS
forall a. a -> a
id ASN1
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
prettyPrint [ASN1]
xs
  prettyPrint (x :: ASN1
x@(End ASN1ConstructionType
_) : [ASN1]
xs)   = ShowS -> ASN1 -> String
forall t. (String -> t) -> ASN1 -> t
p ShowS
forall a. a -> a
id ASN1
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
prettyPrint [ASN1]
xs
  prettyPrint (ASN1
x : [ASN1]
xs)           = ShowS -> ASN1 -> String
forall t. (String -> t) -> ASN1 -> t
p ShowS
forall a. a -> a
id ASN1
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
prettyPrint [ASN1]
xs

p :: ([Char] -> t) -> ASN1 -> t
p :: forall t. (String -> t) -> ASN1 -> t
p String -> t
put (Boolean Bool
b)                        = String -> t
put (String
"bool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
b)
p String -> t
put (IntVal Integer
i)                         = String -> t
put (String
"int: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> ShowS
forall a. Integral a => a -> ShowS
showHex Integer
i String
"")
p String -> t
put (BitString BitArray
bits)                   = String -> t
put (String
"bitstring: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump (BitArray -> ByteString
bitArrayGetData BitArray
bits))
p String -> t
put (OctetString ByteString
bs)                   = String -> t
put (String
"octetstring: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
p String -> t
put ASN1
Null                               = String -> t
put String
"null"
p String -> t
put (OID OID
is)                           = String -> t
put (String
"OID: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OID -> String
forall a. Show a => a -> String
show OID
is)
p String -> t
put (Real Double
d)                           = String -> t
put (String
"real: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
d)
p String -> t
put (Enumerated Integer
_)                     = String -> t
put String
"enum"
p String -> t
put (Start ASN1ConstructionType
Sequence)                   = String -> t
put String
"{"
p String -> t
put (End ASN1ConstructionType
Sequence)                     = String -> t
put String
"}"
p String -> t
put (Start ASN1ConstructionType
Set)                        = String -> t
put String
"["
p String -> t
put (End ASN1ConstructionType
Set)                          = String -> t
put String
"]"
p String -> t
put (Start (Container ASN1Class
x Int
y))            = String -> t
put (String
"< " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Class -> String
forall a. Show a => a -> String
show ASN1Class
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y)
p String -> t
put (End (Container ASN1Class
x Int
y))              = String -> t
put (String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Class -> String
forall a. Show a => a -> String
show ASN1Class
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y)
p String -> t
put (ASN1String ASN1CharacterString
cs)                    = (String -> t) -> ASN1CharacterString -> t
forall t. (String -> t) -> ASN1CharacterString -> t
putCS String -> t
put ASN1CharacterString
cs
p String -> t
put (ASN1Time ASN1TimeType
TimeUTC DateTime
time Maybe TimezoneOffset
tz)         = String -> t
put (String
"utctime: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DateTime -> String
forall a. Show a => a -> String
show DateTime
time String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe TimezoneOffset -> String
forall a. Show a => a -> String
show Maybe TimezoneOffset
tz)
p String -> t
put (ASN1Time ASN1TimeType
TimeGeneralized DateTime
time Maybe TimezoneOffset
tz) = String -> t
put (String
"generalizedtime: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DateTime -> String
forall a. Show a => a -> String
show DateTime
time String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe TimezoneOffset -> String
forall a. Show a => a -> String
show Maybe TimezoneOffset
tz)
p String -> t
put (Other ASN1Class
tc Int
tn ByteString
x)                    = String -> t
put (String
"other(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1Class -> String
forall a. Show a => a -> String
show ASN1Class
tc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
tn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")

putCS :: ([Char] -> t) -> ASN1CharacterString -> t
putCS :: forall t. (String -> t) -> ASN1CharacterString -> t
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
UTF8 ByteString
t)       = String -> t
put (String
"utf8string:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
t)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
Numeric ByteString
bs)   = String -> t
put (String
"numericstring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
Printable ByteString
t)  = String -> t
put (String
"printablestring: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
t)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
T61 ByteString
bs)       = String -> t
put (String
"t61string:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
VideoTex ByteString
bs)  = String -> t
put (String
"videotexstring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
IA5 ByteString
bs)       = String -> t
put (String
"ia5string:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
Graphic ByteString
bs)   = String -> t
put (String
"graphicstring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
Visible ByteString
bs)   = String -> t
put (String
"visiblestring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
General ByteString
bs)   = String -> t
put (String
"generalstring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
UTF32 ByteString
t)      = String -> t
put (String
"universalstring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
t)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
Character ByteString
bs) = String -> t
put (String
"characterstring:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
hexdump ByteString
bs)
putCS String -> t
put (ASN1CharacterString ASN1StringEncoding
BMP ByteString
t)        = String -> t
put (String
"bmpstring: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
t)

hexdump :: ByteString -> String
hexdump :: ByteString -> String
hexdump ByteString
bs = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> ByteString
encodeBase16 ByteString
bs)