{-# LANGUAGE ViewPatterns #-}

{- |
Module      : Data.ASN1.Prim
License     : BSD-style
Copyright   : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Tools to read ASN1 primitive (e.g. boolean, int)
-}

module Data.ASN1.Prim
  ( -- * ASN.1 high-level algebraic types

    ASN1 (..)
  , ASN1ConstructionType (..)

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

    -- * Marshall an ASN.1 value from a val struct or a strict bytestring

  , getBoolean
  , getInteger
  , getDouble
  , getBitString
  , getOctetString
  , getNull
  , getOID
  , getTime

    -- * Marshall an ASN.1 value to a strict bytestring

  , putTime
  , putInteger
  , putDouble
  , putBitString
  , putString
  , putOID
  ) where

import           Control.Arrow ( first )
import           Control.Monad ( unless )
import           Data.ASN1.BitArray ( BitArray (..), toBitArray )
import           Data.ASN1.Error ( ASN1Error (..) )
import           Data.ASN1.Internal
                   ( bytesOfInt, intOfBytes, putVarEncodingIntegral, uintOfBytes
                   )
import           Data.ASN1.Serialize ( putHeader )
import           Data.ASN1.Stream ( getConstructedEnd )
import           Data.ASN1.Types
                   ( ASN1 (..), ASN1CharacterString (..)
                   , ASN1ConstructionType (..), ASN1StringEncoding (..)
                   , ASN1TimeType (..)
                   )
import           Data.ASN1.Types.Lowlevel
                   ( ASN1Class (..), ASN1Event (..), ASN1Header (..)
                   , ASN1Length (..)
                   )
import           Data.Bits
                   ( (.&.), (.|.), clearBit, countTrailingZeros, shiftL, shiftR
                   , testBit
                   )
import           Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Unsafe as B
import           Data.Char (ord, isDigit)
import           Data.Hourglass
                   ( Date (..), DateTime (..), NanoSeconds (..)
                   , TimezoneOffset (..), timeParseE, timePrint, timezone_UTC
                   , todNSec
                   )
import           Data.List ( unfoldr )
import qualified Data.List.NonEmpty as NE
import           Data.Maybe ( isJust )
import           Data.Word ( Word64, Word8 )
import           Prelude hiding ( exp, exponent )

encodeHeader :: Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader :: Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader Bool
pc ASN1Length
len (Boolean Bool
_)                = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x1 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (IntVal Integer
_)                 = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x2 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (BitString BitArray
_)              = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x3 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (OctetString ByteString
_)            = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x4 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len ASN1
Null                       = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x5 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (OID [Integer]
_)                    = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x6 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Real Double
_)                   = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x9 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Enumerated Integer
_)             = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0xa Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (ASN1String ASN1CharacterString
cs)            = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal (ASN1StringEncoding -> Int
forall {a}. Num a => ASN1StringEncoding -> a
characterStringType (ASN1StringEncoding -> Int) -> ASN1StringEncoding -> Int
forall a b. (a -> b) -> a -> b
$ ASN1CharacterString -> ASN1StringEncoding
characterEncoding ASN1CharacterString
cs) Bool
pc ASN1Length
len
 where
  characterStringType :: ASN1StringEncoding -> a
characterStringType ASN1StringEncoding
UTF8      = a
0xc
  characterStringType ASN1StringEncoding
Numeric   = a
0x12
  characterStringType ASN1StringEncoding
Printable = a
0x13
  characterStringType ASN1StringEncoding
T61       = a
0x14
  characterStringType ASN1StringEncoding
VideoTex  = a
0x15
  characterStringType ASN1StringEncoding
IA5       = a
0x16
  characterStringType ASN1StringEncoding
Graphic   = a
0x19
  characterStringType ASN1StringEncoding
Visible   = a
0x1a
  characterStringType ASN1StringEncoding
General   = a
0x1b
  characterStringType ASN1StringEncoding
UTF32     = a
0x1c
  characterStringType ASN1StringEncoding
Character = a
0x1d
  characterStringType ASN1StringEncoding
