-- Copyright (c) 2020  Herbert Valerio Riedel <hvr@gnu.org>
--
--  This file is free software: you may copy, redistribute and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation, either version 2 of the License, or (at your
--  option) any later version.
--
--  This file is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program (see `LICENSE`).  If not, see
--  <https://www.gnu.org/licenses/old-licenses/gpl-2.0.html>.

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE Trustworthy       #-}
{-# LANGUAGE TypeOperators     #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2020
-- SPDX-License-Identifier: GPL-2.0-or-later
--
-- ASN.1 String Types
--
-- This modules features types and associated functions for encoding/decoding common ASN.1 string types from their ASN.1 BER representation according to their standard /universal/ ASN.1 tag number.
--
-- @since 0.1.1
module LDAPv3.ASN1String
  ( ASN1String(..)

  -- * Convenience Sum-type

  , ASN1StringChoice(..)
  , asn1StringChoice'encode
  , asn1StringChoice'decode

  -- * UTF8String

  , UTF8String(UTF8String, utf8String'toShortText)

  -- * UniversalString

  , UniversalString

  -- * BMPString

  , BMPString
  , bmpString'toUcs2CodePoints
  , bmpString'fromUcs2CodePoints

  -- * IA5String

  , IA5String
  , ia5String'toShortText
  , ia5String'fromShortText

  -- * VisibleString

  , VisibleString
  , visibleString'toShortText
  , visibleString'fromShortText

  -- * PrintableString

  , PrintableString
  , printableString'toShortText
  , printableString'fromShortText

  -- * NumericString

  , NumericString
  , numericString'toShortText
  , numericString'fromShortText
  ) where

import           Common                hiding (Option, many, option, some, (<|>))

import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy  as BL
import qualified Data.ByteString.Short as SBS
import           Data.Char             (chr, ord)
import qualified Data.Text.Short       as TS

import           Data.ASN1
import           Data.ASN1.Prim

import qualified Data.Binary           as Bin
import qualified Data.Binary.Get       as Bin
import qualified Data.Binary.Put       as Bin

-- | Typeclass abstracting over common ASN.1 string operations
--
-- @since 0.1.1
class ASN1String a where
  -- | Decode ASN.1 string type from its ASN.1 BER encoding
  asn1string'decode :: ByteString -> Maybe a
  default asn1string'decode :: ASN1 a => ByteString -> Maybe a
  asn1string'decode = Get a -> ByteString -> Maybe a
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (ASN1Decode a -> Get a
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode a
forall t. ASN1 t => ASN1Decode t
asn1decode)

  -- | Encode ASN.1 string type to its ASN.1 BER encoding
  asn1string'encode :: a -> ByteString
  default asn1string'encode :: ASN1 a => a -> ByteString
  asn1string'encode = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
Bin.runPut (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put) -> (a -> PutM Word64) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (a -> ASN1Encode Word64) -> a -> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

  -- | Predicate for determining whether given code-point is allowed by the respective ASN.1 string type
  asn1string'supportsCodePoint :: Proxy a -> Char -> Bool

  -- | Convert ASN.1 string type to list of code-points
  asn1string'toCodePoints :: a -> [Char]

  -- | Construct ASN.1 string type from list of code-points
  --
  -- This returns 'Nothing' if a code-point cannot be expressed in the respective ASN.1 string type.
  asn1string'fromCodePoints :: [Char] -> Maybe a

-- | Convenient Sum-type combining a subset of the standard ASN.1 string-like types
--
-- See specific string types in "LDAPv3.ASN1String" for details.
data ASN1StringChoice
  = ASN1String'OCTET_STRING     ShortByteString
  | ASN1String'UniversalString  UniversalString
  | ASN1String'UTF8String       ShortText
  | ASN1String'BMPString        BMPString
  | ASN1String'IA5String        IA5String
  | ASN1String'VisibleString    VisibleString
  | ASN1String'PrintableString  PrintableString
  | ASN1String'NumericString    NumericString
  deriving (Int -> ASN1StringChoice -> ShowS
[ASN1StringChoice] -> ShowS
ASN1StringChoice -> String
(Int -> ASN1StringChoice -> ShowS)
-> (ASN1StringChoice -> String)
-> ([ASN1StringChoice] -> ShowS)
-> Show ASN1StringChoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASN1StringChoice] -> ShowS
$cshowList :: [ASN1StringChoice] -> ShowS
show :: ASN1StringChoice -> String
$cshow :: ASN1StringChoice -> String
showsPrec :: Int -> ASN1StringChoice -> ShowS
$cshowsPrec :: Int -> ASN1StringChoice -> ShowS
Show,ASN1StringChoice -> ASN1StringChoice -> Bool
(ASN1StringChoice -> ASN1StringChoice -> Bool)
-> (ASN1StringChoice -> ASN1StringChoice -> Bool)
-> Eq ASN1StringChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ASN1StringChoice -> ASN1StringChoice -> Bool
$c/= :: ASN1StringChoice -> ASN1StringChoice -> Bool
== :: ASN1StringChoice -> ASN1StringChoice -> Bool
$c== :: ASN1StringChoice -> ASN1StringChoice -> Bool
Eq)

-- | Encodes as ASN.1 BER
instance Bin.Binary ASN1StringChoice where
    put :: ASN1StringChoice -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (ASN1StringChoice -> PutM Word64) -> ASN1StringChoice -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (ASN1StringChoice -> ASN1Encode Word64)
-> ASN1StringChoice
-> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1StringChoice -> ASN1Encode Word64
go
      where
        go :: ASN1StringChoice -> ASN1Encode Word64
go (ASN1String'BMPString t :: BMPString
t)       = BMPString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode BMPString
t
        go (ASN1String'IA5String t :: IA5String
t)       = IA5String -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode IA5String
t
        go (ASN1String'NumericString t :: NumericString
t)   = NumericString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode NumericString
t
        go (ASN1String'OCTET_STRING b :: ShortByteString
b)    = ShortByteString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode ShortByteString
b
        go (ASN1String'PrintableString t :: PrintableString
t) = PrintableString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode PrintableString
t
        go (ASN1String'UTF8String t :: ShortText
t)      = UTF8String -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> UTF8String
UTF8String ShortText
t)
        go (ASN1String'UniversalString t :: UniversalString
t) = UniversalString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode UniversalString
t
        go (ASN1String'VisibleString t :: VisibleString
t)   = VisibleString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode VisibleString
t

    get :: Get ASN1StringChoice
get = ASN1Decode ASN1StringChoice -> Get ASN1StringChoice
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode ASN1StringChoice
go
      where
        go :: ASN1Decode ASN1StringChoice
