-- |
-- 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 pc :: Bool
pc len :: ASN1Length
len (Boolean _)                = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x1 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (IntVal _)                 = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x2 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (BitString _)              = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x3 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (OctetString _)            = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x4 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len Null                       = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x5 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (OID _)                    = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x6 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (Real _)                   = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x9 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (Enumerated _)             = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0xa Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (ASN1String cs :: 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 UTF8      = 0xc
        characterStringType Numeric   = 0x12
        characterStringType Printable = 0x13
        characterStringType T61       = 0x14
        characterStringType VideoTex  = 0x15
        characterStringType IA5       = 0x16
        characterStringType Graphic   = 0x19
        characterStringType Visible   = 0x1a
        characterStringType General   = 0x1b
        characterStringType UTF32     = 0x1c
        characterStringType Character = 0x1d
        characterStringType BMP       = 0x1e
encodeHeader pc :: Bool
pc len :: ASN1Length
len (ASN1Time TimeUTC _ _)     = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x17 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (ASN1Time TimeGeneralized _ _) = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x18 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (Start Sequence)           = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x10 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (Start Set)                = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal 0x11 Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (Start (Container tc :: ASN1Class
tc tag :: ASN1Tag
tag)) = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
tc ASN1Tag
tag Bool
pc ASN1Length
len
encodeHeader pc :: Bool
pc len :: ASN1Length
len (Other tc :: ASN1Class
tc tag :: ASN1Tag
tag _)           = ASN1Class -> ASN1Tag -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
tc ASN1Tag
tag Bool
pc ASN1Length
len
encodeHeader _ _ (End _)                       = [Char] -> ASN1Header
forall a. HasCallStack => [Char] -> a
error "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 b :: Bool
b)         = Word8 -> ByteString
B.singleton (if Bool
b then 0xff else 0)
encodePrimitiveData (IntVal i :: Integer
i)          = Integer -> ByteString
putInteger Integer
i
encodePrimitiveData (BitString bits :: BitArray
bits)    = BitArray -> ByteString
putBitString BitArray
bits
encodePrimitiveData (OctetString b :: ByteString
b)     = ByteString -> ByteString
putString ByteString
b
encodePrimitiveData Null                = ByteString
B.empty
encodePrimitiveData (OID oidv :: OID
oidv)          = OID -> ByteString
putOID OID
oidv
encodePrimitiveData (Real d :: Double
d)            = Double -> ByteString
putDouble Double
d
encodePrimitiveData (Enumerated i :: 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 cs :: ASN1CharacterString
cs)     = ASN1CharacterString -> ByteString
getCharacterStringRawData ASN1CharacterString
cs
encodePrimitiveData (ASN1Time ty :: ASN1TimeType
ty ti :: DateTime
ti tz :: Maybe TimezoneOffset
tz) = ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ByteString
putTime ASN1TimeType
ty DateTime
ti Maybe TimezoneOffset
tz
encodePrimitiveData (Other _ _ b :: ByteString
b)       = ByteString
b
encodePrimitiveData o :: ASN1
o                   = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ("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 a :: 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 len :: ASN1Tag
len
            | ASN1Tag
len ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
< 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 nb :: t
nb = if t
nb t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> 255 then 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` 256) else 1

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

encodeList :: [ASN1] -> (Int, [ASN1Event])
encodeList :: [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList []               = (0, [])
encodeList (End _:xs :: [ASN1]
xs)       = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
xs
encodeList (t :: ASN1
t@(Start _):xs :: [ASN1]
xs) =
    let (ys :: [ASN1]
ys, zs :: [ASN1]
zs)    = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd 0 [ASN1]
xs
        (llen :: ASN1Tag
llen, lev :: [ASN1Event]
lev) = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
zs
        (len :: ASN1Tag
len, ev :: [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 (x :: ASN1
x:xs :: [ASN1]
xs)           =
    let (llen :: ASN1Tag
llen, lev :: [ASN1Event]
lev) = [ASN1] -> (ASN1Tag, [ASN1Event])
encodeList [ASN1]
xs
        (len :: ASN1Tag
len, ev :: [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 _) children :: [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 (clen :: ASN1Tag
clen, events :: [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 _ _ = [Char] -> (ASN1Tag, [ASN1Event])
forall a. HasCallStack => [Char] -> a
error "not a start node"

mkSmallestLength :: Int -> ASN1Length
mkSmallestLength :: ASN1Tag -> ASN1Length
mkSmallestLength i :: ASN1Tag
i
    | ASN1Tag
i ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
< 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 nb :: t
nb = if t
nb t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> 255 then 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` 256) else 1

