-- |
-- Module      : Data.ASN1.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Data.ASN1.Types
    ( ASN1(..)
    , ASN1S
    , ASN1Class(..)
    , ASN1Tag
    , ASN1ConstructionType(..)
    , ASN1StringEncoding(..)
    , ASN1TimeType(..)
    , ASN1Object(..)
    , ASN1CharacterString(..)
    , asn1CharacterString
    , asn1CharacterToString
    , module Data.ASN1.OID
    ) where

import Data.Hourglass
import Data.ASN1.BitArray
import Data.ASN1.OID
import Data.ASN1.Types.Lowlevel
import Data.ASN1.Types.String
import Data.ByteString (ByteString)

-- | Define the type of container
data ASN1ConstructionType = Sequence
                          | Set
                          | Container ASN1Class ASN1Tag
                          deriving (Int -> ASN1ConstructionType -> ShowS
[ASN1ConstructionType] -> ShowS
ASN1ConstructionType -> String
(Int -> ASN1ConstructionType -> ShowS)
-> (ASN1ConstructionType -> String)
-> ([ASN1ConstructionType] -> ShowS)
-> Show ASN1ConstructionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASN1ConstructionType] -> ShowS
$cshowList :: [ASN1ConstructionType] -> ShowS
show :: ASN1ConstructionType -> String
$cshow :: ASN1ConstructionType -> String
showsPrec :: Int -> ASN1ConstructionType -> ShowS
$cshowsPrec :: Int -> ASN1ConstructionType -> ShowS
Show,ASN1ConstructionType -> ASN1ConstructionType -> Bool
(ASN1ConstructionType -> ASN1ConstructionType -> Bool)
-> (ASN1ConstructionType -> ASN1ConstructionType -> Bool)
-> Eq ASN1ConstructionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ASN1ConstructionType -> ASN1ConstructionType -> Bool
$c/= :: ASN1ConstructionType -> ASN1ConstructionType -> Bool
== :: ASN1ConstructionType -> ASN1ConstructionType -> Bool
$c== :: ASN1ConstructionType -> ASN1ConstructionType -> Bool
Eq)

-- | Different ASN1 time representation
data ASN1TimeType = TimeUTC         -- ^ ASN1 UTCTime Type: limited between 1950-2050
                  | TimeGeneralized -- ^ ASN1 GeneralizedTime Type
                  deriving (Int -> ASN1TimeType -> ShowS
[ASN1TimeType] -> ShowS
ASN1TimeType -> String
(Int -> ASN1TimeType -> ShowS)
-> (ASN1TimeType -> String)
-> ([ASN1TimeType] -> ShowS)
-> Show ASN1TimeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASN1TimeType] -> ShowS
$cshowList :: [ASN1TimeType] -> ShowS
show :: ASN1TimeType -> String
$cshow :: ASN1TimeType -> String
showsPrec :: Int -> ASN1TimeType -> ShowS
$cshowsPrec :: Int -> ASN1TimeType -> ShowS
Show,ASN1TimeType -> ASN1TimeType -> Bool
(ASN1TimeType -> ASN1TimeType -> Bool)
-> (ASN1TimeType -> ASN1TimeType -> Bool) -> Eq ASN1TimeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ASN1TimeType -> ASN1TimeType -> Bool
$c/= :: ASN1TimeType -> ASN1TimeType -> Bool
== :: ASN1TimeType -> ASN1TimeType -> Bool
$c== :: ASN1TimeType -> ASN1TimeType -> Bool
Eq,Eq ASN1TimeType
Eq ASN1TimeType
-> (ASN1TimeType -> ASN1TimeType -> Ordering)
-> (ASN1TimeType -> ASN1TimeType -> Bool)
-> (ASN1TimeType -> ASN1TimeType -> Bool)
-> (ASN1TimeType -> ASN1TimeType -> Bool)
-> (ASN1TimeType -> ASN1TimeType -> Bool)
-> (ASN1TimeType -> ASN1TimeType -> ASN1TimeType)
-> (ASN1TimeType -> ASN1TimeType -> ASN1TimeType)
-> Ord ASN1TimeType
ASN1TimeType -> ASN1TimeType -> Bool
ASN1TimeType -> ASN1TimeType -> Ordering
ASN1TimeType -> ASN1TimeType -> ASN1TimeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
$cmin :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
max :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
$cmax :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
>= :: ASN1TimeType -> ASN1TimeType -> Bool
$c>= :: ASN1TimeType -> ASN1TimeType -> Bool
> :: ASN1TimeType -> ASN1TimeType -> Bool
$c> :: ASN1TimeType -> ASN1TimeType -> Bool
<= :: ASN1TimeType -> ASN1TimeType -> Bool
$c<= :: ASN1TimeType -> ASN1TimeType -> Bool
< :: ASN1TimeType -> ASN1TimeType -> Bool
$c< :: ASN1TimeType -> ASN1TimeType -> Bool
compare :: ASN1TimeType -> ASN1TimeType -> Ordering
$ccompare :: ASN1TimeType -> ASN1TimeType -> Ordering
$cp1Ord :: Eq ASN1TimeType
Ord)

-- | Define high level ASN1 object.
data ASN1 =
      Boolean Bool
    | IntVal  Integer
    | BitString BitArray
    | OctetString ByteString
    | Null
    | OID  OID
    | Real Double
    | Enumerated Integer
    | ASN1String ASN1CharacterString
    | ASN1Time ASN1TimeType DateTime (Maybe TimezoneOffset)
    | Other ASN1Class ASN1Tag ByteString
    | Start ASN1ConstructionType
    | End   ASN1ConstructionType
    deriving (Int -> ASN1 -> ShowS
[ASN1] -> ShowS
ASN1 -> String
(Int -> ASN1 -> ShowS)
-> (ASN1 -> String) -> ([ASN1] -> ShowS) -> Show ASN1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASN1] -> ShowS
$cshowList :: [ASN1] -> ShowS
show :: ASN1 -> String
$cshow :: ASN1 -> String
showsPrec :: Int -> ASN1 -> ShowS
$cshowsPrec :: Int -> ASN1 -> ShowS
Show, ASN1 -> ASN1 -> Bool
(ASN1 -> ASN1 -> Bool) -> (ASN1 -> ASN1 -> Bool) -> Eq ASN1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ASN1 -> ASN1 -> Bool
$c/= :: ASN1 -> ASN1 -> Bool
== :: ASN1 -> ASN1 -> Bool
$c== :: ASN1 -> ASN1 -> Bool
Eq)

-- | represent a chunk of ASN1 Stream.
-- this is equivalent to ShowS but for an ASN1 Stream.
type ASN1S = [ASN1] -> [ASN1]

-- | Define an object that can be converted to and from ASN.1
class ASN1Object a where
    -- | transform an object into a chunk of ASN1 stream.
    toASN1   :: a      -> ASN1S

    -- | returns either an object along the remaining ASN1 stream,
    -- or an error.
    fromASN1 :: [ASN1] -> Either String (a, [ASN1])