go = [ASN1Decode ASN1StringChoice] -> ASN1Decode ASN1StringChoice
forall x. [ASN1Decode x] -> ASN1Decode x
dec'CHOICE
               [ ShortByteString -> ASN1StringChoice
ASN1String'OCTET_STRING (ShortByteString -> ASN1StringChoice)
-> ASN1Decode ShortByteString -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode ShortByteString
forall t. ASN1 t => ASN1Decode t
asn1decode
               , ShortText -> ASN1StringChoice
ASN1String'UTF8String (ShortText -> ASN1StringChoice)
-> (UTF8String -> ShortText) -> UTF8String -> ASN1StringChoice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTF8String -> ShortText
utf8String'toShortText (UTF8String -> ASN1StringChoice)
-> ASN1Decode UTF8String -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode UTF8String
forall t. ASN1 t => ASN1Decode t
asn1decode
               , PrintableString -> ASN1StringChoice
ASN1String'PrintableString (PrintableString -> ASN1StringChoice)
-> ASN1Decode PrintableString -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode PrintableString
forall t. ASN1 t => ASN1Decode t
asn1decode
               , IA5String -> ASN1StringChoice
ASN1String'IA5String (IA5String -> ASN1StringChoice)
-> ASN1Decode IA5String -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode IA5String
forall t. ASN1 t => ASN1Decode t
asn1decode
               , BMPString -> ASN1StringChoice
ASN1String'BMPString (BMPString -> ASN1StringChoice)
-> ASN1Decode BMPString -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode BMPString
forall t. ASN1 t => ASN1Decode t
asn1decode
               , UniversalString -> ASN1StringChoice
ASN1String'UniversalString (UniversalString -> ASN1StringChoice)
-> ASN1Decode UniversalString -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode UniversalString
forall t. ASN1 t => ASN1Decode t
asn1decode
               , VisibleString -> ASN1StringChoice
ASN1String'VisibleString (VisibleString -> ASN1StringChoice)
-> ASN1Decode VisibleString -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode VisibleString
forall t. ASN1 t => ASN1Decode t
asn1decode
               , NumericString -> ASN1StringChoice
ASN1String'NumericString (NumericString -> ASN1StringChoice)
-> ASN1Decode NumericString -> ASN1Decode ASN1StringChoice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode NumericString
forall t. ASN1 t => ASN1Decode t
asn1decode
               ]

-- | Encode ASN.1 string choice to its ASN.1 BER encoding
--
-- @since 0.1.1
asn1StringChoice'encode :: ASN1StringChoice -> ByteString
asn1StringChoice'encode :: ASN1StringChoice -> ByteString
asn1StringChoice'encode = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (ASN1StringChoice -> ByteString)
-> ASN1StringChoice
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
Bin.runPut (Put -> ByteString)
-> (ASN1StringChoice -> Put) -> ASN1StringChoice -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1StringChoice -> Put
forall t. Binary t => t -> Put
Bin.put

-- | Decode ASN.1 string choice from its ASN.1 BER encoding
--
-- @since 0.1.1
asn1StringChoice'decode :: ByteString -> Maybe ASN1StringChoice
asn1StringChoice'decode :: ByteString -> Maybe ASN1StringChoice
asn1StringChoice'decode = Get ASN1StringChoice -> ByteString -> Maybe ASN1StringChoice
forall a. Get a -> ByteString -> Maybe a
runGetMaybe Get ASN1StringChoice
forall t. Binary t => Get t
Bin.get

----------------------------------------------------------------------------

-- | ASN.1 UTF8String
--
-- > UTF8String ::= [UNIVERSAL 12] IMPLICIT OCTET STRING
--
-- @since 0.1.1
newtype UTF8String = UTF8String { UTF8String -> ShortText
utf8String'toShortText :: ShortText } deriving (UTF8String -> UTF8String -> Bool
(UTF8String -> UTF8String -> Bool)
-> (UTF8String -> UTF8String -> Bool) -> Eq UTF8String
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTF8String -> UTF8String -> Bool
$c/= :: UTF8String -> UTF8String -> Bool
== :: UTF8String -> UTF8String -> Bool
$c== :: UTF8String -> UTF8String -> Bool
Eq,Eq UTF8String
Eq UTF8String =>
(UTF8String -> UTF8String -> Ordering)
-> (UTF8String -> UTF8String -> Bool)
-> (UTF8String -> UTF8String -> Bool)
-> (UTF8String -> UTF8String -> Bool)
-> (UTF8String -> UTF8String -> Bool)
-> (UTF8String -> UTF8String -> UTF8String)
-> (UTF8String -> UTF8String -> UTF8String)
-> Ord UTF8String
UTF8String -> UTF8String -> Bool
UTF8String -> UTF8String -> Ordering
UTF8String -> UTF8String -> UTF8String
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 :: UTF8String -> UTF8String -> UTF8String
$cmin :: UTF8String -> UTF8String -> UTF8String
max :: UTF8String -> UTF8String -> UTF8String
$cmax :: UTF8String -> UTF8String -> UTF8String
>= :: UTF8String -> UTF8String -> Bool
$c>= :: UTF8String -> UTF8String -> Bool
> :: UTF8String -> UTF8String -> Bool
$c> :: UTF8String -> UTF8String -> Bool
<= :: UTF8String -> UTF8String -> Bool
$c<= :: UTF8String -> UTF8String -> Bool
< :: UTF8String -> UTF8String -> Bool
$c< :: UTF8String -> UTF8String -> Bool
compare :: UTF8String -> UTF8String -> Ordering
$ccompare :: UTF8String -> UTF8String -> Ordering
$cp1Ord :: Eq UTF8String
Ord)

instance ASN1String UTF8String where
    asn1string'supportsCodePoint :: Proxy UTF8String -> Char -> Bool
asn1string'supportsCodePoint _ = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSurr
    asn1string'toCodePoints :: UTF8String -> String
asn1string'toCodePoints (UTF8String t :: ShortText
t) = ShortText -> String
TS.unpack ShortText
t
    asn1string'fromCodePoints :: String -> Maybe UTF8String
asn1string'fromCodePoints cps :: String
cps
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSurr) String
cps = UTF8String -> Maybe UTF8String
forall a. a -> Maybe a
Just (UTF8String -> Maybe UTF8String) -> UTF8String -> Maybe UTF8String
forall a b. (a -> b) -> a -> b
$! ShortText -> UTF8String
UTF8String (String -> ShortText
TS.pack String
cps)
      | Bool
otherwise              = Maybe UTF8String
forall a. Maybe a
Nothing

instance Show UTF8String where
    show :: UTF8String -> String
