-- |
-- Module      : Data.ASN1.Prim
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Tools to read ASN1 primitive (e.g. boolean, int)
--

{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
module Data.ASN1.Prim
    (
    -- * ASN1 high level algebraic type
      ASN1(..)
    , ASN1ConstructionType(..)

    , encodeHeader
    , encodePrimitiveHeader
    , encodePrimitive
    , decodePrimitive
    , encodeConstructed
    , encodeList
    , encodeOne
    , mkSmallestLength

    -- * marshall an ASN1 type from a val struct or a bytestring
    , getBoolean
    , getInteger
    , getDouble
    , getBitString
    , getOctetString
    , getNull
    , getOID
    , getTime

    -- * marshall an ASN1 type to a bytestring
    , putTime
    , putInteger
    , putDouble
    , putBitString
    , putString
    , putOID
    ) where

import Data.ASN1.Internal
import Data.ASN1.Stream
import Data.ASN1.BitArray
import Data.ASN1.Types
import Data.ASN1.Types.Lowlevel
import Data.ASN1.Error
import Data.ASN1.Serialize
import Data.Bits
import Data.Monoid
import Data.Word
import Data.List (unfoldr)
import Data.ByteString (ByteString)
import Data.Char (ord, isDigit)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Unsafe as B
import Data.Hourglass
import Control.Arrow (first)
import Control.Applicative
import Control.Monad

encodeHeader :: Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader :: Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader Bool
pc ASN1Length
len (Boolean Bool
_)                = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x1 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (IntVal Integer
_)                 = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x2 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (BitString BitArray
_)              = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x3 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (OctetString ByteString
_)            = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x4 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len ASN1
Null                       = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x5 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (OID OID
_)                    = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x6 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Real Double
_)                   = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x9 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Enumerated Integer
_)             = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0xa Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (ASN1String ASN1CharacterString
cs)            = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal (ASN1StringEncoding -> ASN1Tag
forall p. Num p => ASN1StringEncoding -> p
characterStringType (ASN1StringEncoding -> ASN1Tag) -> ASN1StringEncoding -> ASN1Tag
forall a b. (a -> b) -> a -> b
$ ASN1CharacterString -> ASN1StringEncoding
characterEncoding ASN1CharacterString
cs) Bool
pc ASN1Length
len
  where characterStringType :: ASN1StringEncoding -> p
characterStringType ASN1StringEncoding
UTF8      = p
0xc
        characterStringType ASN1StringEncoding
Numeric   = p
0x12
        characterStringType ASN1StringEncoding
Printable = p
0x13
        characterStringType ASN1StringEncoding
T61       = p
0x14
        characterStringType ASN1StringEncoding
VideoTex  = p
0x15
        characterStringType ASN1StringEncoding
IA5       = p
0x16
        characterStringType ASN1StringEncoding
Graphic   = p
0x19
        characterStringType ASN1StringEncoding
Visible   = p
0x1a
        characterStringType ASN1StringEncoding
General   = p
0x1b
        characterStringType ASN1StringEncoding
UTF32     = p
0x1c
        characterStringType ASN1StringEncoding
Character = p
0x1d
        characterStringType ASN1StringEncoding
BMP       = p
0x1e
encodeHeader Bool
pc ASN1Length
len (ASN1Time ASN1TimeType
TimeUTC DateTime
_ Maybe TimezoneOffset
_)     = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x17 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (ASN1Time ASN1TimeType
TimeGeneralized DateTime
_ Maybe TimezoneOffset
_) = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x18 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Start ASN1ConstructionType
Sequence)           = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x10 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Start ASN1ConstructionType
Set)                = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal ASN1Tag
0x11 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Start (Container ASN1Class
tc ASN1Tag
tag)) = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
tc ASN1Tag
tag Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Other ASN1Class
tc ASN1Tag
tag ByteString
_)           = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
tc ASN1Tag
tag Bool
pc ASN1Length
len
encodeHeader Bool
_ ASN1Length
_ (End ASN1ConstructionType
_)                       = [Char] -> ASN1Header
forall a. HasCallStack => [Char] -> a
error [Char]
"this should not happen"

encodePrimitiveHeader :: ASN1Length -> ASN1 -> ASN1Header
encodePrimitiveHeader :: ASN1Length -> ASN1 -> ASN1Header
encodePrimitiveHeader = Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader Bool
False

encodePrimitiveData :: ASN1 -> ByteString
encodePrimitiveData :: ASN1 -> ByteString
encodePrimitiveData (Boolean Bool
b)         = Word8 -> ByteString
B.singleton (if Bool
b then Word8
0xff else Word8
0)
encodePrimitiveData (IntVal Integer
i)          = Integer -> ByteString
putInteger Integer
i
encodePrimitiveData (BitString BitArray
bits)    = BitArray -> ByteString
putBitString BitArray
bits
encodePrimitiveData (OctetString ByteString
b)     = ByteString -> ByteString
putString ByteString
b
encodePrimitiveData ASN1
Null                = ByteString
B.empty
encodePrimitiveData (OID OID
oidv)          = OID -> ByteString
putOID OID
oidv
encodePrimitiveData (Real Double
d)            = Double -> ByteString
putDouble Double
d
encodePrimitiveData (Enumerated Integer
i)      = Integer -> ByteString
putInteger (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
encodePrimitiveData (ASN1String ASN1CharacterString
cs)     = ASN1CharacterString -> ByteString
getCharacterStringRawData ASN1CharacterString
cs
encodePrimitiveData (ASN1Time ASN1TimeType
ty DateTime
ti Maybe TimezoneOffset
tz) = ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ByteString
putTime ASN1TimeType
ty DateTime
ti Maybe TimezoneOffset
tz
encodePrimitiveData (Other ASN1Class
_ ASN1Tag
_ ByteString
b)       = ByteString
b
encodePrimitiveData ASN1
o                   = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"not a primitive " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ASN1 -> [Char]
forall a. Show a => a -> [Char]
show ASN1
o)