BMP       = a
0x1e
encodeHeader Bool
pc ASN1Length
len (ASN1Time ASN1TimeType
TimeUTC DateTime
_ Maybe TimezoneOffset
_)     = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x17 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (ASN1Time ASN1TimeType
TimeGeneralized DateTime
_ Maybe TimezoneOffset
_) = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x18 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Start ASN1ConstructionType
Sequence)           = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x10 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Start ASN1ConstructionType
Set)                = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
Universal Int
0x11 Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Start (Container ASN1Class
tc Int
tag)) = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
tc Int
tag Bool
pc ASN1Length
len
encodeHeader Bool
pc ASN1Length
len (Other ASN1Class
tc Int
tag ByteString
_)           = ASN1Class -> Int -> Bool -> ASN1Length -> ASN1Header
ASN1Header ASN1Class
tc Int
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 [Integer]
oidv)          = [Integer] -> ByteString
putOID [Integer]
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
_ Int
_ 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 -> (Int, [ASN1Event])
encodePrimitive ASN1
a =
  let b :: ByteString
b = ASN1 -> ByteString
encodePrimitiveData ASN1
a
      blen :: Int
blen = ByteString -> Int
B.length ByteString
b
      len :: ASN1Length
len = Int -> ASN1Length
makeLength Int
blen
      hdr :: ASN1Header
hdr = ASN1Length -> ASN1 -> ASN1Header
encodePrimitiveHeader ASN1Length
len ASN1
a
  in  (ByteString -> Int
B.length (ASN1Header -> ByteString
putHeader ASN1Header
hdr) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blen, [ASN1Header -> ASN1Event
Header ASN1Header
hdr, ByteString -> ASN1Event
Primitive ByteString
b])
 where
  makeLength :: Int -> ASN1Length
makeLength Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 = Int -> ASN1Length
LenShort Int
len
    | Bool
otherwise  = Int -> Int -> ASN1Length
LenLong (Int -> Int
forall {t} {a}. (Num a, Integral t) => t -> a
nbBytes Int
len) Int
len
  nbBytes :: t -> a
nbBytes t
nb = if t
nb t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
255 then a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ t -> a
nbBytes (t
nb t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
256) else a
1

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

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

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