show        (UTF8String s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s
    showsPrec :: Int -> UTF8String -> ShowS
showsPrec p :: Int
p (UTF8String s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s

instance ASN1 UTF8String where
    asn1defTag :: Proxy UTF8String -> Tag
asn1defTag _ = Word64 -> Tag
Universal 12
    asn1encode :: UTF8String -> ASN1Encode Word64
asn1encode (UTF8String t :: ShortText
t) = IMPLICIT ('UNIVERSAL 12) ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> IMPLICIT ('UNIVERSAL 12) ShortText
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT ShortText
t :: 'UNIVERSAL 12 `IMPLICIT` ShortText)
    asn1decode :: ASN1Decode UTF8String
asn1decode = IMPLICIT ('UNIVERSAL 12) ShortText -> UTF8String
unwrap (IMPLICIT ('UNIVERSAL 12) ShortText -> UTF8String)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 12) ShortText)
-> ASN1Decode UTF8String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 12) ShortText)
forall t. ASN1 t => ASN1Decode t
asn1decode
      where
        unwrap :: 'UNIVERSAL 12 `IMPLICIT` ShortText -> UTF8String
        unwrap :: IMPLICIT ('UNIVERSAL 12) ShortText -> UTF8String
unwrap (IMPLICIT t :: ShortText
t) = ShortText -> UTF8String
UTF8String ShortText
t

-- | Encodes as ASN.1 BER
instance Bin.Binary UTF8String where
    get :: Get UTF8String
get = ASN1Decode UTF8String -> Get UTF8String
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode UTF8String
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: UTF8String -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (UTF8String -> PutM Word64) -> UTF8String -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (UTF8String -> ASN1Encode Word64) -> UTF8String -> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTF8String -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------

-- | ASN.1 PrintableString
--
-- > PrintableString ::= [UNIVERSAL 19] IMPLICIT OCTET STRING
--
-- @since 0.1.1
newtype PrintableString = PrintableString ShortText deriving (PrintableString -> PrintableString -> Bool
(PrintableString -> PrintableString -> Bool)
-> (PrintableString -> PrintableString -> Bool)
-> Eq PrintableString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrintableString -> PrintableString -> Bool
$c/= :: PrintableString -> PrintableString -> Bool
== :: PrintableString -> PrintableString -> Bool
$c== :: PrintableString -> PrintableString -> Bool
Eq,Eq PrintableString
Eq PrintableString =>
(PrintableString -> PrintableString -> Ordering)
-> (PrintableString -> PrintableString -> Bool)
-> (PrintableString -> PrintableString -> Bool)
-> (PrintableString -> PrintableString -> Bool)
-> (PrintableString -> PrintableString -> Bool)
-> (PrintableString -> PrintableString -> PrintableString)
-> (PrintableString -> PrintableString -> PrintableString)
-> Ord PrintableString
PrintableString -> PrintableString -> Bool
PrintableString -> PrintableString -> Ordering
PrintableString -> PrintableString -> PrintableString
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 :: PrintableString -> PrintableString -> PrintableString
$cmin :: PrintableString -> PrintableString -> PrintableString
max :: PrintableString -> PrintableString -> PrintableString
$cmax :: PrintableString -> PrintableString -> PrintableString
>= :: PrintableString -> PrintableString -> Bool
$c>= :: PrintableString -> PrintableString -> Bool
> :: PrintableString -> PrintableString -> Bool
$c> :: PrintableString -> PrintableString -> Bool
<= :: PrintableString -> PrintableString -> Bool
$c<= :: PrintableString -> PrintableString -> Bool
< :: PrintableString -> PrintableString -> Bool
$c< :: PrintableString -> PrintableString -> Bool
compare :: PrintableString -> PrintableString -> Ordering
$ccompare :: PrintableString -> PrintableString -> Ordering
$cp1Ord :: Eq PrintableString
Ord)

instance ASN1String PrintableString where
    asn1string'supportsCodePoint :: Proxy PrintableString -> Char -> Bool
asn1string'supportsCodePoint _ = Char -> Bool
isPrintableChar
    asn1string'toCodePoints :: PrintableString -> String
asn1string'toCodePoints (PrintableString t :: ShortText
t) = ShortText -> String
TS.unpack ShortText
t
    asn1string'fromCodePoints :: String -> Maybe PrintableString
asn1string'fromCodePoints cps :: String
cps
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPrintableChar String
cps = PrintableString -> Maybe PrintableString
forall a. a -> Maybe a
Just (PrintableString -> Maybe PrintableString)
-> PrintableString -> Maybe PrintableString
forall a b. (a -> b) -> a -> b
$! ShortText -> PrintableString
PrintableString (String -> ShortText
TS.pack String
cps)
      | Bool
otherwise               = Maybe PrintableString
forall a. Maybe a
Nothing

instance Show PrintableString where
    show :: PrintableString -> String
show        (PrintableString s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s
    showsPrec :: Int -> PrintableString -> ShowS
showsPrec p :: Int
p (PrintableString s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s

printableString'fromShortText :: ShortText -> Maybe PrintableString
printableString'fromShortText :: ShortText -> Maybe PrintableString
printableString'fromShortText t :: ShortText
t
  | (Char -> Bool) -> ShortText -> Bool
TS.all Char -> Bool
isPrintableChar ShortText
t = PrintableString -> Maybe PrintableString
forall a. a -> Maybe a
Just (PrintableString -> Maybe PrintableString)
-> PrintableString -> Maybe PrintableString
forall a b. (a -> b) -> a -> b
$! ShortText -> PrintableString
PrintableString ShortText
t
  | Bool
otherwise = Maybe PrintableString
forall a. Maybe a
Nothing

printableString'fromByteString :: ByteString -> Maybe PrintableString
printableString'fromByteString :: ByteString -> Maybe PrintableString
printableString'fromByteString bs :: ByteString
bs
  | (Char -> Bool) -> ByteString -> Bool
BSC.all Char -> Bool
isPrintableChar ByteString
bs = ShortText -> PrintableString
PrintableString (ShortText -> PrintableString)
-> Maybe ShortText -> Maybe PrintableString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe ShortText
TS.fromByteString ByteString
bs
  | Bool
otherwise = Maybe PrintableString
forall a. Maybe a
Nothing

printableString'toShortText :: PrintableString -> ShortText
printableString'toShortText :: PrintableString -> ShortText
printableString'toShortText (PrintableString t :: ShortText
t) = ShortText
t

isPrintableChar :: Char -> Bool
isPrintableChar :: Char -> Bool
isPrintableChar c :: Char
c = case Char
c of
  ' ' -> Bool
True
  '*' -> Bool
False
  ':' -> Bool
True
  '=' -> Bool
True
  '?' -> Bool
True
  _ | Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('A','Z') -> Bool
True
    | Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('a','z') -> Bool
True
    | Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('0','9') -> Bool
True
    | Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('\x27','\x2f') -> Bool
True -- "'()*+,-./"
    | Bool
otherwise -> Bool
False

instance ASN1 PrintableString where
    asn1defTag :: Proxy PrintableString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 19
    asn1encode :: PrintableString -> ASN1Encode Word64
asn1encode (PrintableString t :: ShortText
t) = IMPLICIT ('UNIVERSAL 19) ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> IMPLICIT ('UNIVERSAL 19) ShortText
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT ShortText
t :: 'UNIVERSAL 19 `IMPLICIT` ShortText)
    asn1decode :: ASN1Decode PrintableString
asn1decode = (IMPLICIT ('UNIVERSAL 19) ByteString -> ByteString
unwrap (IMPLICIT ('UNIVERSAL 19) ByteString -> ByteString)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 19) ByteString)
-> ASN1Decode ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 19) ByteString)
forall t. ASN1 t => ASN1Decode t
asn1decode) ASN1Decode ByteString
-> (ByteString -> Either String PrintableString)
-> ASN1Decode PrintableString
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
                 (Either String PrintableString
-> (PrintableString -> Either String PrintableString)
-> Maybe PrintableString
-> Either String PrintableString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String PrintableString
forall a b. a -> Either a b
Left "Invalid code-point in PrintableString") PrintableString -> Either String PrintableString
forall a b. b -> Either a b
Right (Maybe PrintableString -> Either String PrintableString)
-> (ByteString -> Maybe PrintableString)
-> ByteString
-> Either String PrintableString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe PrintableString
printableString'fromByteString)
      where
        unwrap :: 'UNIVERSAL 19 `IMPLICIT` OCTET_STRING -> ByteString
        unwrap :: IMPLICIT ('UNIVERSAL 19) ByteString -> ByteString
unwrap (IMPLICIT t :: ByteString
t) = ByteString
t

-- | Encodes as ASN.1 BER
instance Bin.Binary PrintableString where
    get :: Get PrintableString
get = ASN1Decode PrintableString -> Get PrintableString
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode PrintableString
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: PrintableString -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (PrintableString -> PutM Word64) -> PrintableString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (PrintableString -> ASN1Encode Word64)
-> PrintableString
-> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------

-- | ASN.1 NumericString
--
-- > NumericString ::= [UNIVERSAL 18] IMPLICIT OCTET STRING
--
-- @since 0.1.1
newtype NumericString = NumericString ShortText deriving (NumericString -> NumericString -> Bool
(NumericString -> NumericString -> Bool)
-> (NumericString -> NumericString -> Bool) -> Eq NumericString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumericString -> NumericString -> Bool
$c/= :: NumericString -> NumericString -> Bool
== :: NumericString -> NumericString -> Bool
$c== :: NumericString -> NumericString -> Bool
Eq,Eq NumericString
Eq NumericString =>
(NumericString -> NumericString -> Ordering)
-> (NumericString -> NumericString -> Bool)
-> (NumericString -> NumericString -> Bool)
-> (NumericString -> NumericString -> Bool)
-> (NumericString -> NumericString -> Bool)
-> (NumericString -> NumericString -> NumericString)
-> (NumericString -> NumericString -> NumericString)
-> Ord NumericString
NumericString -> NumericString -> Bool
NumericString -> NumericString -> Ordering
NumericString -> NumericString -> NumericString
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 :: NumericString -> NumericString -> NumericString
$cmin :: NumericString -> NumericString -> NumericString
max :: NumericString -> NumericString -> NumericString
$cmax :: NumericString -> NumericString -> NumericString
>= :: NumericString -> NumericString -> Bool
$c>= :: NumericString -> NumericString -> Bool
> :: NumericString -> NumericString -> Bool
$c> :: NumericString -> NumericString -> Bool
<= :: NumericString -> NumericString -> Bool
$c<= :: NumericString -> NumericString -> Bool
< :: NumericString -> NumericString -> Bool
$c< :: NumericString -> NumericString -> Bool
compare :: NumericString -> NumericString -> Ordering
$ccompare :: NumericString -> NumericString -> Ordering
$cp1Ord :: Eq NumericString
Ord)

instance Show NumericString where
    show :: NumericString -> String
show        (NumericString s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s
    showsPrec :: Int -> NumericString -> ShowS
showsPrec p :: Int
p (NumericString s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s

instance ASN1String NumericString where
    asn1string'supportsCodePoint :: Proxy NumericString -> Char -> Bool
asn1string'supportsCodePoint _ = Char -> Bool
isNumericChar
    asn1string'toCodePoints :: NumericString -> String
asn1string'toCodePoints (NumericString t :: ShortText
t) = ShortText -> String
TS.unpack ShortText
t
    asn1string'fromCodePoints :: String -> Maybe NumericString
asn1string'fromCodePoints cps :: String
cps
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isNumericChar String
cps = NumericString -> Maybe NumericString
forall a. a -> Maybe a
Just (NumericString -> Maybe NumericString)
-> NumericString -> Maybe NumericString
forall a b. (a -> b) -> a -> b
$! ShortText -> NumericString
NumericString (String -> ShortText
TS.pack String
cps)
      | Bool
otherwise               = Maybe NumericString
forall a. Maybe a
Nothing

numericString'fromShortText :: ShortText -> Maybe NumericString
numericString'fromShortText :: ShortText -> Maybe NumericString
numericString'fromShortText t :: ShortText
t
  | (Char -> Bool) -> ShortText -> Bool
TS.all Char -> Bool
isNumericChar ShortText
t = NumericString -> Maybe NumericString
forall a. a -> Maybe a
Just (NumericString -> Maybe NumericString)
-> NumericString -> Maybe NumericString
forall a b. (a -> b) -> a -> b
$! ShortText -> NumericString
NumericString ShortText
t
  | Bool
otherwise = Maybe NumericString
forall a. Maybe a
Nothing

numericString'fromByteString :: ByteString -> Maybe NumericString
numericString'fromByteString :: ByteString -> Maybe NumericString
numericString'fromByteString bs :: ByteString
bs
  | (Char -> Bool) -> ByteString -> Bool
BSC.all Char -> Bool
isNumericChar ByteString
bs = ShortText -> NumericString
NumericString (ShortText -> NumericString)
-> Maybe ShortText -> Maybe NumericString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe ShortText
TS.fromByteString ByteString
bs
  | Bool
otherwise = Maybe NumericString
forall a. Maybe a
Nothing

numericString'toShortText :: NumericString -> ShortText
numericString'toShortText :: NumericString -> ShortText
numericString'toShortText (NumericString t :: ShortText
t) = ShortText
t

isNumericChar :: Char -> Bool
isNumericChar :: Char -> Bool
isNumericChar ' ' = Bool
True
isNumericChar c :: Char
c   = Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('0','9')

instance ASN1 NumericString where
    asn1defTag :: Proxy NumericString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 18
    asn1encode :: NumericString -> ASN1Encode Word64
asn1encode (NumericString t :: ShortText
t) = IMPLICIT ('UNIVERSAL 18) ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> IMPLICIT ('UNIVERSAL 18) ShortText
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT ShortText
t :: 'UNIVERSAL 18 `IMPLICIT` ShortText)
    asn1decode :: ASN1Decode NumericString
asn1decode = (IMPLICIT ('UNIVERSAL 18) ByteString -> ByteString
unwrap (IMPLICIT ('UNIVERSAL 18) ByteString -> ByteString)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 18) ByteString)
-> ASN1Decode ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 18) ByteString)
forall t. ASN1 t => ASN1Decode t
asn1decode) ASN1Decode ByteString
-> (ByteString -> Either String NumericString)
-> ASN1Decode NumericString
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
                 (Either String NumericString
-> (NumericString -> Either String NumericString)
-> Maybe NumericString
-> Either String NumericString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String NumericString
forall a b. a -> Either a b
Left "Invalid code-point in NumericString") NumericString -> Either String NumericString
forall a b. b -> Either a b
Right (Maybe NumericString -> Either String NumericString)
-> (ByteString -> Maybe NumericString)
-> ByteString
-> Either String NumericString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe NumericString
numericString'fromByteString)
      where
        unwrap :: 'UNIVERSAL 18 `IMPLICIT` OCTET_STRING -> ByteString
        unwrap :: IMPLICIT ('UNIVERSAL 18) ByteString -> ByteString
unwrap (IMPLICIT t :: ByteString
t) = ByteString
t

-- | Encodes as ASN.1 BER
instance Bin.Binary NumericString where
    get :: Get NumericString
get = ASN1Decode NumericString -> Get NumericString
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode NumericString
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: NumericString -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (NumericString -> PutM Word64) -> NumericString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (NumericString -> ASN1Encode Word64)
-> NumericString
-> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------

-- | ASN.1 VisibleString
--
-- > VisibleString ::= [UNIVERSAL 26] IMPLICIT OCTET STRING
--
-- @since 0.1.1
newtype VisibleString = VisibleString ShortText deriving (VisibleString -> VisibleString -> Bool
(VisibleString -> VisibleString -> Bool)
-> (VisibleString -> VisibleString -> Bool) -> Eq VisibleString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VisibleString -> VisibleString -> Bool
$c/= :: VisibleString -> VisibleString -> Bool
== :: VisibleString -> VisibleString -> Bool
$c== :: VisibleString -> VisibleString -> Bool
Eq,Eq VisibleString
Eq VisibleString =>
(VisibleString -> VisibleString -> Ordering)
-> (VisibleString -> VisibleString -> Bool)
-> (VisibleString -> VisibleString -> Bool)
-> (VisibleString -> VisibleString -> Bool)
-> (VisibleString -> VisibleString -> Bool)
-> (VisibleString -> VisibleString -> VisibleString)
-> (VisibleString -> VisibleString -> VisibleString)
-> Ord VisibleString
VisibleString -> VisibleString -> Bool
VisibleString -> VisibleString -> Ordering
VisibleString -> VisibleString -> VisibleString
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 :: VisibleString -> VisibleString -> VisibleString
$cmin :: VisibleString -> VisibleString -> VisibleString
max :: VisibleString -> VisibleString -> VisibleString
$cmax :: VisibleString -> VisibleString -> VisibleString
>= :: VisibleString -> VisibleString -> Bool
$c>= :: VisibleString -> VisibleString -> Bool
> :: VisibleString -> VisibleString -> Bool
$c> :: VisibleString -> VisibleString -> Bool
<= :: VisibleString -> VisibleString -> Bool
$c<= :: VisibleString -> VisibleString -> Bool
< :: VisibleString -> VisibleString -> Bool
$c< :: VisibleString -> VisibleString -> Bool
compare :: VisibleString -> VisibleString -> Ordering
$ccompare :: VisibleString -> VisibleString -> Ordering
$cp1Ord :: Eq VisibleString
Ord)

instance ASN1String VisibleString where
    asn1string'supportsCodePoint :: Proxy VisibleString -> Char -> Bool
asn1string'supportsCodePoint _ = Char -> Bool
isVisibleChar
    asn1string'toCodePoints :: VisibleString -> String
asn1string'toCodePoints (VisibleString t :: ShortText
t) = ShortText -> String
TS.unpack ShortText
t
    asn1string'fromCodePoints :: String -> Maybe VisibleString
asn1string'fromCodePoints cps :: String
cps
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isVisibleChar String
cps = VisibleString -> Maybe VisibleString
forall a. a -> Maybe a
Just (VisibleString -> Maybe VisibleString)
-> VisibleString -> Maybe VisibleString
forall a b. (a -> b) -> a -> b
$! ShortText -> VisibleString
VisibleString (String -> ShortText
TS.pack String
cps)
      | Bool
otherwise             = Maybe VisibleString
forall a. Maybe a
Nothing

instance Show VisibleString where
    show :: VisibleString -> String
show        (VisibleString s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s
    showsPrec :: Int -> VisibleString -> ShowS
showsPrec p :: Int
p (VisibleString s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s

visibleString'fromShortText :: ShortText -> Maybe VisibleString
visibleString'fromShortText :: ShortText -> Maybe VisibleString
visibleString'fromShortText t :: ShortText
t
  | (Char -> Bool) -> ShortText -> Bool
TS.all Char -> Bool
isVisibleChar ShortText
t = VisibleString -> Maybe VisibleString
forall a. a -> Maybe a
Just (VisibleString -> Maybe VisibleString)
-> VisibleString -> Maybe VisibleString
forall a b. (a -> b) -> a -> b
$! ShortText -> VisibleString
VisibleString ShortText
t
  | Bool
otherwise = Maybe VisibleString
forall a. Maybe a
Nothing

visibleString'fromByteString :: ByteString -> Maybe VisibleString
visibleString'fromByteString :: ByteString -> Maybe VisibleString
visibleString'fromByteString bs :: ByteString
bs
  | (Char -> Bool) -> ByteString -> Bool
BSC.all Char -> Bool
isVisibleChar ByteString
bs = ShortText -> VisibleString
VisibleString (ShortText -> VisibleString)
-> Maybe ShortText -> Maybe VisibleString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe ShortText
TS.fromByteString ByteString
bs
  | Bool
otherwise = Maybe VisibleString
forall a. Maybe a
Nothing

visibleString'toShortText :: VisibleString -> ShortText
visibleString'toShortText :: VisibleString -> ShortText
visibleString'toShortText (VisibleString t :: ShortText
t) = ShortText
t

isVisibleChar :: Char -> Bool
isVisibleChar :: Char -> Bool
isVisibleChar c :: Char
c = '\x20' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x7e' -- aka 'isPrint && isAscii'

instance ASN1 VisibleString where
    asn1defTag :: Proxy VisibleString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 26
    asn1encode :: VisibleString -> ASN1Encode Word64
asn1encode (VisibleString t :: ShortText
t) = IMPLICIT ('UNIVERSAL 26) ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> IMPLICIT ('UNIVERSAL 26) ShortText
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT ShortText
t :: 'UNIVERSAL 26 `IMPLICIT` ShortText)
    asn1decode :: ASN1Decode VisibleString
asn1decode = (IMPLICIT ('UNIVERSAL 26) ByteString -> ByteString
unwrap (IMPLICIT ('UNIVERSAL 26) ByteString -> ByteString)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 26) ByteString)
-> ASN1Decode ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 26) ByteString)
forall t. ASN1 t => ASN1Decode t
asn1decode) ASN1Decode ByteString
-> (ByteString -> Either String VisibleString)
-> ASN1Decode VisibleString
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
                 (Either String VisibleString
-> (VisibleString -> Either String VisibleString)
-> Maybe VisibleString
-> Either String VisibleString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String VisibleString
forall a b. a -> Either a b
Left "Invalid code-point in VisibleString") VisibleString -> Either String VisibleString
forall a b. b -> Either a b
Right (Maybe VisibleString -> Either String VisibleString)
-> (ByteString -> Maybe VisibleString)
-> ByteString
-> Either String VisibleString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe VisibleString
visibleString'fromByteString)
      where
        unwrap :: 'UNIVERSAL 26 `IMPLICIT` OCTET_STRING -> ByteString
        unwrap :: IMPLICIT ('UNIVERSAL 26) ByteString -> ByteString
unwrap (IMPLICIT t :: ByteString
t) = ByteString
t

-- | Encodes as ASN.1 BER
instance Bin.Binary VisibleString where
    get :: Get VisibleString
get = ASN1Decode VisibleString -> Get VisibleString
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode VisibleString
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: VisibleString -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (VisibleString -> PutM Word64) -> VisibleString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (VisibleString -> ASN1Encode Word64)
-> VisibleString
-> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VisibleString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------

-- | ASN.1 IA5String
--
-- > IA5String ::= [UNIVERSAL 22] IMPLICIT OCTET STRING
--
-- @since 0.1.1
newtype IA5String = IA5String ShortText deriving (IA5String -> IA5String -> Bool
(IA5String -> IA5String -> Bool)
-> (IA5String -> IA5String -> Bool) -> Eq IA5String
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IA5String -> IA5String -> Bool
$c/= :: IA5String -> IA5String -> Bool
== :: IA5String -> IA5String -> Bool
$c== :: IA5String -> IA5String -> Bool
Eq,Eq IA5String
Eq IA5String =>
(IA5String -> IA5String -> Ordering)
-> (IA5String -> IA5String -> Bool)
-> (IA5String -> IA5String -> Bool)
-> (IA5String -> IA5String -> Bool)
-> (IA5String -> IA5String -> Bool)
-> (IA5String -> IA5String -> IA5String)
-> (IA5String -> IA5String -> IA5String)
-> Ord IA5String
IA5String -> IA5String -> Bool
IA5String -> IA5String -> Ordering
IA5String -> IA5String -> IA5String
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 :: IA5String -> IA5String -> IA5String
$cmin :: IA5String -> IA5String -> IA5String
max :: IA5String -> IA5String -> IA5String
$cmax :: IA5String -> IA5String -> IA5String
>= :: IA5String -> IA5String -> Bool
$c>= :: IA5String -> IA5String -> Bool
> :: IA5String -> IA5String -> Bool
$c> :: IA5String -> IA5String -> Bool
<= :: IA5String -> IA5String -> Bool
$c<= :: IA5String -> IA5String -> Bool
< :: IA5String -> IA5String -> Bool
$c< :: IA5String -> IA5String -> Bool
compare :: IA5String -> IA5String -> Ordering
$ccompare :: IA5String -> IA5String -> Ordering
$cp1Ord :: Eq IA5String
Ord)

instance ASN1String IA5String where
    asn1string'supportsCodePoint :: Proxy IA5String -> Char -> Bool
asn1string'supportsCodePoint _ = Char -> Bool
isIA5Char
    asn1string'toCodePoints :: IA5String -> String
asn1string'toCodePoints (IA5String t :: ShortText
t) = ShortText -> String
TS.unpack ShortText
t
    asn1string'fromCodePoints :: String -> Maybe IA5String
asn1string'fromCodePoints cps :: String
cps
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isIA5Char String
cps = IA5String -> Maybe IA5String
forall a. a -> Maybe a
Just (IA5String -> Maybe IA5String) -> IA5String -> Maybe IA5String
forall a b. (a -> b) -> a -> b
$! ShortText -> IA5String
IA5String (String -> ShortText
TS.pack String
cps)
      | Bool
otherwise         = Maybe IA5String
forall a. Maybe a
Nothing

instance Show IA5String where
    show :: IA5String -> String
show        (IA5String s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s
    showsPrec :: Int -> IA5String -> ShowS
showsPrec p :: Int
p (IA5String s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s

ia5String'fromShortText :: ShortText -> Maybe IA5String
ia5String'fromShortText :: ShortText -> Maybe IA5String
ia5String'fromShortText t :: ShortText
t
  | (Char -> Bool) -> ShortText -> Bool
TS.all Char -> Bool
isIA5Char ShortText
t = IA5String -> Maybe IA5String
forall a. a -> Maybe a
Just (IA5String -> Maybe IA5String) -> IA5String -> Maybe IA5String
forall a b. (a -> b) -> a -> b
$! ShortText -> IA5String
IA5String ShortText
t
  | Bool
otherwise = Maybe IA5String
forall a. Maybe a
Nothing

ia5String'fromByteString :: ByteString -> Maybe IA5String
ia5String'fromByteString :: ByteString -> Maybe IA5String
ia5String'fromByteString bs :: ByteString
bs
  | (Char -> Bool) -> ByteString -> Bool
BSC.all Char -> Bool
isIA5Char ByteString
bs = ShortText -> IA5String
IA5String (ShortText -> IA5String) -> Maybe ShortText -> Maybe IA5String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe ShortText
TS.fromByteString ByteString
bs
  | Bool
otherwise = Maybe IA5String
forall a. Maybe a
Nothing

ia5String'toShortText :: IA5String -> ShortText
ia5String'toShortText :: IA5String -> ShortText
ia5String'toShortText (IA5String t :: ShortText
t) = ShortText
t

isIA5Char :: Char -> Bool
isIA5Char :: Char -> Bool
isIA5Char c :: Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x7f'

instance ASN1 IA5String where
    asn1defTag :: Proxy IA5String -> Tag
asn1defTag _ = Word64 -> Tag
Universal 22
    asn1encode :: IA5String -> ASN1Encode Word64
asn1encode (IA5String t :: ShortText
t) = IMPLICIT ('UNIVERSAL 22) ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> IMPLICIT ('UNIVERSAL 22) ShortText
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT ShortText
t :: 'UNIVERSAL 22 `IMPLICIT` ShortText)
    asn1decode :: ASN1Decode IA5String
asn1decode = (IMPLICIT ('UNIVERSAL 22) ByteString -> ByteString
unwrap (IMPLICIT ('UNIVERSAL 22) ByteString -> ByteString)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 22) ByteString)
-> ASN1Decode ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 22) ByteString)
forall t. ASN1 t => ASN1Decode t
asn1decode) ASN1Decode ByteString
-> (ByteString -> Either String IA5String) -> ASN1Decode IA5String
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
                 (Either String IA5String
-> (IA5String -> Either String IA5String)
-> Maybe IA5String
-> Either String IA5String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String IA5String
forall a b. a -> Either a b
Left "Invalid code-point in IA5String") IA5String -> Either String IA5String
forall a b. b -> Either a b
Right (Maybe IA5String -> Either String IA5String)
-> (ByteString -> Maybe IA5String)
-> ByteString
-> Either String IA5String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe IA5String
ia5String'fromByteString)
      where
        unwrap :: 'UNIVERSAL 22 `IMPLICIT` OCTET_STRING -> ByteString
        unwrap :: IMPLICIT ('UNIVERSAL 22) ByteString -> ByteString
unwrap (IMPLICIT t :: ByteString
t) = ByteString
t

-- | Encodes as ASN.1 BER
instance Bin.Binary IA5String where
    get :: Get IA5String
get = ASN1Decode IA5String -> Get IA5String
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode IA5String
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: IA5String -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (IA5String -> PutM Word64) -> IA5String -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (IA5String -> ASN1Encode Word64) -> IA5String -> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IA5String -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------

-- | ASN.1 BMPString
--
-- > BMPString ::= [UNIVERSAL 30] IMPLICIT OCTET STRING
--
-- NB: The surrogate-pair range U+D800 through U+DFFF is tolerated and thus the responsibility of code converting to and
-- from 'BMPString'
--
-- @since 0.1.1
newtype BMPString = BMPString SBS.ShortByteString deriving (BMPString -> BMPString -> Bool
(BMPString -> BMPString -> Bool)
-> (BMPString -> BMPString -> Bool) -> Eq BMPString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BMPString -> BMPString -> Bool
$c/= :: BMPString -> BMPString -> Bool
== :: BMPString -> BMPString -> Bool
$c== :: BMPString -> BMPString -> Bool
Eq,Eq BMPString
Eq BMPString =>
(BMPString -> BMPString -> Ordering)
-> (BMPString -> BMPString -> Bool)
-> (BMPString -> BMPString -> Bool)
-> (BMPString -> BMPString -> Bool)
-> (BMPString -> BMPString -> Bool)
-> (BMPString -> BMPString -> BMPString)
-> (BMPString -> BMPString -> BMPString)
-> Ord BMPString
BMPString -> BMPString -> Bool
BMPString -> BMPString -> Ordering
BMPString -> BMPString -> BMPString
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 :: BMPString -> BMPString -> BMPString
$cmin :: BMPString -> BMPString -> BMPString
max :: BMPString -> BMPString -> BMPString
$cmax :: BMPString -> BMPString -> BMPString
>= :: BMPString -> BMPString -> Bool
$c>= :: BMPString -> BMPString -> Bool
> :: BMPString -> BMPString -> Bool
$c> :: BMPString -> BMPString -> Bool
<= :: BMPString -> BMPString -> Bool
$c<= :: BMPString -> BMPString -> Bool
< :: BMPString -> BMPString -> Bool
$c< :: BMPString -> BMPString -> Bool
compare :: BMPString -> BMPString -> Ordering
$ccompare :: BMPString -> BMPString -> Ordering
$cp1Ord :: Eq BMPString
Ord)

instance ASN1String BMPString where
    asn1string'supportsCodePoint :: Proxy BMPString -> Char -> Bool
asn1string'supportsCodePoint _ = (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xffff')
    asn1string'toCodePoints :: BMPString -> String
asn1string'toCodePoints   = BMPString -> String
bmpString'toString
    asn1string'fromCodePoints :: String -> Maybe BMPString
asn1string'fromCodePoints = String -> Maybe BMPString
bmpString'fromString

instance Show BMPString where
    show :: BMPString -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (BMPString -> String) -> BMPString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMPString -> String
bmpString'toString
    showsPrec :: Int -> BMPString -> ShowS
showsPrec p :: Int
p = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (String -> ShowS) -> (BMPString -> String) -> BMPString -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMPString -> String
bmpString'toString

bmpString'toUcs2CodePoints :: BMPString -> [Word16]
bmpString'toUcs2CodePoints :: BMPString -> [Word16]
bmpString'toUcs2CodePoints (BMPString sbs :: ShortByteString
sbs) = [Word8] -> [Word16]
forall a a. (Integral a, Num a) => [a] -> [a]
go (ShortByteString -> [Word8]
SBS.unpack ShortByteString
sbs)
  where
    go :: [a] -> [a]
go (h :: a
h:l :: a
l:rest :: [a]
rest) = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
ha -> a -> a
forall a. Num a => a -> a -> a
*0x100)a -> a -> a
forall a. Num a => a -> a -> a
+a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest
    go []         = []
    go [_]        = [a]
forall a. a
impossible -- forbidden by invariant

bmpString'fromUcs2CodePoints :: [Word16] -> BMPString
bmpString'fromUcs2CodePoints :: [Word16] -> BMPString
bmpString'fromUcs2CodePoints cps :: [Word16]
cps = ShortByteString -> BMPString
BMPString ([Word8] -> ShortByteString
SBS.pack ([Word8] -> ShortByteString) -> [Word8] -> ShortByteString
forall a b. (a -> b) -> a -> b
$ [Word16] -> [Word8]
forall a a. (Integral a, Bits a, Num a) => [a] -> [a]
go [Word16]
cps)
  where
    go :: [a] -> [a]
go (cp :: a
cp:rest :: [a]
rest) = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
cp a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` 8) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
cp a -> a -> a
forall a. Bits a => a -> a -> a
.&. 0xff) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
rest
    go []        = []

-- NB: Surrogate pair code-points (U+D800 through U+DFFF) are transparently emitted as surrogate 'Char' code-points
bmpString'toString :: BMPString -> String
bmpString'toString :: BMPString -> String
bmpString'toString = (Word16 -> Char) -> [Word16] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word16 -> Int) -> Word16 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word16] -> String)
-> (BMPString -> [Word16]) -> BMPString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMPString -> [Word16]
bmpString'toUcs2CodePoints

-- NB: Surrogate pair code-points (U+D800 through U+DFFF) are not rejected in order for 'bmpString'toString' to be an inverse operation.
bmpString'fromString :: String -> Maybe BMPString
bmpString'fromString :: String -> Maybe BMPString
bmpString'fromString s :: String
s
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xffff') String
s = BMPString -> Maybe BMPString
forall a. a -> Maybe a
Just (BMPString -> Maybe BMPString) -> BMPString -> Maybe BMPString
forall a b. (a -> b) -> a -> b
$! [Word16] -> BMPString
bmpString'fromUcs2CodePoints ([Word16] -> BMPString) -> [Word16] -> BMPString
forall a b. (a -> b) -> a -> b
$ (Char -> Word16) -> String -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (Char -> Int) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
s
  | Bool
otherwise = Maybe BMPString
forall a. Maybe a
Nothing

bmpString'fromByteString :: ByteString -> Maybe BMPString
bmpString'fromByteString :: ByteString -> Maybe BMPString
bmpString'fromByteString bs :: ByteString
bs
 | Int -> Bool
forall a. Integral a => a -> Bool
even (ByteString -> Int
BSC.length ByteString
bs) = BMPString -> Maybe BMPString
forall a. a -> Maybe a
Just (BMPString -> Maybe BMPString) -> BMPString -> Maybe BMPString
forall a b. (a -> b) -> a -> b
$! ShortByteString -> BMPString
BMPString (ByteString -> ShortByteString
SBS.toShort ByteString
bs)
 | Bool
otherwise = Maybe BMPString
forall a. Maybe a
Nothing

instance ASN1 BMPString where
    asn1defTag :: Proxy BMPString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 30
    asn1encode :: BMPString -> ASN1Encode Word64
asn1encode (BMPString t :: ShortByteString
t) = IMPLICIT ('UNIVERSAL 30) ByteString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ByteString -> IMPLICIT ('UNIVERSAL 30) ByteString
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT (ShortByteString -> ByteString
SBS.fromShort ShortByteString
t) :: 'UNIVERSAL 30 `IMPLICIT` OCTET_STRING)
    asn1decode :: ASN1Decode BMPString
asn1decode = (IMPLICIT ('UNIVERSAL 30) ByteString -> ByteString
unwrap (IMPLICIT ('UNIVERSAL 30) ByteString -> ByteString)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 30) ByteString)
-> ASN1Decode ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 30) ByteString)
forall t. ASN1 t => ASN1Decode t
asn1decode) ASN1Decode ByteString
-> (ByteString -> Either String BMPString) -> ASN1Decode BMPString
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
                 (Either String BMPString
-> (BMPString -> Either String BMPString)
-> Maybe BMPString
-> Either String BMPString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String BMPString
forall a b. a -> Either a b
Left "Invalid code-point in BMPString") BMPString -> Either String BMPString
forall a b. b -> Either a b
Right (Maybe BMPString -> Either String BMPString)
-> (ByteString -> Maybe BMPString)
-> ByteString
-> Either String BMPString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe BMPString
bmpString'fromByteString)
      where
        unwrap :: 'UNIVERSAL 30 `IMPLICIT` OCTET_STRING -> ByteString
        unwrap :: IMPLICIT ('UNIVERSAL 30) ByteString -> ByteString
unwrap (IMPLICIT t :: ByteString
t) = ByteString
t

-- | Encodes as ASN.1 BER
instance Bin.Binary BMPString where
    get :: Get BMPString
get = ASN1Decode BMPString -> Get BMPString
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode BMPString
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: BMPString -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (BMPString -> PutM Word64) -> BMPString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (BMPString -> ASN1Encode Word64) -> BMPString -> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BMPString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------

-- | ASN.1 UniversalString
--
-- > UniversalString ::= [UNIVERSAL 28] IMPLICIT OCTET STRING
--
-- NB: The surrogate-pair range U+D800 through U+DFFF is tolerated and thus becomes the responsibility of code converting to and from 'UniversalString'
--
-- @since 0.1.1
newtype UniversalString = UniversalString SBS.ShortByteString
  deriving (UniversalString -> UniversalString -> Bool
(UniversalString -> UniversalString -> Bool)
-> (UniversalString -> UniversalString -> Bool)
-> Eq UniversalString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniversalString -> UniversalString -> Bool
$c/= :: UniversalString -> UniversalString -> Bool
== :: UniversalString -> UniversalString -> Bool
$c== :: UniversalString -> UniversalString -> Bool
Eq,Eq UniversalString
Eq UniversalString =>
(UniversalString -> UniversalString -> Ordering)
-> (UniversalString -> UniversalString -> Bool)
-> (UniversalString -> UniversalString -> Bool)
-> (UniversalString -> UniversalString -> Bool)
-> (UniversalString -> UniversalString -> Bool)
-> (UniversalString -> UniversalString -> UniversalString)
-> (UniversalString -> UniversalString -> UniversalString)
-> Ord UniversalString
UniversalString -> UniversalString -> Bool
UniversalString -> UniversalString -> Ordering
UniversalString -> UniversalString -> UniversalString
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 :: UniversalString -> UniversalString -> UniversalString
$cmin :: UniversalString -> UniversalString -> UniversalString
max :: UniversalString -> UniversalString -> UniversalString
$cmax :: UniversalString -> UniversalString -> UniversalString
>= :: UniversalString -> UniversalString -> Bool
$c>= :: UniversalString -> UniversalString -> Bool
> :: UniversalString -> UniversalString -> Bool
$c> :: UniversalString -> UniversalString -> Bool
<= :: UniversalString -> UniversalString -> Bool
$c<= :: UniversalString -> UniversalString -> Bool
< :: UniversalString -> UniversalString -> Bool
$c< :: UniversalString -> UniversalString -> Bool
compare :: UniversalString -> UniversalString -> Ordering
$ccompare :: UniversalString -> UniversalString -> Ordering
$cp1Ord :: Eq UniversalString
Ord)

instance ASN1String UniversalString where
    asn1string'supportsCodePoint :: Proxy UniversalString -> Char -> Bool
asn1string'supportsCodePoint _ = Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True
    asn1string'toCodePoints :: UniversalString -> String
asn1string'toCodePoints = UniversalString -> String
universalString'toString
    asn1string'fromCodePoints :: String -> Maybe UniversalString
asn1string'fromCodePoints = \s :: String
s -> UniversalString -> Maybe UniversalString
forall a. a -> Maybe a
Just (UniversalString -> Maybe UniversalString)
-> UniversalString -> Maybe UniversalString
forall a b. (a -> b) -> a -> b
$! String -> UniversalString
universalString'fromString String
s

instance Show UniversalString where
    show :: UniversalString -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (UniversalString -> String) -> UniversalString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalString -> String
universalString'toString
    showsPrec :: Int -> UniversalString -> ShowS
showsPrec p :: Int
p = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (String -> ShowS)
-> (UniversalString -> String) -> UniversalString -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalString -> String
universalString'toString

-- NB: Surrogate pair code-points (U+D800 through U+DFFF) are transparently emitted as surrogate 'Char' code-points
universalString'toString :: UniversalString -> String
universalString'toString :: UniversalString -> String
universalString'toString = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall a. a
impossible ShowS
forall a. a -> a
id (Maybe String -> String)
-> (UniversalString -> Maybe String) -> UniversalString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe String
bsToUcs4 (ByteString -> Maybe String)
-> (UniversalString -> ByteString)
-> UniversalString
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(UniversalString x :: ShortByteString
x) -> ShortByteString -> ByteString
SBS.fromShort ShortByteString
x)

-- NB: Surrogate pair code-points (U+D800 through U+DFFF) are not rejected in order for 'universalString'toString' to be an inverse operation.
universalString'fromString :: String -> UniversalString
universalString'fromString :: String -> UniversalString
universalString'fromString = ShortByteString -> UniversalString
UniversalString (ShortByteString -> UniversalString)
-> (String -> ShortByteString) -> String -> UniversalString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (String -> ByteString) -> String -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
ucs4ToBs

universalString'fromByteString :: ByteString -> Maybe UniversalString
universalString'fromByteString :: ByteString -> Maybe UniversalString
universalString'fromByteString bs :: ByteString
bs
 | Just _ <- ByteString -> Maybe String
bsToUcs4 ByteString
bs = UniversalString -> Maybe UniversalString
forall a. a -> Maybe a
Just (ShortByteString -> UniversalString
UniversalString (ShortByteString -> UniversalString)
-> ShortByteString -> UniversalString
forall a b. (a -> b) -> a -> b
$ ByteString -> ShortByteString
SBS.toShort ByteString
bs)
 | Bool
otherwise = Maybe UniversalString
forall a. Maybe a
Nothing

-- internal
bsToUcs4 :: ByteString -> Maybe [Char]
bsToUcs4 :: ByteString -> Maybe String
bsToUcs4 bs :: ByteString
bs
  | (n :: Int
n,0) <- ByteString -> Int
BSC.length ByteString
bs Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 4 = Get String -> ByteString -> Maybe String
forall a. Get a -> ByteString -> Maybe a
runGetMaybe (Int -> Get Char -> Get String
forall a. Int -> Get a -> Get [a]
repGet Int
n Get Char
f) ByteString
bs
  | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
  where
    f :: Get Char
f = do Word32
x <- Get Word32
Bin.getWord32be
           Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word32
x Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0x10ffff)
           Char -> Get Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Get Char) -> Char -> Get Char
forall a b. (a -> b) -> a -> b
$! Int -> Char
chr (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)

ucs4ToBs :: [Char] -> ByteString
ucs4ToBs :: String -> ByteString
ucs4ToBs cs :: String
cs = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
Bin.runPut ((Word32 -> Put) -> [Word32] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word32 -> Put
Bin.putWord32be [Word32]
cs')
  where
    cs' :: [Word32]
    cs' :: [Word32]
cs' = (Char -> Word32) -> String -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> (Char -> Int) -> Char -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
cs

instance ASN1 UniversalString where
    asn1defTag :: Proxy UniversalString -> Tag
asn1defTag _ = Word64 -> Tag
Universal 28
    asn1encode :: UniversalString -> ASN1Encode Word64
asn1encode (UniversalString t :: ShortByteString
t) = IMPLICIT ('UNIVERSAL 28) ByteString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ByteString -> IMPLICIT ('UNIVERSAL 28) ByteString
forall (tag :: TagK) x. x -> IMPLICIT tag x
IMPLICIT (ShortByteString -> ByteString
SBS.fromShort ShortByteString
t) :: 'UNIVERSAL 28 `IMPLICIT` OCTET_STRING)
    asn1decode :: ASN1Decode UniversalString
asn1decode = (IMPLICIT ('UNIVERSAL 28) ByteString -> ByteString
unwrap (IMPLICIT ('UNIVERSAL 28) ByteString -> ByteString)
-> ASN1Decode (IMPLICIT ('UNIVERSAL 28) ByteString)
-> ASN1Decode ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1Decode (IMPLICIT ('UNIVERSAL 28) ByteString)
forall t. ASN1 t => ASN1Decode t
asn1decode) ASN1Decode ByteString
-> (ByteString -> Either String UniversalString)
-> ASN1Decode UniversalString
forall x y. ASN1Decode x -> (x -> Either String y) -> ASN1Decode y
`transformVia`
                 (Either String UniversalString
-> (UniversalString -> Either String UniversalString)
-> Maybe UniversalString
-> Either String UniversalString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String UniversalString
forall a b. a -> Either a b
Left "Invalid code-point in UniversalString") UniversalString -> Either String UniversalString
forall a b. b -> Either a b
Right (Maybe UniversalString -> Either String UniversalString)
-> (ByteString -> Maybe UniversalString)
-> ByteString
-> Either String UniversalString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UniversalString
universalString'fromByteString)
      where
        unwrap :: 'UNIVERSAL 28 `IMPLICIT` OCTET_STRING -> ByteString
        unwrap :: IMPLICIT ('UNIVERSAL 28) ByteString -> ByteString
unwrap (IMPLICIT t :: ByteString
t) = ByteString
t

-- | Encodes as ASN.1 BER
instance Bin.Binary UniversalString where
    get :: Get UniversalString
get = ASN1Decode UniversalString -> Get UniversalString
forall x. ASN1Decode x -> Get x
toBinaryGet ASN1Decode UniversalString
forall t. ASN1 t => ASN1Decode t
asn1decode
    put :: UniversalString -> Put
put = PutM Word64 -> Put
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PutM Word64 -> Put)
-> (UniversalString -> PutM Word64) -> UniversalString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Encode Word64 -> PutM Word64
forall a. ASN1Encode a -> PutM a
toBinaryPut (ASN1Encode Word64 -> PutM Word64)
-> (UniversalString -> ASN1Encode Word64)
-> UniversalString
-> PutM Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniversalString -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode

----------------------------------------------------------------------------
-- helpers

runGetMaybe :: Bin.Get a -> ByteString -> Maybe a
runGetMaybe :: Get a -> ByteString -> Maybe a
runGetMaybe g :: Get a
g bs :: ByteString
bs = case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Bin.runGetOrFail Get a
g (ByteString -> ByteString
BL.fromStrict ByteString
bs) of
  Left _ -> Maybe a
forall a. Maybe a
Nothing
  Right (rest :: ByteString
rest,_,x :: a
x)
    | ByteString -> Bool
BL.null ByteString
rest -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! a
x
    | Bool
otherwise     -> Maybe a
forall a. Maybe a
Nothing

repGet :: Int -> Bin.Get a -> Bin.Get [a]
repGet :: Int -> Get a -> Get [a]
repGet n :: Int
n g :: Get a
g = [a] -> Int -> Get [a]
forall t. (Eq t, Num t) => [a] -> t -> Get [a]
go [] Int
n
 where
   go :: [a] -> t -> Get [a]
go xs :: [a]
xs 0 = [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Get [a]) -> [a] -> Get [a]
forall a b. (a -> b) -> a -> b
$! [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs
   go xs :: [a]
xs i :: t
i = do { a
x <- Get a
g; a
x a -> Get [a] -> Get [a]
forall a b. a -> b -> b
`seq` [a] -> t -> Get [a]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) (t
it -> t -> t
forall a. Num a => a -> a -> a
-1) }

isSurr :: Char -> Bool
isSurr :: Char -> Bool
isSurr c :: Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xd800' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xdfff'