Codec.ASN1.ASN1

|  | 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