encodePrimitive :: ASN1 -> (Int, [ASN1Event])
encodePrimitive :: ASN1 -> (ASN1Tag, [ASN1Event])
encodePrimitive ASN1
a =
    let b :: ByteString
b = ASN1 -> ByteString
encodePrimitiveData ASN1
a
        blen :: ASN1Tag
blen = ByteString -> ASN1Tag
B.length ByteString
b
        len :: ASN1Length
len = ASN1Tag -> ASN1Length
makeLength ASN1Tag
blen
        hdr :: ASN1Header
hdr = ASN1Length -> ASN1 -> ASN1Header
encodePrimitiveHeader ASN1Length
len ASN1
a
     in (ByteString -> ASN1Tag
B.length (ASN1Header -> ByteString
putHeader ASN1Header
hdr) ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
blen, [ASN1Header -> ASN1Event
Header ASN1Header
hdr, ByteString -> ASN1Event
Primitive ByteString
b])
  where
        makeLength :: ASN1Tag -> ASN1Length
makeLength ASN1Tag
len
            | ASN1Tag
len ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
< ASN1Tag
0x80 = ASN1Tag -> ASN1Length
LenShort ASN1Tag
len
            | Bool
otherwise  = ASN1Tag -> ASN1Tag -> ASN1Length
LenLong (ASN1Tag -> ASN1Tag
forall t p. (Num p, Integral t) => t -> p
nbBytes ASN1Tag
len) ASN1Tag
len
        nbBytes :: t -> p
nbBytes t
nb = if t
nb t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
255 then p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ t -> p
nbBytes (t
nb t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
256) else p
1

encodeOne :: ASN1 -> (Int, [ASN1Event])
encodeOne :: ASN1 -> (ASN1Tag, [ASN1Event])
encodeOne (Start ASN1ConstructionType
_) = [Char] -> (ASN1Tag, [ASN1Event])
forall a. HasCallStack => [Char] -> a
error [Char]
"encode one cannot do start"
encodeOne ASN1
t         = ASN1 -> (ASN1Tag, [ASN1Event])
encodePrimitive ASN1
t

encodeList :: [ASN1] -> (Int, [ASN1Event])
encodeList :: [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList []               = (ASN1Tag
0, [])
encodeList (End ASN1ConstructionType
_:[ASN1]
xs)       = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
xs
encodeList (t :: ASN1
t@(Start ASN1ConstructionType
_):[ASN1]
xs) =
    let ([ASN1]
ys, [ASN1]
zs)    = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd ASN1Tag
0 [ASN1]
xs
        (ASN1Tag
llen, [ASN1Event]
lev) = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
zs
        (ASN1Tag
len, [ASN1Event]
ev)   = ASN1 -> [ASN1] -> (ASN1Tag, [ASN1Event])
encodeConstructed ASN1
t [ASN1]
ys
     in (ASN1Tag
llen ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
len, [ASN1Event]
ev [ASN1Event] -> [ASN1Event] -> [ASN1Event]
forall a. [a] -> [a] -> [a]
++ [ASN1Event]
lev)

encodeList (ASN1
x:[ASN1]
xs)           =
    let (ASN1Tag
llen, [ASN1Event]
lev) = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
xs
        (ASN1Tag
len, [ASN1Event]
ev)   = ASN1 -> (ASN1Tag, [ASN1Event])
encodeOne ASN1
x
     in (ASN1Tag
llen ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
len, [ASN1Event]
ev [ASN1Event] -> [ASN1Event] -> [ASN1Event]
forall a. [a] -> [a] -> [a]
++ [ASN1Event]
lev)

encodeConstructed :: ASN1 -> [ASN1] -> (Int, [ASN1Event])
encodeConstructed :: ASN1 -> [ASN1] -> (ASN1Tag, [ASN1Event])
encodeConstructed c :: ASN1
c@(Start ASN1ConstructionType
_) [ASN1]
children =
    (ASN1Tag
tlen, ASN1Header -> ASN1Event
Header ASN1Header
h ASN1Event -> [ASN1Event] -> [ASN1Event]
forall a. a -> [a] -> [a]
: ASN1Event
ConstructionBegin ASN1Event -> [ASN1Event] -> [ASN1Event]
forall a. a -> [a] -> [a]
: [ASN1Event]
events [ASN1Event] -> [ASN1Event] -> [ASN1Event]
forall a. [a] -> [a] -> [a]
++ [ASN1Event
ConstructionEnd])
  where (ASN1Tag
clen, [ASN1Event]
events) = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
children
        len :: ASN1Length
len  = ASN1Tag -> ASN1Length
mkSmallestLength ASN1Tag
clen
        h :: ASN1Header
h    = Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader Bool
True ASN1Length
len ASN1
c
        tlen :: ASN1Tag
tlen = ByteString -> ASN1Tag
B.length (ASN1Header -> ByteString
putHeader ASN1Header
h) ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
clen

encodeConstructed ASN1
_ [ASN1]
_ = [Char] -> (ASN1Tag, [ASN1Event])
forall a. HasCallStack => [Char] -> a
error [Char]
"not a start node"

mkSmallestLength :: Int -> ASN1Length
mkSmallestLength :: ASN1Tag -> ASN1Length
mkSmallestLength ASN1Tag
i
    | ASN1Tag
i ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
< ASN1Tag
0x80  = ASN1Tag -> ASN1Length
LenShort ASN1Tag
i
    | Bool
otherwise = ASN1Tag -> ASN1Tag -> ASN1Length
LenLong (ASN1Tag -> ASN1Tag
forall t p. (Num p, Integral t) => t -> p
nbBytes ASN1Tag
i) ASN1Tag
i
        where nbBytes :: t -> p
nbBytes t
nb = if t
nb t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
255 then p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ t -> p
nbBytes (t
nb t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
256) else p
1

type ASN1Ret = Either ASN1Error ASN1

decodePrimitive :: ASN1Header -> B.ByteString -> ASN1Ret
decodePrimitive :: ASN1Header -> ByteString -> ASN1Ret
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x1 Bool
_ ASN1Length
_) ByteString
p   = Bool -> ByteString -> ASN1Ret
getBoolean Bool
False ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x2 Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getInteger ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x3 Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getBitString ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x4 Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getOctetString ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x5 Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getNull ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x6 Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getOID ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x7 Bool
_ ASN1Length
_) ByteString
_   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented [Char]
"Object Descriptor"
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x8 Bool
_ ASN1Length
_) ByteString
_   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented [Char]
"External"
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x9 Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getDouble ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0xa Bool
_ ASN1Length
_) ByteString
p   = ByteString -> ASN1Ret
getEnumerated ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0xb Bool
_ ASN1Length
_) ByteString
_   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented [Char]
"EMBEDDED PDV"
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0xc Bool
_ ASN1Length
_) ByteString
p   = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
UTF8 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0xd Bool
_ ASN1Length
_) ByteString
_   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented [Char]
"RELATIVE-OID"
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x10 Bool
_ ASN1Length
_) ByteString
_  = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypePrimitiveInvalid [Char]
"sequence"
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x11 Bool
_ ASN1Length
_) ByteString
_  = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypePrimitiveInvalid [Char]
"set"
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x12 Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Numeric ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x13 Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Printable ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x14 Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
T61 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x15 Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
VideoTex ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x16 Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
IA5 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x17 Bool
_ ASN1Length
_) ByteString
p  = ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
TimeUTC ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x18 Bool
_ ASN1Length
_) ByteString
p  = ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
TimeGeneralized ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x19 Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Graphic ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x1a Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Visible ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x1b Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
General ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x1c Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
UTF32 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x1d Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Character ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal ASN1Tag
0x1e Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
BMP ByteString
p
decodePrimitive (ASN1Header ASN1Class
tc        ASN1Tag
tag  Bool
_ ASN1Length
_) ByteString
p  = ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> ASN1 -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ ASN1Class -> ASN1Tag -> ByteString -> ASN1
Other ASN1Class
tc ASN1Tag
tag ByteString
p


