{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}-- |-- Module : Data.ASN1.Raw-- License : BSD-style-- Maintainer : Vincent Hanquez <vincent@snarc.org>-- Stability : experimental-- Portability : unknown---- A module containing raw ASN1 serialization/derialization tools--moduleData.ASN1.Raw(-- * ASN1 definitionsASN1Class(..),ASN1Tag,ASN1Length(..),ASN1Header(..),ASN1Err(..)-- * Enumerator events,ASN1Event(..),iterateFile,iterateByteString,enumReadBytes,enumWriteBytes,toBytes-- * serialize asn1 headers,getHeader,putHeader)whereimportData.Enumeratorhiding(head,length,map)importqualifiedData.EnumeratorasEimportqualifiedData.Enumerator.ListasELimportData.Enumerator.Binary(enumFile)importData.Attoparsec.EnumeratorimportData.AttoparsecimportqualifiedData.AttoparsecasAimportData.ByteString(ByteString)importqualifiedData.ByteStringasBimportqualifiedData.ByteString.LazyasLimportData.ASN1.InternalimportControl.ExceptionimportData.TypeableimportData.WordimportData.BitsimportControl.MonadimportControl.Monad.IdentityimportControl.Applicative((<|>),(<$>))dataASN1Class=Universal|Application|Context|Privatederiving(Show,Eq,Ord,Enum)typeASN1Tag=IntdataASN1Length=LenShortInt-- ^ Short form with only one byte. length has to be < 127.|LenLongIntInt-- ^ Long form of N bytes|LenIndefinite-- ^ Length is indefinite expect an EOC in the stream to finish the typederiving(Show,Eq)dataASN1Header=ASN1Header!ASN1Class!ASN1Tag!Bool!ASN1Lengthderiving(Show,Eq)dataASN1Event=HeaderASN1Header-- ^ ASN1 Header|Primitive!ByteString-- ^ Primitive|ConstructionBegin-- ^ Constructed value start|ConstructionEnd-- ^ Constructed value endderiving(Show,Eq)dataASN1Err=ASN1LengthDecodingLongContainsZero|ASN1WritingUnexpectedConstructionEnd|ASN1WritingUnexpectedInputEOF|ASN1PolicyFailedStringString|ASN1NotImplementedString|ASN1Multiple[ASN1Err]|ASN1MiscString|ASN1ParsingPartial|ASN1ParsingFailStringderiving(Typeable,Show,Eq)instanceExceptionASN1Err{-| iterate over a file using a file enumerator. -}iterateFile::FilePath->IterateeASN1EventIOa->IO(EitherSomeExceptiona)iterateFilepathp=run(enumFilepath$$joinI(enumReadBytes$$p)){-| iterate over a lazy bytestring using a list enumerator over the bytestring chunks. -}iterateByteString::Monadm=>L.ByteString->IterateeASN1Eventma->m(EitherSomeExceptiona)iterateByteStringbsp=run(enumList1(L.toChunksbs)$$joinI(enumReadBytes$$p)){- parse state machine -}dataParseState=PSPrimitiveInt|PSConstructingInt|PSConstructingEOC{-| enumReadBytes parse bytestring and generate asn1event. -}enumReadBytes::Monadm=>EnumerateeByteStringASN1EventmaenumReadBytes=checkDone$\k->k(Chunks[])>>==loop[0][]whereloop!cs!ps=checkDone(gocsps)go(n:[])[]k=iterDesc>>=eofCheckk(\(c,e,nps)->casenpsofPSPrimitive_->k(Chunks[e])>>==loop[c+n][nps]_->k(Chunks[e,ConstructionBegin])>>==loop[0,c+n][nps])go(n:cs)(PSPrimitivei:pss)k=iterPrimi>>=(\e->k(Chunks[e])>>==loop(n+i:cs)pss)go(n:m:cs)fps@(PSConstructingi:pss)k|n==i=k(Chunks[ConstructionEnd])>>==loop(n+m:cs)pss|otherwise=iterDesc>>=eofCheckk(\(c,e,nps)->casenpsofPSPrimitive_->k(Chunks[e])>>==loop(n+c:m:cs)(nps:fps)_->k(Chunks[e,ConstructionBegin])>>==loop(0:n+c:m:cs)(nps:fps))go(n:m:cs)fps@(PSConstructingEOC:pss)k=iterDesc>>=eofCheckk(\(c,e,nps)->caseeof-- check if EOC or continue(Header(ASN1Header_0__))->k(Chunks[ConstructionEnd])>>==loop(c+n+m:cs)pss_->k(Chunks[e])>>==loop(n+c:m:cs)(nps:fps))-- error casego__k=k(Chunks[])>>==returneofCheckk_Nothing=k(Chunks[])>>==returneofCheck_f(Justx)=f$!xiterDesc::Monadm=>IterateeByteStringm(Maybe(Int,ASN1Event,ParseState))iterDesc=iterParser((endOfInput>>returnNothing)<|>fmapJustparseHeaderEvent)iterPrimi=iterParser(fmap(Primitive)(A.takei)){- parseHeaderEvent returns the asn1event header, the length parsed and the next parse state. -}parseHeaderEvent::Parser(Int,ASN1Event,ParseState)parseHeaderEvent=do(lbytes,asn1header@(ASN1Header__pclen))<-parseHeaderletps=ifpc-- constructed value(s)thencaselenofLenIndefinite->PSConstructingEOCLenLong_i->PSConstructingiLenShorti->PSConstructingi-- primitive valueelsecaselenofLenIndefinite->error"cannot do indefinite primitive"LenLong_i->PSPrimitiveiLenShorti->PSPrimitiveireturn(lbytes,Headerasn1header,ps){- parseHeader parse a asn1 header in an attoparsec context.
- it returns the number of bytes parsed, the asn1event for this event -}parseHeader::Parser(Int,ASN1Header)parseHeader=do(cl,pc,t1)<-parseFirstWord<$>anyWord8(tagbytes,tag)<-ift1==0x1fthengetTagLongelsereturn(0,t1)(lenbytes,len)<-getLengthreturn(1+tagbytes+lenbytes,ASN1Headercltagpclen){- parse an header from a single bytestring. -}getHeader::ByteString->EitherASN1ErrASN1HeadergetHeaderl=caseparseparseHeaderlof(Fail___)->Left(ASN1ParsingFail"header")(Partial_)->Left(ASN1ParsingPartial)Donebr->ifB.nullbthenRight(sndr)elseLeftASN1ParsingPartial{- parse the first word of an header -}parseFirstWord::Word8->(ASN1Class,Bool,ASN1Tag)parseFirstWordw=(cl,pc,t1)wherecl=toEnum$fromIntegral$(w`shiftR`6)pc=testBitw5t1=fromIntegral(w.&.0x1f){- when the first tag is 0x1f, the tag is in long form, where
- we get bytes while the 7th bit is set. -}getTagLong::Parser(Int,ASN1Tag)getTagLong=dot<-fromIntegral<$>anyWord8when(t==0x80)$error"not canonical encoding of tag"iftestBitt7thengetNext1(clearBitt7)elsereturn(1,t)wheregetNext!blen!n=dot<-fromIntegral<$>anyWord8iftestBitt7thengetNext(blen+1)(n`shiftL`7+clearBitt7)elsereturn(blen+1,n`shiftL`7+t){- get the asn1 length which is either short form if 7th bit is not set,
- indefinite form is the 7 bit is set and every other bits clear,
- or long form otherwise, where the next bytes will represent the length
-}getLength::Parser(Int,ASN1Length)getLength=dol1<-fromIntegral<$>anyWord8iftestBitl17thencaseclearBitl17of0->return(1,LenIndefinite)len->dolw<-A.takelenreturn(1+len,LenLonglen$uintbslw)elsereturn(1,LenShortl1)where{- uintbs return the unsigned int represented by the bytes -}uintbs=B.foldl(\accn->(acc`shiftL`8)+fromIntegraln)0{- | putIdentifier encode an ASN1 Identifier into a marshalled value -}putHeader::ASN1Header->ByteStringputHeader(ASN1Headercltagpclen)=B.appendtgByteslenByteswherecli=shiftL(fromIntegral$fromEnumcl)6pcval=shiftL(ifpcthen0x1else0x0)5tag0=iftag<0x1fthenfromIntegraltagelse0x1fword1=cli.|.pcval.|.tag0tgBytes=iftag<0x1fthenB.singletonword1elseB.consword1$putVarEncodingIntegraltaglenBytes=B.pack$putLengthlen{- | putLength encode a length into a ASN1 length.
- see getLength for the encoding rules -}putLength::ASN1Length->[Word8]putLength(LenShorti)|i<0||i>0x7f=error"putLength: short length is not between 0x0 and 0x80"|otherwise=[fromIntegrali]putLength(LenLong_i)|i<0=error"putLength: long length is negative"|otherwise=lenbytes:lwwherelw=bytesOfUInt$fromIntegralilenbytes=fromIntegral(lengthlw.|.0x80)putLength(LenIndefinite)=[0x80]{-| write Bytes of events enumeratee -}enumWriteBytes::Monadm=>EnumerateeASN1EventByteStringmaenumWriteBytes=checkDone$\k->k(Chunks[])>>==loop[]whereputEoc=putHeader$ASN1HeaderUniversal0False(LenShort0)loopeocs=checkDone$goeocsgoeocsk=EL.head>>=\x->casexofNothing->ifeocs==[]thenk(Chunks[])>>==returnelseE.throwErrorASN1WritingUnexpectedInputEOFJust(Headerhdr@(ASN1Header__Truelen))->k(Chunks[putHeaderhdr])>>==loop((len==LenIndefinite):eocs)Just(Headerhdr)->k(Chunks[putHeaderhdr])>>==loopeocsJust(Primitivep)->k(Chunks[p])>>==loopeocsJustConstructionBegin->k(Chunks[])>>==loopeocsJustConstructionEnd->caseeocsof[]->E.throwErrorASN1WritingUnexpectedConstructionEndTrue:tl->k(Chunks[putEoc])>>==looptlFalse:tl->k(Chunks[])>>==looptltoBytes::[ASN1Event]->L.ByteStringtoBytesevs=caserunIdentity(run(enumList8evs$$joinI(enumWriteBytes$$EL.consume)))ofLefterr->error$showerrRightl->L.fromChunksl