|  | Contents | Index

Codec.ASN1.ASN1

Portability | non-portable
Stability | experimental
Maintainer | dominic.steinitz@blueyonder.co.uk

Contents

Type declarations
Example

Description
Provide Haskell types associated with some of the ASN.1 base types. The ASN.1, BER and other standards have been developed by the International Telecomunication Union (ITU) http://www.itu.int/ They can be downloaded for free from http://asn1.elibel.tm.fr/en/standards/. See also a layman's guide to a subset of ASN.1, BER and DER available at ftp://ftp.rsa.com/pub/pkcs/ascii/layman.asc.
Synopsis

newtype VisibleString = MkVisibleString String
newtype PrintableString = MkPrintableString String
data NULL = NULL
newtype OctetString = MkOctetString [Octet]
newtype BitString = MkBitString [Octet]
intToTwosBinComp :: Integral a => a -> [Word8]
twosBinCompToInt :: Integral a => [Word8] -> a
newtype Octet = MkOctet Word8
newtype OID = MkOID [Int]
newtype ASNEnum = MkASNEnum Int
class Encodable a where

encode :: a -> OctetStream
decode :: WrapMonad m => Handle -> m (Int, a)

data ASN

= forall a . (CF a, Encodable a, Show a) => Primitive' Tag a
| Constructed' Tag [ASN]

class ASNable a where

toASN :: TagOption -> a -> ASN
fromASN :: TagOption -> ASN -> a

data TagType

= Universal
| Application
| Context
| Private

data TagCons

= Primitive
| Constructed

data TagOption

= Implicit Tag
| NoTag

type Tag = (TagType, Int)

Type declarations
newtype VisibleString

Constructors

MkVisibleString String |

Instances

CF VisibleString
CT VisibleString
Encodable VisibleString
ASNable VisibleString
Show VisibleString

newtype PrintableString

Constructors

MkPrintableString String |

Instances

CF PrintableString
CT PrintableString
Encodable PrintableString
ASNable PrintableString
Show PrintableString

data NULL

Constructors

NULL |

Instances

CF NULL
CT NULL
Encodable NULL
ASNable NULL
Eq NULL
Show NULL

newtype OctetString

Constructors

MkOctetString [Octet] |

Instances

Show OctetString
CF OctetString
CT OctetString
Encodable OctetString
ASNable OctetString
Eq OctetString

newtype BitString

Constructors

MkBitString [Octet] |

Instances

Show BitString
CF BitString
CT BitString
Encodable BitString
ASNable BitString
Eq BitString

intToTwosBinComp :: Integral a => a -> [Word8]
twosBinCompToInt :: Integral a => [Word8] -> a
newtype Octet

Constructors

MkOctet Word8 |

Instances

Show Octet
Eq Octet

newtype OID

Constructors

MkOID [Int] |

Instances

CF OID
CT OID
Encodable OID
ASNable OID
Eq OID
Show OID

newtype ASNEnum

Constructors

MkASNEnum Int |

Instances

CF ASNEnum
CT ASNEnum
Encodable ASNEnum
ASNable ASNEnum
Eq ASNEnum
Show ASNEnum

class Encodable a where

Methods

encode :: a -> OctetStream
decode :: WrapMonad m => Handle -> m (Int, a)

Instances

Encodable VisibleString
Encodable PrintableString
Encodable OctetString
Encodable BitString
Encodable NULL
Encodable Bool
Encodable OID
Encodable Int
Encodable Integer
Encodable ASNEnum
Encodable ASN

data ASN

Constructors

forall a . (CF a, Encodable a, Show a) => Primitive' Tag a |
Constructed' Tag [ASN] |

Instances

Show ASN
ASNable [ASN]
Encodable ASN

class ASNable a where

Methods

toASN :: TagOption -> a -> ASN
fromASN :: TagOption -> ASN -> a

Instances

ASNable VisibleString
ASNable PrintableString
ASNable OctetString
ASNable BitString
ASNable NULL
ASNable Bool
ASNable OID
ASNable Int
ASNable ASNEnum
ASNable Integer
ASNable [ASN]
ASNable RSAPrivateKey
ASNable Version
ASNable AlgorithmIdentifier
ASNable PrivateKeyInfo

data TagType

Constructors

Universal |
Application |
Context |
Private |

Instances