getBoolean :: Bool -> ByteString -> Either ASN1Error ASN1
getBoolean :: Bool -> ByteString -> ASN1Ret
getBoolean Bool
isDer ByteString
s =
    if ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
1
        then case ByteString -> Word8
B.head ByteString
s of
            Word8
0    -> ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (Bool -> ASN1
Boolean Bool
False)
            Word8
0xff -> ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (Bool -> ASN1
Boolean Bool
True)
            Word8
_    -> if Bool
isDer then ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> ASN1Error
PolicyFailed [Char]
"DER" [Char]
"boolean value not canonical" else ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (Bool -> ASN1
Boolean Bool
True)
        else ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeDecodingFailed [Char]
"boolean: length not within bound"

{- | getInteger, parse a value bytestring and get the integer out of the two complement encoded bytes -}
getInteger :: ByteString -> Either ASN1Error ASN1
{-# INLINE getInteger #-}
getInteger :: ByteString -> ASN1Ret
getInteger ByteString
s = Integer -> ASN1
IntVal (Integer -> ASN1) -> Either ASN1Error Integer -> ASN1Ret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ByteString -> Either ASN1Error Integer
getIntegerRaw [Char]
"integer" ByteString
s

{- | getEnumerated, parse an enumerated value the same way that integer values are parsed. -}
getEnumerated :: ByteString -> Either ASN1Error ASN1
{-# INLINE getEnumerated #-}
getEnumerated :: ByteString -> ASN1Ret
getEnumerated ByteString
s = Integer -> ASN1
Enumerated (Integer -> ASN1) -> Either ASN1Error Integer -> ASN1Ret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ByteString -> Either ASN1Error Integer
getIntegerRaw [Char]
"enumerated" ByteString
s

{- | According to X.690 section 8.4 integer and enumerated values should be encoded the same way. -}
getIntegerRaw :: String -> ByteString -> Either ASN1Error Integer
getIntegerRaw :: [Char] -> ByteString -> Either ASN1Error Integer
getIntegerRaw [Char]
typestr ByteString
s
    | ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
0 = ASN1Error -> Either ASN1Error Integer
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error Integer)
-> ([Char] -> ASN1Error) -> [Char] -> Either ASN1Error Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ASN1Error
TypeDecodingFailed ([Char] -> Either ASN1Error Integer)
-> [Char] -> Either ASN1Error Integer
forall a b. (a -> b) -> a -> b
$ [Char]
typestr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": null encoding"
    | ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
1 = Integer -> Either ASN1Error Integer
forall a b. b -> Either a b
Right (Integer -> Either ASN1Error Integer)
-> Integer -> Either ASN1Error Integer
forall a b. (a -> b) -> a -> b
$ (ASN1Tag, Integer) -> Integer
forall a b. (a, b) -> b
snd ((ASN1Tag, Integer) -> Integer) -> (ASN1Tag, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> (ASN1Tag, Integer)
intOfBytes ByteString
s
    | Bool
otherwise       =
        if (Word8
v1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff Bool -> Bool -> Bool
&& Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
testBit Word8
v2 ASN1Tag
7) Bool -> Bool -> Bool
|| (Word8
v1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0 Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
testBit Word8
v2 ASN1Tag
7))
            then ASN1Error -> Either ASN1Error Integer
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error Integer)
-> ([Char] -> ASN1Error) -> [Char] -> Either ASN1Error Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ASN1Error
TypeDecodingFailed ([Char] -> Either ASN1Error Integer)
-> [Char] -> Either ASN1Error Integer
forall a b. (a -> b) -> a -> b
$ [Char]
typestr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": not shortest encoding"
            else Integer -> Either ASN1Error Integer
