{- |
Module      : Data.ASN1.Types
License     : BSD-style
Copyright   : (c) 2010-2013 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.ASN1.BitArray ( BitArray )
import           Data.ASN1.OID ( OID )
import           Data.ASN1.Types.Lowlevel ( ASN1Class (..), ASN1Tag )
import           Data.ASN1.Types.String
                   ( ASN1CharacterString (..), ASN1StringEncoding (..)
                   , asn1CharacterString, asn1CharacterToString
                   )
import           Data.ByteString ( ByteString )
import           Data.Hourglass ( DateTime, TimezoneOffset )

-- | Define the types of container.

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

-- | Different ASN.1 time representations.

data ASN1TimeType =
    TimeUTC
    -- ^ ASN.1 UTCTime Type: limited between 1950-2050.

  | TimeGeneralized
    -- ^ ASN.1 GeneralizedTime Type.

  deriving (ASN1TimeType -> ASN1TimeType -> Bool
(ASN1TimeType -> ASN1TimeType -> Bool)
-> (ASN1TimeType -> ASN1TimeType -> Bool) -> Eq ASN1TimeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ASN1TimeType -> ASN1TimeType -> Bool
== :: ASN1TimeType -> ASN1TimeType -> Bool
$c/= :: ASN1TimeType -> ASN1TimeType -> Bool
/= :: 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
$ccompare :: ASN1TimeType -> ASN1TimeType -> Ordering
compare :: ASN1TimeType -> ASN1TimeType -> Ordering
$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
>= :: ASN1TimeType -> ASN1TimeType -> Bool
$cmax :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
max :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
$cmin :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
min :: ASN1TimeType -> ASN1TimeType -> ASN1TimeType
Ord, ASN1Tag -> ASN1TimeType -> ShowS
[ASN1TimeType] -> ShowS
ASN1TimeType -> String
(ASN1Tag -> ASN1TimeType -> ShowS)
-> (ASN1TimeType -> String)
-> ([ASN1TimeType] -> ShowS)
-> Show ASN1TimeType
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ASN1Tag -> ASN1TimeType -> ShowS
showsPrec :: ASN1Tag -> ASN1TimeType -> ShowS
$cshow :: ASN1TimeType -> String
show :: ASN1TimeType -> String
$cshowList :: [ASN1TimeType] -> ShowS
showList :: [ASN1TimeType] -> ShowS
Show)

-- | Define high level ASN.1 objects.

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 (ASN1 -> ASN1 -> Bool
(ASN1 -> ASN1 -> Bool) -> (ASN1 -> ASN1 -> Bool) -> Eq ASN1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ASN1 -> ASN1 -> Bool
== :: ASN1 -> ASN1 -> Bool
$c/= :: ASN1 -> ASN1 -> Bool
/= :: ASN1 -> ASN1 -> Bool
Eq, ASN1Tag -> ASN1 -> ShowS
[ASN1] -> ShowS
ASN1 -> String
(ASN1Tag -> ASN1 -> ShowS)
-> (ASN1 -> String) -> ([ASN1] -> ShowS) -> Show ASN1
forall a.
(ASN1Tag -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: ASN1Tag -> ASN1 -> ShowS
showsPrec :: ASN1Tag -> ASN1 -> ShowS
$cshow :: ASN1 -> String
show :: ASN1 -> String
$cshowList :: [ASN1] -> ShowS
showList :: [ASN1] -> ShowS
Show)

-- | Represent a chunk of ASN.1 Stream. This is equivalent to ShowS but for an

-- ASN.1 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 ASN.1 stream.

  toASN1 :: a -> ASN1S

  -- | Returns either an object along the remaining ASN.1 stream, or an error.

  fromASN1 :: [ASN1] -> Either String (a, [ASN1])