Eq TagType
Enum TagType
Show TagType
Read TagType
Ord TagType

data TagCons

Constructors

Primitive |
Constructed |

Instances

Eq TagCons
Enum TagCons
Show TagCons

data TagOption

Constructors

Implicit Tag |
NoTag |

type Tag = (TagType, Int)
Example

This example program takes a modified version of the example in Annex A of X.690 (ISO 8825-1) and demonstrates how to produce Haskell types and encoding and decoding functions for each type.

Here's the ASN.1.

    PersonnelRecord ::= [APPLICATION 0] IMPLICIT SEQUENCE {
       name         Name,
       title        [0] VisibleString,
       number       EmployeeNumber,
       dateOfHire   [1] Date,
       nameOfSpouse [2] Name,
       children     [3] IMPLICIT
          SEQUENCE OF ChildInformation DEFAULT {} }

    ChildInformation ::= SEQUENCE
        { name        Name,
          dateOfBirth [0] Date}

    Name ::= [APPLICATION 1] IMPLICIT SEQUENCE
       {givenName  VisibleString,
        initial    VisibleString,
        familyName VisibleString}

    EmployeeNumber ::= [APPLICATION 2] IMPLICIT INTEGER

    Date ::= [APPLICATION 3] IMPLICIT VisibleString -- YYYYMMDD