forall a b. b -> Either a b
Right (Integer -> Either ASN1Error Integer)
-> Integer -> Either ASN1Error Integer
forall a b. (a -> b) -> a -> b
$ (ASN1Tag, Integer) -> Integer
forall a b. (a, b) -> b
snd ((ASN1Tag, Integer) -> Integer) -> (ASN1Tag, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> (ASN1Tag, Integer)
intOfBytes ByteString
s
        where
            v1 :: Word8
v1 = ByteString
s ByteString -> ASN1Tag -> Word8
`B.index` ASN1Tag
0
            v2 :: Word8
v2 = ByteString
s ByteString -> ASN1Tag -> Word8
`B.index` ASN1Tag
1

getDouble :: ByteString -> Either ASN1Error ASN1
getDouble :: ByteString -> ASN1Ret
getDouble ByteString
s = Double -> ASN1
Real (Double -> ASN1) -> Either ASN1Error Double -> ASN1Ret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either ASN1Error Double
getDoubleRaw ByteString
s

getDoubleRaw :: ByteString -> Either ASN1Error Double
getDoubleRaw :: ByteString -> Either ASN1Error Double
getDoubleRaw ByteString
s
  | ByteString -> Bool
B.null ByteString
s  = Double -> Either ASN1Error Double
forall a b. b -> Either a b
Right Double
0
getDoubleRaw s :: ByteString
s@(ByteString -> Word8
B.unsafeHead -> Word8
h)
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x40 = Double -> Either ASN1Error Double
forall a b. b -> Either a b
Right (Double -> Either ASN1Error Double)
-> Double -> Either ASN1Error Double
forall a b. (a -> b) -> a -> b
$! (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)  -- Infinity
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x41 = Double -> Either ASN1Error Double
forall a b. b -> Either a b
Right (Double -> Either ASN1Error Double)
-> Double -> Either ASN1Error Double
forall a b. (a -> b) -> a -> b
$! (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) -- -Infinity
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x42 = Double -> Either ASN1Error Double
forall a b. b -> Either a b
Right (Double -> Either ASN1Error Double)
-> Double -> Either ASN1Error Double
forall a b. (a -> b) -> a -> b
$! (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)  -- NaN
  | Bool
otherwise = do
      let len :: ASN1Tag
len = ByteString -> ASN1Tag
B.length ByteString
s
      ASN1Tag
base <- case (Word8
h Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
`testBit` ASN1Tag
5, Word8
h Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
`testBit` ASN1Tag
4) of
                -- extract bits 5,4 for the base
                (Bool
False, Bool
False) -> ASN1Tag -> Either ASN1Error ASN1Tag
forall (m :: * -> *) a. Monad m => a -> m a
return ASN1Tag
2
                (Bool
False, Bool
True)  -> ASN1Tag -> Either ASN1Error ASN1Tag
forall (m :: * -> *) a. Monad m => a -> m a
return ASN1Tag
8
                (Bool
True,  Bool
False) -> ASN1Tag -> Either ASN1Error ASN1Tag
forall (m :: * -> *) a. Monad m => a -> m a
return ASN1Tag
16
                (Bool, Bool)
_              -> ASN1Error -> Either ASN1Error ASN1Tag
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error ASN1Tag)
-> ([Char] -> ASN1Error) -> [Char] -> Either ASN1Error ASN1Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ASN1Error
TypeDecodingFailed ([Char] -> Either ASN1Error ASN1Tag)
-> [Char] -> Either ASN1Error ASN1Tag
forall a b. (a -> b) -> a -> b
$ [Char]
"real: invalid base detected"
      -- check bit 6 for the sign
      let mkSigned :: Integer -> Integer
mkSigned = if Word8
h Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
`testBit` ASN1Tag
6 then Integer -> Integer
forall a. Num a => a -> a
negate else Integer -> Integer
forall a. a -> a
id
      -- extract bits 3,2 for the scaling factor
      let scaleFactor :: Word8
scaleFactor = (Word8
h Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0c) Word8 -> ASN1Tag -> Word8
forall a. Bits a => a -> ASN1Tag -> a
`shiftR` ASN1Tag
2
      Word8
expLength <- ASN1Tag -> Word8 -> ByteString -> Either ASN1Error Word8
getExponentLength ASN1Tag
len Word8
h ByteString
s
      -- 1 byte for the header, expLength for the exponent, and at least 1 byte for the mantissa
      Bool -> Either ASN1Error () -> Either ASN1Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ASN1Tag
len ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
> ASN1Tag
1 ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ Word8 -> ASN1Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
expLength) (Either ASN1Error () -> Either ASN1Error ())
-> Either ASN1Error () -> Either ASN1Error ()
forall a b. (a -> b) -> a -> b
$
        ASN1Error -> Either ASN1Error ()
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error ())
-> ([Char] -> ASN1Error) -> [Char] -> Either ASN1Error ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ASN1Error
TypeDecodingFailed ([Char] -> Either ASN1Error ()) -> [Char] -> Either ASN1Error ()
forall a b. (a -> b) -> a -> b
$ [Char]
"real: not enough input for exponent and mantissa"
      let (ASN1Tag
_, Integer
exp'') = ByteString -> (ASN1Tag, Integer)
intOfBytes (ByteString -> (ASN1Tag, Integer))
-> ByteString -> (ASN1Tag, Integer)
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ByteString -> ByteString
B.unsafeTake (Word8 -> ASN1Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
expLength) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ByteString -> ByteString
B.unsafeDrop ASN1Tag
1 ByteString
s
      let exp' :: Integer
exp' = case ASN1Tag
base :: Int of
                   ASN1Tag
2 -> Integer
exp''
                   ASN1Tag
8 -> Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
exp''
                   ASN1Tag
_ -> Integer
4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
exp'' -- must be 16
          exponent :: Integer
exponent = Integer
exp' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
scaleFactor
          -- whatever is leftover is the mantissa, unsigned
          (ASN1Tag
_, Integer
mantissa) = ByteString -> (ASN1Tag, Integer)
uintOfBytes (ByteString -> (ASN1Tag, Integer))
-> ByteString -> (ASN1Tag, Integer)
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ByteString -> ByteString
B.unsafeDrop (ASN1Tag
1 ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ Word8 -> ASN1Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
expLength) ByteString
s
      Double -> Either ASN1Error Double