encodeConstructed :: ASN1 -> [ASN1] -> (Int, [ASN1Event])
encodeConstructed :: ASN1 -> [ASN1] -> (Int, [ASN1Event])
encodeConstructed c :: ASN1
c@(Start ASN1ConstructionType
_) [ASN1]
children =
  (Int
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
  (Int
clen, [ASN1Event]
events) = [ASN1] -> (Int, [ASN1Event])
encodeList [ASN1]
children
  len :: ASN1Length
len = Int -> ASN1Length
mkSmallestLength Int
clen
  h :: ASN1Header
h = Bool -> ASN1Length -> ASN1 -> ASN1Header
encodeHeader Bool
True ASN1Length
len ASN1
c
  tlen :: Int
tlen = ByteString -> Int
B.length (ASN1Header -> ByteString
putHeader ASN1Header
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
clen

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

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

type ASN1Ret = Either ASN1Error ASN1

decodePrimitive :: ASN1Header -> B.ByteString -> ASN1Ret
decodePrimitive :: ASN1Header -> ByteString -> ASN1Ret
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x1 Bool
_ ASN1Length
_) ByteString
p  = Bool -> ByteString -> ASN1Ret
getBoolean Bool
False ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x2 Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getInteger ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x3 Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getBitString ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x4 Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getOctetString ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x5 Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getNull ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x6 Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getOID ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
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 Int
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 Int
0x9 Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getDouble ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0xa Bool
_ ASN1Length
_) ByteString
p  = ByteString -> ASN1Ret
getEnumerated ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
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 Int
0xc Bool
_ ASN1Length
_) ByteString
p  = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
UTF8 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
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 Int
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 Int
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 Int
0x12 Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Numeric ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x13 Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Printable ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x14 Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
T61 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x15 Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
VideoTex ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x16 Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
IA5 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x17 Bool
_ ASN1Length
_) ByteString
p = ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
TimeUTC ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x18 Bool
_ ASN1Length
_) ByteString
p = ASN1TimeType -> ByteString -> ASN1Ret
getTime ASN1TimeType
TimeGeneralized ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x19 Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Graphic ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x1a Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Visible ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x1b Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
General ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x1c Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
UTF32 ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x1d Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
Character ByteString
p
decodePrimitive (ASN1Header ASN1Class
Universal Int
0x1e Bool
_ ASN1Length
_) ByteString
p = ASN1StringEncoding -> ByteString -> ASN1Ret
getCharacterString ASN1StringEncoding
BMP ByteString
p
decodePrimitive (ASN1Header ASN1Class
tc        Int
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 -> Int -> ByteString -> ASN1
Other ASN1Class
tc Int
tag ByteString
p

getBoolean :: Bool -> ByteString -> Either ASN1Error ASN1
getBoolean :: Bool -> ByteString -> ASN1Ret
getBoolean Bool
isDer ByteString
s =
  if ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    then case HasCallStack => ByteString -> Word8
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"

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

-- | 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 -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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
$ (Int, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Int, Integer) -> Integer) -> (Int, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> (Int, 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 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
v2 Int
7) Bool -> Bool -> Bool
|| (Word8
v1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0 Bool -> Bool -> Bool
&& Bool -> Bool
not ( Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
v2 Int
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
$ (Int, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Int, Integer) -> Integer) -> (Int, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> (Int, Integer)
intOfBytes ByteString
s
 where
  v1 :: Word8
v1 = ByteString
s HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
`B.index` Int
0
  v2 :: Word8
v2 = ByteString
s HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
`B.index` Int
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 :: Int
len = ByteString -> Int
B.length ByteString
s
      Int
base <- case (Word8
h Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
5, Word8
h Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
4) of
        -- extract bits 5,4 for the base

        (Bool
False, Bool
False) -> Int -> Either ASN1Error Int
forall a. a -> Either ASN1Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
2
        (Bool
False, Bool
True)  -> Int -> Either ASN1Error Int
forall a. a -> Either ASN1Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
8
        (Bool
True,  Bool
False) -> Int -> Either ASN1Error Int
forall a. a -> Either ASN1Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
16
        (Bool, Bool)
_ ->
          ASN1Error -> Either ASN1Error Int
forall a b. a -> Either a b
Left (ASN1Error -> Either ASN1Error Int)
-> ([Char] -> ASN1Error) -> [Char] -> Either ASN1Error Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ASN1Error
TypeDecodingFailed ([Char] -> Either ASN1Error Int) -> [Char] -> Either ASN1Error Int
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 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
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 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
      Word8
expLength <- Int -> Word8 -> ByteString -> Either ASN1Error Word8
getExponentLength Int
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 (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
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 (Int
_, Integer
exp'') = ByteString -> (Int, Integer)
intOfBytes (ByteString -> (Int, Integer)) -> ByteString -> (Int, Integer)
forall a b. (a -> b) -> a -> b
$
            Int -> ByteString -> ByteString
B.unsafeTake (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
expLength) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeDrop Int
1 ByteString
s
      let exp' :: Integer
exp' = case Int
base :: Int of
                   Int
2 -> Integer
exp''
                   Int
8 -> Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
exp''
                   Int
_ -> 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

          (Int
_, Integer
mantissa) = ByteString -> (Int, Integer)
uintOfBytes (ByteString -> (Int, Integer)) -> ByteString -> (Int, Integer)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeDrop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
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 -> Int -> Double
forall a. RealFloat a => Integer -> Int -> 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 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
exponent)

getExponentLength :: Int -> Word8 -> ByteString -> Either ASN1Error Word8
getExponentLength :: Int -> Word8 -> ByteString -> Either ASN1Error Word8
getExponentLength Int
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 (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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 a. a -> Either ASN1Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Either ASN1Error Word8)
-> Word8 -> Either ASN1Error Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
B.unsafeIndex ByteString
s Int
1
      | Bool
otherwise -> Word8 -> Either ASN1Error Word8
forall a. a -> Either ASN1Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 = HasCallStack => ByteString -> Word8
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
- Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ( Char -> Int
ord Char
'0')
        else Word8
toSkip in
  let xs :: ByteString
xs = HasCallStack => ByteString -> ByteString
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 -> Int -> BitArray
toBitArray ByteString
xs (Word8 -> Int
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 -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 = case ByteString -> [Word8]
B.unpack ByteString
s of
  [] -> 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]
"OID: no data"
  (Word8
x : [Word8]
xs) -> ASN1 -> ASN1Ret
forall a b. b -> Either a b
Right (ASN1 -> ASN1Ret) -> ASN1 -> ASN1Ret
forall a b. (a -> b) -> a -> b
$ [Integer] -> ASN1
OID
    ( 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 -> [Integer] -> [Integer]
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 -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Word8] -> [Integer]
groupOID [Word8]
xs
    )
 where
  groupOID :: [Word8] -> [Integer]
  groupOID :: [Word8] -> [Integer]
groupOID =
    ([Word8] -> Integer) -> [[Word8]] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Word8 -> Integer) -> Integer -> [Word8] -> Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Integer
acc Word8
n -> (Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
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]] -> [Integer])
-> ([Word8] -> [[Word8]]) -> [Word8] -> [Integer]
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 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
a Int
7
    then (a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit a
a Int
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 b c d. (b -> c) -> (b, d) -> (c, d)
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 Int
y Month
m Int
d) TimeOfDay
tod)
    | ASN1TimeType