And here is the corresponding Haskell.

    module Main(main) where

    import Char
    import IO
    import Control.Monad.State
    import List

    import Codec.ASN1.ASN1

    newtype Date = MkDate VisibleString
       deriving Show

    instance ASNable Date where
       toASN NoTag (MkDate d) = toASN (Implicit (Application,3)) d
       toASN tag   (MkDate d) = toASN tag d
       fromASN t x =
          let (u,e1,e2) =
                case t of
                   NoTag ->
    	          ((Application,3),
    	           "fromASN: invalid application primitive tag for Date",
    	           "fromASN: invalid constructed tag for Date")
                   (Implicit v) ->
    	          (v,
    	           "fromASN: invalid implicit primitive tag for Date",
    	           "fromASN: invalid implicit constructed tag for Date") in
             f u x e1 e2
          where
             f t x errMsg1 errMsg2 =
                case x of
    	       Primitive' t' v ->
    	          if t == t'
    		     -- VisibleString normally has the Universal tag 26.
    		     -- Decode it as an OctetString, encode it with the
    		     -- expected tag and then properly decode it.
    	             then let (y::OctetString) = fromASN (Implicit t) x
    	                      z = map (chr . fromIntegral) $
    	                          encode $ toASN (Implicit (Universal,26)) y
    	                      ((_,(u::ASN)),_)  = runState (decode stdin) z
    	                      (v::VisibleString) = fromASN NoTag u in
    	                         MkDate v
    	             else error (errMsg1 ++ "\n" ++ "Expected " ++ show t ++ " actual " ++ show t')
    	       otherwise ->
    	          error errMsg2

    newtype EmployeeNumber = MkEmployeeNumber Integer
       deriving Show

    instance ASNable EmployeeNumber where
       toASN NoTag (MkEmployeeNumber n) =
          toASN (Implicit (Application,2)) n
       toASN tag (MkEmployeeNumber n) =
          toASN tag n
       fromASN t x =
          let (u,e1,e2) =
                case t of
                   NoTag ->
    	          ((Application,2),
    	           "fromASN: invalid application primitive tag for EmployeeNumber",
    	           "fromASN: invalid constructed tag for EmployeeNumber")
                   (Implicit v) ->
    	          (v,
    	           "fromASN: invalid implicit primitive tag for EmployeeNumber",
    	           "fromASN: invalid implicit constructed tag for EmployeeNumber") in
             f u x e1 e2
          where
             f t x errMsg1 errMsg2 =
                case x of
    	       Primitive' t' v ->
    	          if t == t'
    		     -- Integer normally has the Universal tag 2.
    		     -- Decode it as an OctetString, encode it with the
    		     -- expected tag and then properly decode it.
    	             then let (y::OctetString) = fromASN (Implicit t) x
    	                      z = map (chr . fromIntegral) $
    	                          encode $ toASN (Implicit (Universal,2)) y
    	                      ((_,(u::ASN)),_)  = runState (decode stdin) z
    	                      (v::Integer) = fromASN NoTag u in
    	                         MkEmployeeNumber v
    	             else error (errMsg1 ++ "\n" ++ "Expected " ++ show t ++ " actual " ++ show t')
    	       otherwise ->
    	          error errMsg2

    data Name =
       MkName {
          givenName  :: VisibleString,
          initial    :: VisibleString,
          familyName :: VisibleString }
       deriving Show

    instance ASNable Name where
       toASN NoTag n =
          toASN (Implicit (Application,1)) [toASN NoTag (givenName n),
                                            toASN NoTag (initial n),
                                            toASN NoTag (familyName n)]
       toASN tag n =
          toASN tag [toASN NoTag $ givenName n,
                     toASN NoTag $ initial n,
                     toASN NoTag $ familyName n]
       fromASN t x =
          let (u,e1,e2,e3) =
                case t of
                   NoTag ->
    	          ((Application,1),
    	           "fromASN: invalid application constructed tag for Name",
    	           "fromASN: invalid primitive tag for Name",
                       "fromASN: invalid number of components for Name")
                   (Implicit v) ->
    	          (v,
    	           "fromASN: invalid implicit constructed tag for Name",
    	           "fromASN: invalid implicit primitive tag for Name",
                       "fromASN: invalid number of components for Name") in
             f u x e1 e2 e3
          where
             f t x errMsg1 errMsg2 errMsg3 =
                case x of
    	       Constructed' t' v ->
    	          if t == t'
    	             then case v of
    		             [b1,b2,b3] ->
    			        let gn = fromASN NoTag b1
    				    i  = fromASN NoTag b2
    				    fn = fromASN NoTag b3 in
    				       MkName {givenName = gn, initial = i, familyName = fn}
    			     otherwise ->
    			        error errMsg3
    	             else error (errMsg1 ++ "\n" ++ "Expected " ++ show t ++ " actual " ++ show t')
    	       otherwise ->
    	          error errMsg2

    data ChildInformation =
       MkChildInformation {
          name :: Name,
          dateOfBirth ::Date }
       deriving Show

    instance ASNable ChildInformation where
       toASN t c =
          case t of
             NoTag ->
                Constructed' (Universal,16) bs
             Implicit tag ->
                Constructed' tag bs
          where
              bs = [toASN NoTag (name c),
                    toASN (Implicit (Context,1)) (dateOfBirth c)]
       fromASN t x =
          let (u,e1,e2,e3) =
                case t of
                   NoTag ->
    	          ((Universal,16),
    	           "fromASN: invalid universal constructed tag for ChildInformation",
    	           "fromASN: invalid primitive tag for ChildInformation",
                       "fromASN: invalid number of components for ChildInformation")
                   (Implicit v) ->
    	          (v,
    	           "fromASN: invalid implicit constructed tag for ChildInformation",
    	           "fromASN: invalid implicit primitive tag for ChildInformation",
                       "fromASN: invalid number of components for ChildInformation") in
             f u x e1 e2 e3
          where
             f t x errMsg1 errMsg2 errMsg3 =
                case x of
    	       Constructed' t' v ->
    	          if t == t'
    	             then case v of
    		             [b1,b2] ->
    			        let dob = fromASN (Implicit (Context,1)) b2
    				    nm  = fromASN NoTag b1 in
    				       MkChildInformation {dateOfBirth = dob, name = nm}
    			     otherwise ->
    			        error errMsg3
    	             else error (errMsg1 ++ "\n" ++ "Expected " ++ show t ++ " actual " ++ show t')
    	       otherwise ->
    	          error errMsg2

    data PersonnelRecord =
       MkPersonnelRecord {
          name_1       :: Name,
          title        :: VisibleString,
          number       :: EmployeeNumber,
          dateOfHire   :: Date,
          nameOfSpouse :: Name,
          children     :: [ChildInformation] }
       deriving Show

    instance ASNable PersonnelRecord where
       toASN t p =
          case t of
             NoTag ->
                Constructed' (Application,0) bs
             Implicit tag ->
                Constructed' tag bs
          where
              bs = [toASN NoTag (name_1 p),
                    toASN (Implicit (Context,0)) (title p),
    		toASN NoTag (number p),
    		toASN (Implicit (Context,1)) (dateOfHire p),
    		toASN (Implicit (Context,2)) (nameOfSpouse p),
    		toASN (Implicit (Context,3)) (map (toASN NoTag) (children p))]
       fromASN t x =
          let (u,e1,e2,e3) =
                case t of
                   NoTag ->
    	          ((Application,0),
    	           "fromASN: invalid application constructed tag for PersonnelRecord",
    	           "fromASN: invalid primitive tag for PersonnelRecord",
                       "fromASN: invalid number of components for PersonnelRecord")
                   (Implicit v) ->
    	          (v,
    	           "fromASN: invalid implicit constructed tag for PersonnelRecord",
    	           "fromASN: invalid implicit primitive tag for PersonnelRecord",
                       "fromASN: invalid number of components for PersonnelRecord") in
             f u x e1 e2 e3
          where
             f t x errMsg1 errMsg2 errMsg3 =
                case x of
    	       Constructed' t' v ->
    	          if t == t'
    	             then case v of
    		             [b1,b2,b3,b4,b5,b6] ->
    			        let nm  = fromASN NoTag b1
    		                   -- VisibleString normally has the Universal tag 26.
    		                   -- Decode it as an OctetString and then encode it with the
    		                   -- expected tag and then properly decode it.
    				    tio :: OctetString
    				    tio = fromASN (Implicit (Context,0)) b2
    	                            tie = map (chr . fromIntegral) $
    	                                     encode $ toASN (Implicit (Universal,26)) tio
    	                            ((_,(tia::ASN)),_)  = runState (decode stdin) tie
    	                            ti  = fromASN NoTag tia
    				    en  = fromASN NoTag b3
    				    doh = fromASN (Implicit (Context,1)) b4
    				    nos = fromASN (Implicit (Context,2)) b5
    				    as  = fromASN (Implicit (Context,3)) b6
    				    cs  = map (fromASN NoTag) as in
    				       MkPersonnelRecord { name_1       = nm,
    				                           title        = ti,
    							   number       = en,
    							   dateOfHire   = doh,
    							   nameOfSpouse = nos,
    							   children     = cs }
    			     otherwise ->
    			        error errMsg3
    	             else error (errMsg1 ++ "\n" ++ "Expected " ++ show t ++ " actual " ++ show t')
    	       otherwise ->
    	          error errMsg2

    name1 = MkName { givenName  = MkVisibleString "John",
                    initial    = MkVisibleString "P",
                    familyName = MkVisibleString "Smith" }

    name2 = MkName { givenName  = MkVisibleString "Mary",
                    initial    = MkVisibleString "T",
                    familyName = MkVisibleString "Smith" }

    name3 = MkName { givenName = MkVisibleString "Ralph",
                     initial   = MkVisibleString "T",
                     familyName = MkVisibleString "Smith" }

    name4 = MkName { givenName = MkVisibleString "Susan",
                     initial   = MkVisibleString "B",
                     familyName = MkVisibleString "Jones" }

    date1 = MkDate (MkVisibleString "19710917")
    date2 = MkDate (MkVisibleString "19571111")
    date3 = MkDate (MkVisibleString "19590717")

    employeeNumber1 = MkEmployeeNumber 51

    child1 = MkChildInformation { name = name3,
                                  dateOfBirth = date2 }

    child2 = MkChildInformation { name = name4,
                                  dateOfBirth = date3 }

    personnelRecord1 = MkPersonnelRecord { name_1 = name1,
                                           title  = MkVisibleString "Director",
    				       number = employeeNumber1,
    				       dateOfHire = date1,
    				       nameOfSpouse = name2,
    				       children = [child1,child2] }

    encodedPR = map (chr . fromIntegral) $ encode $ toASN NoTag personnelRecord1

    -- Decoding can either be done using a state monad or the IO monad - see below.
    -- stdin is a dummy file handle so that the overloaded function decode can be used
    -- with either monad.

    unASNedAndDecodedPR :: (PersonnelRecord,String)
    unASNedAndDecodedPR = runState (do (m,y) <- decode stdin; return $ fromASN NoTag y) encodedPR

    main =
       do ofh <- openFile "tst.txt" WriteMode
          hPutStr ofh encodedPR
          hClose ofh
          ifh <- openFile "tst.txt" ReadMode
          (m,y) <- decode ifh
          putStrLn (show ((fromASN NoTag y)::PersonnelRecord))

Produced by Haddock version 0.6