forall a b. b -> Either a b
Right (Double -> Either ASN1Error Double)
-> Double -> Either ASN1Error Double
forall a b. (a -> b) -> a -> b
$! Integer -> ASN1Tag -> Double
forall a. RealFloat a => Integer -> ASN1Tag -> a
encodeFloat (Integer -> Integer
mkSigned (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
mantissa) (Integer -> ASN1Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
exponent)

getExponentLength :: Int -> Word8 -> ByteString -> Either ASN1Error Word8
getExponentLength :: ASN1Tag -> Word8 -> ByteString -> Either ASN1Error Word8
getExponentLength ASN1Tag
len Word8
h ByteString
s =
  case Word8
h Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x03 of
    Word8
l | Word8
l Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x03 -> do
          Bool -> Either ASN1Error () -> Either ASN1Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ASN1Tag
len ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
> ASN1Tag
1) (Either ASN1Error () -> Either ASN1Error ())
-> Either ASN1Error () -> Either ASN1Error ()
forall a b. (a -> b) -> a -> b
$ ASN1Error -> Either ASN1Error ()
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error ())
-> ([Char] -> ASN1Error) -> [Char] -> Either ASN1Error ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ASN1Error
TypeDecodingFailed ([Char] -> Either ASN1Error ()) -> [Char] -> Either ASN1Error ()
forall a b. (a -> b) -> a -> b
$ [Char]
"real: not enough input to decode exponent length"
          Word8 -> Either ASN1Error Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either ASN1Error Word8)
-> Word8 -> Either ASN1Error Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> ASN1Tag -> Word8
B.unsafeIndex ByteString
s ASN1Tag
1
      | Bool
otherwise -> Word8 -> Either ASN1Error Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either ASN1Error Word8)
-> Word8 -> Either ASN1Error Word8
forall a b. (a -> b) -> a -> b
$ Word8
l Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1

getBitString :: ByteString -> Either ASN1Error ASN1
getBitString :: ByteString -> ASN1Ret
getBitString ByteString
s =
    let toSkip :: Word8
toSkip = ByteString -> Word8
B.head ByteString
s in
    let toSkip' :: Word8
toSkip' = if Word8
toSkip Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
toSkip Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
48 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
7 then Word8
toSkip Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- (ASN1Tag -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ASN1Tag -> Word8) -> ASN1Tag -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> ASN1Tag
ord Char
'0') else Word8
toSkip in
    let xs :: ByteString
xs = ByteString -> ByteString
B.tail ByteString
s in
    if Word8
toSkip' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0 Bool -> Bool -> Bool
&& Word8
toSkip' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
7
        then ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> ASN1 -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ BitArray -> ASN1
BitString (BitArray -> ASN1) -> BitArray -> ASN1
forall a b. (a -> b) -> a -> b
$ ByteString -> ASN1Tag -> BitArray
toBitArray ByteString
xs (Word8 -> ASN1Tag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
toSkip')
        else ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeDecodingFailed ([Char]
"bitstring: skip number not within bound " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
toSkip' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
s)

getCharacterString :: ASN1StringEncoding -> ByteString -> Either ASN1Error ASN1
getCharacterString :: ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
encoding ByteString
bs = ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> ASN1 -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ ASN1CharacterString -> ASN1
ASN1String (ASN1StringEncoding -> ByteString -> ASN1CharacterString
ASN1CharacterString ASN1StringEncoding
encoding ByteString
bs)

getOctetString :: ByteString -> Either ASN1Error ASN1
getOctetString :: ByteString -> ASN1Ret
getOctetString = ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> (ByteString -> ASN1) -> ByteString -> ASN1Ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ASN1
OctetString

getNull :: ByteString -> Either ASN1Error ASN1
getNull :: ByteString -> ASN1Ret
getNull ByteString
s
    | ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
0 = ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right ASN1
Null
    | Bool
otherwise       = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeDecodingFailed [Char]
"Null: data length not within bound"

{- | return an OID -}
getOID :: ByteString -> Either ASN1Error ASN1
getOID :: ByteString -> ASN1Ret
getOID ByteString
s = ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> ASN1 -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ OID -> ASN1
OID (OID -> ASN1) -> OID -> ASN1
forall a b. (a -> b) -> a -> b
$ (Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
x Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`div` Word8
40) Integer -> OID -> OID
forall a. a -> [a] -> [a]
: Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
x Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`mod` Word8
40) Integer -> OID -> OID
forall a. a -> [a] -> [a]
: [Word8] -> OID
groupOID [Word8]
xs)
  where
        (Word8
x:[Word8]
xs) = ByteString -> [Word8]
B.unpack ByteString
s

        groupOID :: [Word8] -> [Integer]
        groupOID :: [Word8] -> OID
groupOID = ([Word8] -> Integer) -> [[Word8]] -> OID
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
acc Word8
n -> (Integer
acc Integer -> ASN1Tag -> Integer
forall a. Bits a => a -> ASN1Tag -> a
`shiftL` ASN1Tag
7) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Integer
0) ([[Word8]] -> OID) -> ([Word8] -> [[Word8]]) -> [Word8] -> OID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [[Word8]]
groupSubOID

        groupSubOIDHelper :: [a] -> Maybe ([a], [a])
groupSubOIDHelper [] = Maybe ([a], [a])
forall a. Maybe a
Nothing
        groupSubOIDHelper [a]
l  = ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a])) -> ([a], [a]) -> Maybe ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> ([a], [a])
forall a. Bits a => [a] -> ([a], [a])
spanSubOIDbound [a]
l

        groupSubOID :: [Word8] -> [[Word8]]
        groupSubOID :: [Word8] -> [[Word8]]