type ASN1Ret = Either ASN1Error ASN1

decodePrimitive :: ASN1Header -> B.ByteString -> ASN1Ret
decodePrimitive :: ASN1Header -> ByteString -> ASN1Ret
decodePrimitive (ASN1Header Universal 0x1 _ _) p :: ByteString
p   = Bool -> ByteString -> ASN1Ret
getBoolean Bool
False ByteString
p
decodePrimitive (ASN1Header Universal 0x2 _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getInteger ByteString
p
decodePrimitive (ASN1Header Universal 0x3 _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getBitString ByteString
p
decodePrimitive (ASN1Header Universal 0x4 _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getOctetString ByteString
p
decodePrimitive (ASN1Header Universal 0x5 _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getNull ByteString
p
decodePrimitive (ASN1Header Universal 0x6 _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getOID ByteString
p
decodePrimitive (ASN1Header Universal 0x7 _ _) _   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented "Object Descriptor"
decodePrimitive (ASN1Header Universal 0x8 _ _) _   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented "External"
decodePrimitive (ASN1Header Universal 0x9 _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getDouble ByteString
p
decodePrimitive (ASN1Header Universal 0xa _ _) p :: ByteString
p   = ByteString -> ASN1Ret
getEnumerated ByteString
p
decodePrimitive (ASN1Header Universal 0xb _ _) _   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented "EMBEDDED PDV"
decodePrimitive (ASN1Header Universal 0xc _ _) p :: ByteString
p   = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
UTF8 ByteString
p
decodePrimitive (ASN1Header Universal 0xd _ _) _   = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypeNotImplemented "RELATIVE-OID"
decodePrimitive (ASN1Header Universal 0x10 _ _) _  = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypePrimitiveInvalid "sequence"
decodePrimitive (ASN1Header Universal 0x11 _ _) _  = ASN1Error -> ASN1Ret
forall a b. a -> Either a b
Left (ASN1Error -> ASN1Ret) -> ASN1Error -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Char] -> ASN1Error
TypePrimitiveInvalid "set"
decodePrimitive (ASN1Header Universal 0x12 _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Numeric ByteString
p
decodePrimitive (ASN1Header Universal 0x13 _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Printable ByteString
p
decodePrimitive (ASN1Header Universal 0x14 _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
T61 ByteString
p
decodePrimitive (ASN1Header Universal 0x15 _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
VideoTex ByteString
p
decodePrimitive (ASN1Header Universal 0x16 _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
IA5 ByteString
p
decodePrimitive (ASN1Header Universal 0x17 _ _) p :: ByteString
p  = ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
TimeUTC ByteString
p
decodePrimitive (ASN1Header Universal 0x18 _ _) p :: ByteString
p  = ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
TimeGeneralized ByteString
p
decodePrimitive (ASN1Header Universal 0x19 _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Graphic ByteString
p
decodePrimitive (ASN1Header Universal 0x1a _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Visible ByteString
p
decodePrimitive (ASN1Header Universal 0x1b _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
General ByteString
p
decodePrimitive (ASN1Header Universal 0x1c _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
UTF32 ByteString
p
decodePrimitive (ASN1Header Universal 0x1d _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Character ByteString
p
decodePrimitive (ASN1Header Universal 0x1e _ _) p :: ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
BMP ByteString
p
decodePrimitive (ASN1Header tc :: ASN1Class
tc        tag :: ASN1Tag
tag  _ _) p :: 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 isDer :: Bool
isDer s :: ByteString
s =
    if ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== 1
        then case ByteString -> Word8
B.head ByteString
s of
            0    -> ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (Bool -> ASN1
Boolean Bool
False)
            0xff -> ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (Bool -> ASN1
Boolean Bool
True)
            _    -> 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 "DER" "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 "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 s :: 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 "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 s :: 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 "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 typestr :: [Char]
typestr s :: ByteString
s
    | ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== 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]
++ ": null encoding"
    | ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== 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
== 0xff Bool -> Bool -> Bool
&& Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
testBit Word8
v2 7) Bool -> Bool -> Bool
|| (Word8
v1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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 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]
++ ": 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` 0
            v2 :: Word8
v2 = ByteString
s ByteString -> ASN1Tag -> Word8
`B.index` 1

getDouble :: ByteString -> Either ASN1Error ASN1
getDouble :: ByteString -> ASN1Ret
getDouble s :: 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 s :: ByteString
s
  | ByteString -> Bool
B.null ByteString
s  = Double -> Either ASN1Error Double
forall a b. b -> Either a b
Right 0
getDoubleRaw s :: ByteString
s@(ByteString -> Word8
B.unsafeHead -> Word8
h)
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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
$! (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0)  -- Infinity
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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
$! (-1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0) -- -Infinity
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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
$! (0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/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` 5, Word8
h Word8 -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
`testBit` 4) of
                -- extract bits 5,4 for the base
                (False, False) -> ASN1Tag -> Either ASN1Error ASN1Tag
forall (m :: * -> *) a. Monad m => a -> m a
return 2
                (False, True)  -> ASN1Tag -> Either ASN1Error ASN1Tag
forall (m :: * -> *) a. Monad m => a -> m a
return 8
                (True,  False) -> ASN1Tag -> Either ASN1Error ASN1Tag
forall (m :: * -> *) a. Monad m => a -> m a
return 16
                _              -> 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
$ "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` 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
.&. 0x0c) Word8 -> ASN1Tag -> Word8
forall a. Bits a => a -> ASN1Tag -> a
`shiftR` 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
> 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
$ "real: not enough input for exponent and mantissa"
      let (_, exp'' :: 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 1 ByteString
s
      let exp' :: Integer
exp' = case ASN1Tag
base :: Int of
                   2 -> Integer
exp''
                   8 -> 3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
exp''
                   _ -> 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
          (_, mantissa :: Integer
mantissa) = ByteString -> (ASN1Tag, Integer)
uintOfBytes (ByteString -> (ASN1Tag, Integer))
-> ByteString -> (ASN1Tag, Integer)
forall a b. (a -> b) -> a -> b
$ ASN1Tag -> ByteString -> ByteString
B.unsafeDrop (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 len :: ASN1Tag
len h :: Word8
h s :: ByteString
s =
  case Word8
h Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x03 of
    l :: Word8
l | Word8
l Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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
> 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
$ "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 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
+ 1

getBitString :: ByteString -> Either ASN1Error ASN1
getBitString :: ByteString -> ASN1Ret
getBitString s :: 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
>= 48 Bool -> Bool -> Bool
&& Word8
toSkip Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 48 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 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 '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
>= 0 Bool -> Bool -> Bool
&& Word8
toSkip' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 ("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]
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 encoding :: ASN1StringEncoding
encoding bs :: 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 s :: ByteString
s
    | ByteString -> ASN1Tag
B.length ByteString
s ASN1Tag -> ASN1Tag -> Bool
forall a. Eq a => a -> a -> Bool
== 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 "Null: data length not within bound"

{- | return an OID -}
getOID :: ByteString -> Either ASN1Error ASN1
getOID :: ByteString -> ASN1Ret
getOID s :: 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` 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` 40) Integer -> OID -> OID
forall a. a -> [a] -> [a]
: [Word8] -> OID
groupOID [Word8]
xs)
  where
        (x :: Word8
x:xs :: [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 (\acc :: Integer
acc n :: Word8
n -> (Integer
acc Integer -> ASN1Tag -> Integer
forall a. Bits a => a -> ASN1Tag -> a
`shiftL` 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) 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 l :: [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 :: [a]
as) = if a -> ASN1Tag -> Bool
forall a. Bits a => a -> ASN1Tag -> Bool
testBit a
a 7 then (a -> ASN1Tag -> a
forall a. Bits a => a -> ASN1Tag -> a
clearBit a
a 7 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys, [a]
zs) else ([a
a], [a]
as)
            where (ys :: [a]
ys, zs :: [a]
zs) = [a] -> ([a], [a])
spanSubOIDbound [a]
as

getTime :: ASN1TimeType -> ByteString -> Either ASN1Error ASN1
getTime :: ASN1TimeType -> ByteString -> ASN1Ret
getTime timeType :: ASN1TimeType
timeType bs :: ByteString
bs
    | ByteString -> Bool
hasNonASCII ByteString
bs = [Char] -> ASN1Ret
forall b. [Char] -> Either ASN1Error b
decodingError "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 _  ->
                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 _  -> [Char] -> ASN1Ret
forall b. [Char] -> Either ASN1Error b
decodingError ("cannot convert string " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack ByteString
bs)
                    Right r :: (DateTime, [Char])
r -> (DateTime, [Char]) -> ASN1Ret
parseRemaining (DateTime, [Char])
r
            Right r :: (DateTime, [Char])
r -> (DateTime, [Char]) -> ASN1Ret
parseRemaining (DateTime, [Char])
r
  where
        parseRemaining :: (DateTime, [Char]) -> ASN1Ret
parseRemaining r :: (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 err :: [Char]
err        -> [Char] -> ASN1Ret
forall b. [Char] -> Either ASN1Error b
decodingError [Char]
err
                Right (dt' :: DateTime
dt', tz :: 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 y :: ASN1Tag
y m :: Month
m d :: ASN1Tag
d) tod :: 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
> 2050                    = Date -> TimeOfDay -> DateTime
DateTime (ASN1Tag -> Month -> ASN1Tag -> Date
Date (ASN1Tag
y ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
- 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 = 'Y'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:'Y'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
baseFormat
               | Bool
otherwise                   = [Char]
baseFormat
        baseFormat :: [Char]
baseFormat = "YYMMDDHMIS"

        parseMs :: (DateTime, [Char]) -> (DateTime, [Char])
parseMs (dt :: DateTime
dt,s :: [Char]
s) =
            case [Char]
s of
                '.':s' :: [Char]
s' -> let (ns :: NanoSeconds
ns, r :: [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 3 Char -> Bool
isDigit [Char]
s'
                           in (DateTime
dt { dtTime :: TimeOfDay
dtTime = (DateTime -> TimeOfDay
dtTime DateTime
dt) { todNSec :: NanoSeconds
todNSec = NanoSeconds
ns } }, [Char]
r)
                _      -> (DateTime
dt,[Char]
s)
        parseTimezone :: (a, [Char]) -> Either [Char] (a, Maybe TimezoneOffset)
parseTimezone (dt :: a
dt,s :: [Char]
s) =
            case [Char]
s of
                '+':s' :: [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')
                '-':s' :: [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 ((-1) ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
*) [Char]
s')
                '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)
                ""     -> (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] -> Either [Char] (a, Maybe TimezoneOffset)
forall a b. a -> Either a b
Left ("unknown timezone format: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s)

        parseTimezoneFormat :: (ASN1Tag -> ASN1Tag) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat transform :: ASN1Tag -> ASN1Tag
transform s :: [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
== 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 4 Char -> Bool
isDigit [Char]
s
            | Bool
otherwise      = Maybe TimezoneOffset
forall a. Maybe a
Nothing
          where toTz :: ASN1Tag -> TimezoneOffset
toTz z :: ASN1Tag
z = let (h :: ASN1Tag
h,m :: ASN1Tag
m) = ASN1Tag
z ASN1Tag -> ASN1Tag -> (ASN1Tag, ASN1Tag)
forall a. Integral a => a -> a -> (a, a)
`divMod` 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
* 60 ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+ ASN1Tag
m)

        toNano :: String -> NanoSeconds
        toNano :: [Char] -> NanoSeconds
toNano l :: [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
* 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
                            1 -> 100
                            2 -> 10
                            3 -> 1
                            _ -> 1

        spanToLength :: Int -> (Char -> Bool) -> String -> (String, String)
        spanToLength :: ASN1Tag -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength len :: ASN1Tag
len p :: Char -> Bool
p l :: [Char]
l = ASN1Tag -> [Char] -> ([Char], [Char])
loop 0 [Char]
l
          where loop :: ASN1Tag -> [Char] -> ([Char], [Char])
loop i :: ASN1Tag
i z :: [Char]
z
                    | ASN1Tag
i ASN1Tag -> ASN1Tag -> Bool
forall a. Ord a => a -> a -> Bool
>= ASN1Tag
len  = ([], [Char]
z)
                    | Bool
otherwise = case [Char]
z of
                                    []   -> ([], [])
                                    x :: Char
x:xs :: [Char]
xs -> if Char -> Bool
p Char
x
                                                then let (r1 :: [Char]
r1,r2 :: [Char]
r2) = ASN1Tag -> [Char] -> ([Char], [Char])
loop (ASN1Tag
iASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
+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 (\acc :: ASN1Tag
acc w :: Char
w -> ASN1Tag
acc ASN1Tag -> ASN1Tag -> ASN1Tag
forall a. Num a => a -> a -> a
* 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 '0')) 0

        decodingError :: [Char] -> Either ASN1Error b
decodingError reason :: [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 ("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]
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 (\c :: Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> 0x7f)

-- FIXME need msec printed
putTime :: ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ByteString
putTime :: ASN1TimeType -> DateTime -> Maybe TimezoneOffset -> ByteString
putTime ty :: ASN1TimeType
ty dt :: DateTime
dt mtz :: 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 "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 "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
                     Nothing                      -> ""
                     Just tz :: TimezoneOffset
tz | TimezoneOffset
tz TimezoneOffset -> TimezoneOffset -> Bool
forall a. Eq a => a -> a -> Bool
== TimezoneOffset
timezone_UTC -> "Z"
                             | Bool
otherwise          -> TimezoneOffset -> [Char]
forall a. Show a => a -> [Char]
show TimezoneOffset
tz

putInteger :: Integer -> ByteString
putInteger :: Integer -> ByteString
putInteger i :: 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 n :: Word64
n bits :: 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 = (8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Word64
n Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` 8)) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0x7

putString :: ByteString -> ByteString
putString :: ByteString -> ByteString
putString l :: 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 oids :: OID
oids = case OID
oids of
    (oid1 :: Integer
oid1:oid2 :: Integer
oid2:suboids :: 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
* 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
    _                   -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ("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 x :: i
x | i
x i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== 0    = Word8 -> ByteString
B.singleton 0
                 | Bool
otherwise = i -> ByteString
forall i. (Bits i, Integral i) => i -> ByteString
putVarEncodingIntegral i
x

putDouble :: Double -> ByteString
putDouble :: Double -> ByteString
putDouble d :: Double
d
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [Word8] -> ByteString
B.pack []
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0) = [Word8] -> ByteString
B.pack [0x40]
  | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double -> Double
forall a. Num a => a -> a
negate (1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0) = [Word8] -> ByteString
B.pack [0x41]
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
d = [Word8] -> ByteString
B.pack [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
- 1)) -- encode length of exponent
                (ByteString
expBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
manBS)
  where
  (mkUnsigned :: Integer -> Integer
mkUnsigned, header :: Word8
header)
    | Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 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)
  (man :: Integer
man, exp :: ASN1Tag
exp) = Double -> (Integer, ASN1Tag)
forall a. RealFloat a => a -> (Integer, ASN1Tag)
decodeFloat Double
d
  (mantissa :: Word64
mantissa, exponent :: 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 (mantissa :: Word64
mantissa, exponent :: 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 = 0x80
bINARY_NEGATIVE_NUMBER_ID :: Word8
bINARY_NEGATIVE_NUMBER_ID = 0xc0