timeType ASN1TimeType -> ASN1TimeType -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1TimeType
TimeGeneralized = DateTime
dt
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2050 = Date -> TimeOfDay -> DateTime
DateTime (Int -> Month -> Int -> Date
Date (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100) Month
m Int
d) TimeOfDay
tod
    | Bool
otherwise = DateTime
dt
  formatNoSeconds :: [Char]
formatNoSeconds = [Char] -> [Char]
forall a. HasCallStack => [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 b c d. (b -> c) -> (b, d) -> (c, d)
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
$ Int -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength Int
3 Char -> Bool
isDigit [Char]
s'
                 in (DateTime
dt { dtTime = (dtTime dt) { todNSec = 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, (Int -> Int) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat Int -> Int
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, (Int -> Int) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat ((-Int
1) Int -> Int -> Int
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 :: (Int -> Int) -> [Char] -> Maybe TimezoneOffset
parseTimezoneFormat Int -> Int
transform [Char]
s
      | [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4  = TimezoneOffset -> Maybe TimezoneOffset
forall a. a -> Maybe a
Just (TimezoneOffset -> Maybe TimezoneOffset)
-> TimezoneOffset -> Maybe TimezoneOffset
forall a b. (a -> b) -> a -> b
$ Int -> TimezoneOffset
toTz (Int -> TimezoneOffset) -> Int -> TimezoneOffset
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
toInt ([Char] -> Int) -> [Char] -> Int
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
$ Int -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength Int
4 Char -> Bool
isDigit [Char]
s
      | Bool
otherwise      = Maybe TimezoneOffset
forall a. Maybe a
Nothing
   where
    toTz :: Int -> TimezoneOffset
toTz Int
z = let (Int
h,Int
m) = Int
z Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
100
             in  Int -> TimezoneOffset
TimezoneOffset (Int -> TimezoneOffset) -> Int -> TimezoneOffset
forall a b. (a -> b) -> a -> b
$ Int -> Int
transform (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)

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

  spanToLength :: Int -> (Char -> Bool) -> String -> (String, String)
  spanToLength :: Int -> (Char -> Bool) -> [Char] -> ([Char], [Char])
spanToLength Int
len Char -> Bool
p = Int -> [Char] -> ([Char], [Char])
loop Int
0
   where
    loop :: Int -> [Char] -> ([Char], [Char])
loop Int
i [Char]
z
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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) = Int -> [Char] -> ([Char], [Char])
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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] -> Int
toInt = (Int -> Char -> Int) -> Int -> [Char] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc Char
w -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')) Int
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 = Maybe Word8 -> Bool
forall a. Maybe a -> Bool
isJust (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 -> 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
$ NonEmpty Word8 -> [Word8]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Word8 -> [Word8]) -> NonEmpty Word8 -> [Word8]
forall a b. (a -> b) -> a -> b
$ Integer -> NonEmpty 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 :: [Integer] -> ByteString
putOID [Integer]
oids = case [Integer]
oids of
  (Integer
oid1:Integer
oid2:[Integer]
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) -> [Integer] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> ByteString
forall {i}. (Bits i, Integral i) => i -> ByteString
encode [Integer]
suboids
    in  Word8 -> ByteString -> ByteString
B.cons Word8
eoidclass ByteString
subeoids
  [Integer]
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid OID format " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Integer] -> [Char]
forall a. Show a => a -> [Char]
show [Integer]
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, Int
exp) = Double -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat Double
d
  (Word64
mantissa, Int
exponent) = (Word64, Int) -> (Word64, Int)
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, Int
exp)
  expBS :: ByteString
expBS = Integer -> ByteString
putInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
exponent)
  expLen :: Word8
expLen = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
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, Int) -> (Word64, Int)
normalize (Word64
mantissa, Int
exponent) = (Word64
mantissa Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
sh, Int
exponent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sh)
 where
  sh :: Int
sh = Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
mantissa

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