groupSubOID = ([Word8] -> Maybe ([Word8], [Word8])) -> [Word8] -> [[Word8]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [Word8] -> Maybe ([Word8], [Word8])
forall a. Bits a => [a] -> Maybe ([a], [a])
groupSubOIDHelper

        spanSubOIDbound :: [a] -> ([a], [a])
spanSubOIDbound [] = ([], [])
        spanSubOIDbound (a
a:[a]
as) = if a -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
testBit a
a ASN1Tag
7 then (a -> ASN1Tag -> a
forall a. Bits a => a -> ASN1Tag -> a
clearBit a
a ASN1Tag
7 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys, [a]
zs) else ([a
a], [a]
as)
            where ([a]
ys, [a]
zs) = [a] -> ([a], [a])
spanSubOIDbound [a]
as

getTime :: ASN1TimeType -> ByteString -> Either ASN1Error ASN1
getTime :: ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
timeType ByteString
bs
    | ByteString -> Bool
hasNonASCII ByteString
bs = [Char] -> ASN1Ret
forall b. [Char] -> Either ASN1Error b
decodingError [Char]
"contains non ASCII characters"
    | Bool
otherwise      =
        case [Char]
-> [Char] -> Either (TimeFormatElem, [Char]) (DateTime, [Char])
forall format.
TimeFormat format =>
format
-> [Char] -> Either (TimeFormatElem, [Char]) (DateTime, [Char])
timeParseE [Char]
format (ByteString -> [Char]
BC.unpack ByteString
bs) of -- BC.unpack is safe as we check ASCIIness first
            Left (TimeFormatElem, [Char])
_  ->
                case [Char]
-> [Char] -> Either (TimeFormatElem, [Char]) (DateTime, [Char])
forall format.
TimeFormat format =>
format
-> [Char] -> Either (TimeFormatElem, [Char]) (DateTime, [Char])
timeParseE [Char]
formatNoSeconds (ByteString -> [Char]
BC.unpack ByteString
bs) of
                    Left (TimeFormatElem, [Char])
_  -> [Char] -> ASN1Ret
forall b. [Char] -> Either ASN1Error b
decodingError ([Char]
"cannot convert string " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack ByteString
bs)
                    Right (DateTime, [Char])
r -> (DateTime, [Char]) -> ASN1Ret
parseRemaining (DateTime, [Char])
r
            Right (DateTime, [Char])
r -> (DateTime, [Char]) -> ASN1Ret
parseRemaining (DateTime, [Char])
r
  where
        parseRemaining :: (DateTime, [Char]) -> ASN1Ret
parseRemaining (DateTime, [Char])
r =
            case (DateTime, [Char])
-> Either [Char] (DateTime, Maybe TimezoneOffset)
forall a. (a, [Char]) -> Either [Char] (a, Maybe TimezoneOffset)
parseTimezone ((DateTime, [Char])
 -> Either [Char] (DateTime, Maybe TimezoneOffset))
-> (DateTime, [Char])
-> Either [Char] (DateTime, Maybe TimezoneOffset)
forall a b. (a -> b) -> a -> b
$ (DateTime, [Char]) -> (DateTime, [Char])
parseMs ((DateTime, [Char]) -> (DateTime, [Char]))
-> (DateTime, [Char]) -> (DateTime, [Char])
forall a b. (a -> b) -> a -> b
$ (DateTime -> DateTime) -> (DateTime, [Char]) -> (DateTime, [Char])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DateTime -> DateTime
adjustUTC (DateTime, [Char])
r of
                Left [Char]
err        -> [Char] -> ASN1Ret
forall b. [Char] -> Either ASN1Error b
decodingError [Char]
err
                Right (DateTime
dt', Maybe TimezoneOffset
tz) -> ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> ASN1 -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ASN1
ASN1Time ASN1TimeType
timeType DateTime
dt' Maybe TimezoneOffset
tz

        adjustUTC :: DateTime -> DateTime
adjustUTC dt :: DateTime
dt@(DateTime (Date ASN1Tag
y Month
m ASN1Tag
d) TimeOfDay
tod)
            | ASN1TimeType
timeType ASN1TimeType -> ASN1TimeType -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1TimeType
TimeGeneralized = DateTime
dt
            | ASN1Tag
y ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
> ASN1Tag
2050                    = Date -> TimeOfDay -> DateTime
DateTime (ASN1Tag -> Month -> ASN1Tag -> Date
Date (ASN1Tag
y ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
- ASN1Tag
100) Month
m ASN1Tag
d) TimeOfDay
tod
            | Bool
otherwise                   = DateTime
dt
        formatNoSeconds :: [Char]
formatNoSeconds = [Char] -> [Char]
forall a. [a] -> [a]
init [Char]
format
        format :: [Char]
format | ASN1TimeType
timeType ASN1TimeType -> ASN1TimeType -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1TimeType
TimeGeneralized = Char
'Y'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'Y'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
baseFormat
               | Bool
otherwise                   = [Char]
baseFormat
        baseFormat :: [Char]
baseFormat = [Char]
"YYMMDDHMIS"

        parseMs :: (DateTime, [Char]) -> (DateTime, [Char])
parseMs (DateTime
dt,[Char]
s) =
            case [Char]
s of
                Char
'.':[Char]
s' -> let (NanoSeconds
ns, [Char]
r) = ([Char] -> NanoSeconds)
-> ([Char], [Char]) -> (NanoSeconds, [Char])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [Char] -> NanoSeconds
toNano (([Char], [Char]) -> (NanoSeconds, [Char]))
-> ([Char], [Char]) -> (NanoSeconds, [Char])
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength ASN1Tag
3 Char -> Bool
isDigit [Char]
s'
                           in (DateTime
dt { dtTime :: TimeOfDay
dtTime = (DateTime -> TimeOfDay
dtTime DateTime
dt) { todNSec :: NanoSeconds
todNSec = NanoSeconds
ns } }, [Char]
r)
                [Char]
_      -> (DateTime
dt,[Char]
s)
        parseTimezone :: (a, [Char]) -> Either [Char] (a, Maybe TimezoneOffset)
parseTimezone (a
dt,[Char]
s) =
            case [Char]
s of
                Char
'+':[Char]
s' -> (a, Maybe TimezoneOffset)
-> Either [Char] (a, Maybe TimezoneOffset)
forall a b. b -> Either a b
Right (a
dt, (ASN1Tag -> ASN1Tag) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat ASN1Tag -> ASN1Tag
forall a. a -> a
id [Char]
s')
                Char
'-':[Char]
s' -> (a, Maybe TimezoneOffset)
-> Either [Char] (a, Maybe TimezoneOffset)
forall a b. b -> Either a b
Right (a
dt, (ASN1Tag -> ASN1Tag) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat ((-ASN1Tag
1) ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
*) [Char]
s')
                Char
'Z':[] -> (a, Maybe TimezoneOffset)
-> Either [Char] (a, Maybe TimezoneOffset)
forall a b. b -> Either a b
Right (a
dt, TimezoneOffset -> Maybe TimezoneOffset
forall a. a -> Maybe a
Just TimezoneOffset
timezone_UTC)
                [Char]
""     -> (a, Maybe TimezoneOffset)
-> Either [Char] (a, Maybe TimezoneOffset)
forall a b. b -> Either a b
Right (a
dt, Maybe TimezoneOffset
forall a. Maybe a
Nothing)
                [Char]
_      -> [Char] -> Either [Char] (a, Maybe TimezoneOffset)
forall a b. a -> Either a b
Left ([Char]
"unknown timezone format: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)

        parseTimezoneFormat :: (ASN1Tag -> ASN1Tag) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat ASN1Tag -> ASN1Tag
transform [Char]
s
            | [Char] -> ASN1Tag
forall (t :: * -> *) a. Foldable t => t a -> ASN1Tag
length [Char]
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1Tag
4  = TimezoneOffset -> Maybe TimezoneOffset
forall a. a -> Maybe a
Just (TimezoneOffset -> Maybe TimezoneOffset)
-> TimezoneOffset -> Maybe TimezoneOffset
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> TimezoneOffset
toTz (ASN1Tag -> TimezoneOffset) -> ASN1Tag -> TimezoneOffset
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Tag
toInt ([Char] -> ASN1Tag) -> [Char] -> ASN1Tag
forall a b. (a -> b) -> a -> b
$ ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> [Char]
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength ASN1Tag
4 Char -> Bool
isDigit [Char]
s
            | Bool
otherwise      = Maybe TimezoneOffset
forall a. Maybe a
Nothing
          where toTz :: ASN1Tag -> TimezoneOffset
toTz ASN1Tag
z = let (ASN1Tag
h,ASN1Tag
m) = ASN1Tag
z ASN1Tag -> ASN1Tag -> (ASN1Tag, ASN1Tag)
forall a. Integral a => a -> a -> (a, a)
`divMod` ASN1Tag
100 in ASN1Tag -> TimezoneOffset
TimezoneOffset (ASN1Tag -> TimezoneOffset) -> ASN1Tag -> TimezoneOffset
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ASN1Tag
transform (ASN1Tag
h ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
* ASN1Tag
60 ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
m)

        toNano :: String -> NanoSeconds
        toNano :: [Char] -> NanoSeconds
toNano [Char]
l = ASN1Tag -> NanoSeconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Char] -> ASN1Tag
toInt [Char]
l ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
* ASN1Tag
order ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
* ASN1Tag
1000000)
          where len :: ASN1Tag
len   = [Char] -> ASN1Tag
forall (t :: * -> *) a. Foldable t => t a -> ASN1Tag
length [Char]
l
                order :: ASN1Tag
order = case ASN1Tag
len of
                            ASN1Tag
1 -> ASN1Tag
100
                            ASN1Tag
2 -> ASN1Tag
10
                            ASN1Tag
3 -> ASN1Tag
1
                            ASN1Tag
_ -> ASN1Tag
1

        spanToLength :: Int -> (Char -> Bool) -> String -> (String, String)
        spanToLength :: ASN1Tag -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength ASN1Tag
len Char -> Bool
p [Char]
l = ASN1Tag -> [Char] -> ([Char], [Char])
loop ASN1Tag
0 [Char]
l
          where loop :: ASN1Tag -> [Char] -> ([Char], [Char])
loop ASN1Tag
i [Char]
z
                    | ASN1Tag
i ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
>= ASN1Tag
len  = ([], [Char]
z)
                    | Bool
otherwise = case [Char]
z of
                                    []   -> ([], [])
                                    Char
x:[Char]
xs -> if Char -> Bool
p Char
x
                                                then let ([Char]
r1,[Char]
r2) = ASN1Tag -> [Char] -> ([Char], [Char])
loop (ASN1Tag
iASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ASN1Tag
1) [Char]
xs
                                                      in (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
r1, [Char]
r2)
                                                else ([], [Char]
z)

        toInt :: String -> Int
        toInt :: [Char] -> ASN1Tag
toInt = (ASN1Tag -> Char -> ASN1Tag) -> ASN1Tag -> [Char] -> ASN1Tag
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ASN1Tag
acc Char
w -> ASN1Tag
acc ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
* ASN1Tag
10 ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ (Char -> ASN1Tag
ord Char
w ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
- Char -> ASN1Tag
ord Char
'0')) ASN1Tag
0

        decodingError :: [Char] -> Either ASN1Error b
decodingError [Char]
reason = ASN1Error -> Either ASN1Error b
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error b)
-> ASN1Error -> Either ASN1Error b
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeDecodingFailed ([Char]
"time format invalid for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ASN1TimeType -> [Char]
forall a. Show a => a -> [Char]
show ASN1TimeType
timeType [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
reason)
        hasNonASCII :: ByteString -> Bool
hasNonASCII = Bool -> (Word8 -> Bool) -> Maybe Word8 -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True) (Maybe Word8 -> Bool)
-> (ByteString -> Maybe Word8) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> Maybe Word8
B.find (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7f)

-- FIXME need msec printed
putTime :: ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ByteString
putTime :: ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ByteString
putTime ASN1TimeType
ty DateTime
dt Maybe TimezoneOffset
mtz = [Char] -> ByteString
BC.pack [Char]
etime
  where
        etime :: [Char]
etime
            | ASN1TimeType
ty ASN1TimeType -> ASN1TimeType -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1TimeType
TimeUTC = [Char] -> DateTime -> [Char]
forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> [Char]
timePrint [Char]
"YYMMDDHMIS" DateTime
dt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tzStr
            | Bool
otherwise     = [Char] -> DateTime -> [Char]
forall format t.
(TimeFormat format, Timeable t) =>
format -> t -> [Char]
timePrint [Char]
"YYYYMMDDHMIS" DateTime
dt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
forall a. [a]
msecStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
tzStr
        msecStr :: [a]
msecStr = []
        tzStr :: [Char]
tzStr = case Maybe TimezoneOffset
mtz of
                     Maybe TimezoneOffset
Nothing                      -> [Char]
""
                     Just TimezoneOffset
tz | TimezoneOffset
tz TimezoneOffset -> TimezoneOffset -> Bool
forall a. Eq a => a -> a -> Bool
== TimezoneOffset
timezone_UTC -> [Char]
"Z"
                             | Bool
otherwise          -> TimezoneOffset -> [Char]
forall a. Show a => a -> [Char]
show TimezoneOffset
tz

putInteger :: Integer -> ByteString
putInteger :: Integer -> ByteString
putInteger Integer
i = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> [Word8]
bytesOfInt Integer
i

putBitString :: BitArray -> ByteString
putBitString :: BitArray -> ByteString
putBitString (BitArray Word64
n ByteString
bits) =
    [ByteString] -> ByteString
B.concat [Word8 -> ByteString
B.singleton (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i),ByteString
bits]
  where i :: Word64
i = (Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Word64
n Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
8)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x7

putString :: ByteString -> ByteString
putString :: ByteString -> ByteString
putString ByteString
l = ByteString
l

{- no enforce check that oid1 is between [0..2] and oid2 is between [0..39] -}
putOID :: [Integer] -> ByteString
putOID :: OID -> ByteString
putOID OID
oids = case OID
oids of
    (Integer
oid1:Integer
oid2:OID
suboids) ->
        let eoidclass :: Word8
eoidclass = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
oid1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
40 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
oid2)
            subeoids :: ByteString
subeoids  = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> ByteString) -> OID -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> ByteString
forall i. (Bits i, Integral i) => i -> ByteString
encode OID
suboids
         in Word8 -> ByteString -> ByteString
B.cons Word8
eoidclass ByteString
subeoids
    OID
_                   -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid OID format " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ OID -> [Char]
forall a. Show a => a -> [Char]
show OID
oids)
  where
        encode :: i -> ByteString
encode i
x | i
x i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0    = Word8 -> ByteString
B.singleton Word8
0
                 | Bool
otherwise = i -> ByteString
forall i. (Bits i, Integral i) => i -> ByteString
putVarEncodingIntegral i
x

putDouble :: Double -> ByteString
putDouble :: Double -> ByteString
putDouble Double
d
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = [Word8] -> ByteString
B.pack []
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) = [Word8] -> ByteString
B.pack [Word8
0x40]
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Double
forall a. Num a => a -> a
negate (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) = [Word8] -> ByteString
B.pack [Word8
0x41]
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d = [Word8] -> ByteString
B.pack [Word8
0x42]
  | Bool
otherwise = Word8 -> ByteString -> ByteString
B.cons (Word8
header Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
expLen Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1)) -- encode length of exponent
                (ByteString
expBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
manBS)
  where
  (Integer -> Integer
mkUnsigned, Word8
header)
    | Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0     = (Integer -> Integer
forall a. Num a => a -> a
negate, Word8
bINARY_NEGATIVE_NUMBER_ID)
    | Bool
otherwise = (Integer -> Integer
forall a. a -> a
id, Word8
bINARY_POSITIVE_NUMBER_ID)
  (Integer
man, ASN1Tag
exp) = Double -> (Integer, ASN1Tag)
forall a. RealFloat a => a -> (Integer, ASN1Tag)
decodeFloat Double
d
  (Word64
mantissa, ASN1Tag
exponent) = (Word64, ASN1Tag) -> (Word64, ASN1Tag)
normalize (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
mkUnsigned Integer
man, ASN1Tag
exp)
  expBS :: ByteString
expBS = Integer -> ByteString
putInteger (ASN1Tag -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ASN1Tag
exponent)
  expLen :: Word8
expLen = ASN1Tag -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ASN1Tag
B.length ByteString
expBS)
  manBS :: ByteString
manBS = Integer -> ByteString
putInteger (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
mantissa)

-- | Normalize the mantissa and adjust the exponent.
--
-- DER requires the mantissa to either be 0 or odd, so we right-shift it
-- until the LSB is 1, and then add the shift amount to the exponent.
--
-- TODO: handle denormal numbers
normalize :: (Word64, Int) -> (Word64, Int)
normalize :: (Word64, ASN1Tag) -> (Word64, ASN1Tag)
normalize (Word64
mantissa, ASN1Tag
exponent) = (Word64
mantissa Word64 -> ASN1Tag -> Word64
forall a. Bits a => a -> ASN1Tag -> a
`shiftR` ASN1Tag
sh, ASN1Tag
exponent ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
sh)
  where
    sh :: ASN1Tag
sh = Word64 -> ASN1Tag
forall b. FiniteBits b => b -> ASN1Tag
countTrailingZeros Word64
mantissa

#if !(MIN_VERSION_base(4,8,0))
    countTrailingZeros :: FiniteBits b => b -> Int
    countTrailingZeros x = go 0
      where
        go i | i >= w      = i
             | testBit x i = i
             | otherwise   = go (i+1)
        w = finiteBitSize x
#endif

bINARY_POSITIVE_NUMBER_ID, bINARY_NEGATIVE_NUMBER_ID :: Word8
bINARY_POSITIVE_NUMBER_ID :: Word8
bINARY_POSITIVE_NUMBER_ID = Word8
0x80
bINARY_NEGATIVE_NUMBER_ID :: Word8
bINARY_NEGATIVE_NUMBER_ID = Word8
0xc0