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

Different String types available in ASN.1.
-}

module Data.ASN1.Types.String
  ( ASN1StringEncoding (..)
  , ASN1CharacterString (..)
  , asn1CharacterString
  , asn1CharacterToString
  ) where

import           Data.Bits ( (.&.), (.|.), shiftL, shiftR, testBit )
import           Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import           Data.String ( IsString (..) )
import           Data.Word ( Word16, Word32, Word8 )

-- A note on T.61 encodings. The actual specification of a T.61 character set

-- seems to be lost in time. As such, it will be considered an ASCII-like

-- encoding.

--

-- <http://www.mail-archive.com/asn1@asn1.org/msg00460.html>

-- "sizable volume of software in the world treats TeletexString (T61String)

-- as a simple 8-bit string with mostly Windows Latin 1"


-- | Define all possible ASN.1 String encodings.

data ASN1StringEncoding =
    IA5
    -- ^ 128 characters equivalent to the ASCII alphabet.

  | UTF8
    -- ^ UTF8.

  | General
    -- ^ All registered graphic and character sets (see ISO 2375) plus SPACE and

    -- DELETE.

  | Graphic
    -- ^ All registered G sets and SPACE.

  | Numeric
    -- ^ Encoding containing numeric [0-9] and space.

  | Printable
    -- ^ Printable [a-z] [A-Z] [()+,-.?:/=] and space.

  | VideoTex
    -- ^ CCITT's T.100 and T.101 character sets.

  | Visible
    -- ^ International ASCII printing character sets.

  | T61
    -- ^ Teletext.

  | UTF32
    -- ^ UTF32.

  | Character
    -- ^ Character.

  | BMP
    -- ^ UCS2.

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

-- | Provide a way to possibly encode or decode character strings based on

-- character encoding.

stringEncodingFunctions ::
     ASN1StringEncoding
  -> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions :: ASN1StringEncoding
-> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions ASN1StringEncoding
encoding
  | ASN1StringEncoding
encoding ASN1StringEncoding -> ASN1StringEncoding -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1StringEncoding
UTF8                   = (ByteString -> String, String -> ByteString)
-> Maybe (ByteString -> String, String -> ByteString)
forall a. a -> Maybe a
Just (ByteString -> String
decodeUTF8, String -> ByteString
encodeUTF8)
  | ASN1StringEncoding
encoding ASN1StringEncoding -> ASN1StringEncoding -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1StringEncoding
BMP                    = (ByteString -> String, String -> ByteString)
-> Maybe (ByteString -> String, String -> ByteString)
forall a. a -> Maybe a
Just (ByteString -> String
decodeBMP, String -> ByteString
encodeBMP)
  | ASN1StringEncoding
encoding ASN1StringEncoding -> ASN1StringEncoding -> Bool
forall a. Eq a => a -> a -> Bool
== ASN1StringEncoding
UTF32                  = (ByteString -> String, String -> ByteString)
-> Maybe (ByteString -> String, String -> ByteString)
forall a. a -> Maybe a
Just (ByteString -> String
decodeUTF32, String -> ByteString
encodeUTF32)
  | ASN1StringEncoding
encoding ASN1StringEncoding -> [ASN1StringEncoding] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ASN1StringEncoding]
asciiLikeEncodings = (ByteString -> String, String -> ByteString)
-> Maybe (ByteString -> String, String -> ByteString)
forall a. a -> Maybe a
Just (ByteString -> String
decodeASCII, String -> ByteString
encodeASCII)
  | Bool
otherwise                          = Maybe (ByteString -> String, String -> ByteString)
forall a. Maybe a
Nothing
 where
  asciiLikeEncodings :: [ASN1StringEncoding]
asciiLikeEncodings = [ASN1StringEncoding
IA5,ASN1StringEncoding
Numeric,ASN1StringEncoding
Printable,ASN1StringEncoding
Visible,ASN1StringEncoding
General,ASN1StringEncoding
Graphic,ASN1StringEncoding
T61]

-- | Encode a string into a character string.

asn1CharacterString :: ASN1StringEncoding -> String -> ASN1CharacterString
asn1CharacterString :: ASN1StringEncoding -> String -> ASN1CharacterString
asn1CharacterString ASN1StringEncoding
encoding String
s =
  case ASN1StringEncoding
-> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions ASN1StringEncoding
encoding of
    Just (ByteString -> String
_, String -> ByteString
e) -> ASN1StringEncoding -> ByteString -> ASN1CharacterString
ASN1CharacterString ASN1StringEncoding
encoding (String -> ByteString
e String
s)
    Maybe (ByteString -> String, String -> ByteString)
Nothing     ->
      String -> ASN1CharacterString
forall a. HasCallStack => String -> a
error (String
"cannot encode ASN1 Character String " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ASN1StringEncoding -> String
forall a. Show a => a -> String
show ASN1StringEncoding
encoding String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from string")

-- | Try to decode an 'ASN1CharacterString' to a String.

asn1CharacterToString :: ASN1CharacterString -> Maybe String
asn1CharacterToString :: ASN1CharacterString -> Maybe String
asn1CharacterToString (ASN1CharacterString ASN1StringEncoding
encoding ByteString
bs) =
  case ASN1StringEncoding
-> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions ASN1StringEncoding
encoding of
    Just (ByteString -> String
d, String -> ByteString
_) -> String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
d ByteString
bs)
    Maybe (ByteString -> String, String -> ByteString)
Nothing     -> Maybe String
forall a. Maybe a
Nothing

-- | ASN1 Character String with encoding

data ASN1CharacterString = ASN1CharacterString
  { ASN1CharacterString -> ASN1StringEncoding
characterEncoding         :: ASN1StringEncoding
  , ASN1CharacterString -> ByteString
getCharacterStringRawData :: ByteString
  }
  deriving (ASN1CharacterString -> ASN1CharacterString -> Bool
(ASN1CharacterString -> ASN1CharacterString -> Bool)
-> (ASN1CharacterString -> ASN1CharacterString -> Bool)
-> Eq ASN1CharacterString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ASN1CharacterString -> ASN1CharacterString -> Bool
== :: ASN1CharacterString -> ASN1CharacterString -> Bool
$c/= :: ASN1CharacterString -> ASN1CharacterString -> Bool
/= :: ASN1CharacterString -> ASN1CharacterString -> Bool
Eq, Eq ASN1CharacterString
Eq ASN1CharacterString =>
(ASN1CharacterString -> ASN1CharacterString -> Ordering)
-> (ASN1CharacterString -> ASN1CharacterString -> Bool)
-> (ASN1CharacterString -> ASN1CharacterString -> Bool)
-> (ASN1CharacterString -> ASN1CharacterString -> Bool)
-> (ASN1CharacterString -> ASN1CharacterString -> Bool)
-> (ASN1CharacterString
    -> ASN1CharacterString -> ASN1CharacterString)
-> (ASN1CharacterString
    -> ASN1CharacterString -> ASN1CharacterString)
-> Ord ASN1CharacterString
ASN1CharacterString -> ASN1CharacterString -> Bool
ASN1CharacterString -> ASN1CharacterString -> Ordering
ASN1CharacterString -> ASN1CharacterString -> ASN1CharacterString
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 :: ASN1CharacterString -> ASN1CharacterString -> Ordering
compare :: ASN1CharacterString -> ASN1CharacterString -> Ordering
$c< :: ASN1CharacterString -> ASN1CharacterString -> Bool
< :: ASN1CharacterString -> ASN1CharacterString -> Bool
$c<= :: ASN1CharacterString -> ASN1CharacterString -> Bool
<= :: ASN1CharacterString -> ASN1CharacterString -> Bool
$c> :: ASN1CharacterString -> ASN1CharacterString -> Bool
> :: ASN1CharacterString -> ASN1CharacterString -> Bool
$c>= :: ASN1CharacterString -> ASN1CharacterString -> Bool
>= :: ASN1CharacterString -> ASN1CharacterString -> Bool
$cmax :: ASN1CharacterString -> ASN1CharacterString -> ASN1CharacterString
max :: ASN1CharacterString -> ASN1CharacterString -> ASN1CharacterString
$cmin :: ASN1CharacterString -> ASN1CharacterString -> ASN1CharacterString
min :: ASN1CharacterString -> ASN1CharacterString -> ASN1CharacterString
Ord, Int -> ASN1CharacterString -> ShowS
[ASN1CharacterString] -> ShowS
ASN1CharacterString -> String
(Int -> ASN1CharacterString -> ShowS)
-> (ASN1CharacterString -> String)
-> ([ASN1CharacterString] -> ShowS)
-> Show ASN1CharacterString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ASN1CharacterString -> ShowS
showsPrec :: Int -> ASN1CharacterString -> ShowS
$cshow :: ASN1CharacterString -> String
show :: ASN1CharacterString -> String
$cshowList :: [ASN1CharacterString] -> ShowS
showList :: [ASN1CharacterString] -> ShowS
Show)

instance IsString ASN1CharacterString where
  fromString :: String -> ASN1CharacterString
fromString String
s = ASN1StringEncoding -> ByteString -> ASN1CharacterString
ASN1CharacterString ASN1StringEncoding
UTF8 (String -> ByteString
encodeUTF8 String
s)

decodeUTF8 :: ByteString -> String
decodeUTF8 :: ByteString -> String
decodeUTF8 ByteString
b = Int -> [Word8] -> String
loop Int
0 ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
b
 where
  loop :: Int -> [Word8] -> [Char]
  loop :: Int -> [Word8] -> String
loop Int
_ [] = []
  loop Int
pos (Word8
x:[Word8]
xs)
    | Word8
x Word8 -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
7 = Int -> Char
forall a. Enum a => Int -> a
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Word8]
xs
    | Word8
x Word8 -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
6 = ShowS
forall a. HasCallStack => String -> a
error String
"continuation byte in heading context"
    | Word8
x Word8 -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
5 = Int -> Word8 -> Int -> [Word8] -> String
uncont Int
1 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1f) Int
pos [Word8]
xs
    | Word8
x Word8 -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
4 = Int -> Word8 -> Int -> [Word8] -> String
uncont Int
2 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf)  Int
pos [Word8]
xs
    | Word8
x Word8 -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
3 = Int -> Word8 -> Int -> [Word8] -> String
uncont Int
3 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7)  Int
pos [Word8]
xs
    | Bool
otherwise     = ShowS
forall a. HasCallStack => String -> a
error String
"too many byte"
  uncont :: Int -> Word8 -> Int -> [Word8] -> [Char]
  uncont :: Int -> Word8 -> Int -> [Word8] -> String
uncont Int
1 Word8
iniV Int
pos [Word8]
xs =
    case [Word8]
xs of
      Word8
c1:[Word8]
xs' -> Word8 -> [Word8] -> Char
decodeCont Word8
iniV [Word8
c1] Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) [Word8]
xs'
      [Word8]
_      -> ShowS
forall a. HasCallStack => String -> a
error String
"truncated continuation, expecting 1 byte"
  uncont Int
2 Word8
iniV Int
pos [Word8]
xs =
    case [Word8]
xs of
      Word8
c1:Word8
c2:[Word8]
xs' -> Word8 -> [Word8] -> Char
decodeCont Word8
iniV [Word8
c1,Word8
c2] Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) [Word8]
xs'
      [Word8]
_         -> ShowS
forall a. HasCallStack => String -> a
error String
"truncated continuation, expecting 2 bytes"
  uncont Int
3 Word8
iniV Int
pos [Word8]
xs =
    case [Word8]
xs of
      Word8
c1:Word8
c2:Word8
c3:[Word8]
xs' -> Word8 -> [Word8] -> Char
decodeCont Word8
iniV [Word8
c1,Word8
c2,Word8
c3] Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) [Word8]
xs'
      [Word8]
_            -> ShowS
forall a. HasCallStack => String -> a
error String
"truncated continuation, expecting 3 bytes"
  uncont Int
_ Word8
_ Int
_ [Word8]
_ = ShowS
forall a. HasCallStack => String -> a
error String
"invalid number of bytes for continuation"
  decodeCont :: Word8 -> [Word8] -> Char
  decodeCont :: Word8 -> [Word8] -> Char
decodeCont Word8
iniV [Word8]
l
    | (Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Word8 -> Bool
forall {a}. Bits a => a -> Bool
isContByte [Word8]
l = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ (Int -> Word8 -> Int) -> Int -> [Word8] -> 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 Word8
v -> (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v)
       (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
iniV)
       ((Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3f) [Word8]
l)
    | Bool
otherwise        = String -> Char
forall a. HasCallStack => String -> a
error String
"continuation bytes invalid"
  isContByte :: a -> Bool
isContByte a
v = a
v a -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`testBit` Int
7 Bool -> Bool -> Bool
&& a
v a -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
6
  isClear :: a -> Int -> Bool
isClear a
v Int
i = Bool -> Bool
not (a
v a -> Int -> Bool
forall {a}. Bits a => a -> Int -> Bool
`testBit` Int
i)

encodeUTF8 :: String -> ByteString
encodeUTF8 :: String -> ByteString
encodeUTF8 String
s = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> [Word8]) -> String -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Word8]
forall {a} {a}. (Integral a, Num a, Bits a) => a -> [a]
toUTF8 (Int -> [Word8]) -> (Char -> Int) -> Char -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) String
s
 where
  toUTF8 :: a -> [a]
toUTF8 a
e
    | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x80      = [a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
e]
    | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x800     = [a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0xc0 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)), a -> a
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont a
e]
    | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x10000   = [ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0xe0 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
12))
                      , a -> a
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
                      , a -> a
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont a
e
                      ]
    | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x200000  = [a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0xf0 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
                      , a -> a
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
12)
                      , a -> a
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
                      , a -> a
forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont a
e
                      ]
    | Bool
otherwise     = String -> [a]
forall a. HasCallStack => String -> a
error String
"not a valid value"
  toCont :: a -> b
toCont a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0x80 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x3f))

decodeASCII :: ByteString -> String
decodeASCII :: ByteString -> String
decodeASCII = ByteString -> String
BC.unpack

encodeASCII :: String -> ByteString
encodeASCII :: String -> ByteString
encodeASCII = String -> ByteString
BC.pack

decodeBMP :: ByteString -> String
decodeBMP :: ByteString -> String
decodeBMP ByteString
b
    | Int -> Bool
forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
b) = ShowS
forall a. HasCallStack => String -> a
error String
"not a valid BMP string"
    | Bool
otherwise        = [Word8] -> String
forall {a} {a}. (Integral a, Enum a) => [a] -> [a]
fromUCS2 ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
b
 where
  fromUCS2 :: [a] -> [a]
fromUCS2 [] = []
  fromUCS2 (a
b0:a
b1:[a]
l) =
    let v :: Word16
        v :: Word16
v = (a -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. a -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b1
    in  Int -> a
forall a. Enum a => Int -> a
toEnum (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
fromUCS2 [a]
l
  fromUCS2 [a]
_ = String -> [a]
forall a. HasCallStack => String -> a
error String
"decodeBMP: internal error"

encodeBMP :: String -> ByteString
encodeBMP :: String -> ByteString
encodeBMP String
s = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> [Word8]) -> String -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Word8]
forall {p} {a}. (Integral p, Bits p, Num a) => p -> [a]
toUCS2 (Int -> [Word8]) -> (Char -> Int) -> Char -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) String
s
 where
  toUCS2 :: p -> [a]
toUCS2 p
v = [a
b0, a
b1]
   where
    b0 :: a
b0 = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
v p -> Int -> p
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
    b1 :: a
b1 = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
v p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0xff)

decodeUTF32 :: ByteString -> String
decodeUTF32 :: ByteString -> String
decodeUTF32 ByteString
bs
  | (ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = ShowS
forall a. HasCallStack => String -> a
error String
"not a valid UTF32 string"
  | Bool
otherwise                  = Int -> String
fromUTF32 Int
0
 where
  w32ToChar :: Word32 -> Char
  w32ToChar :: Word32 -> Char
w32ToChar = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word32 -> Int) -> Word32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  fromUTF32 :: Int -> String
fromUTF32 Int
ofs
    | Int
ofs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
bs = []
    | Bool
otherwise =
        let a :: Word8
a = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
bs Int
ofs
            b :: Word8
b = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
bs (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            c :: Word8
c = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
bs (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
            d :: Word8
d = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
bs (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
            v :: Word32
v =     (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
                Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d
        in  Word32 -> Char
w32ToChar Word32
v Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
fromUTF32 (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)
encodeUTF32 :: String -> ByteString
encodeUTF32 :: String -> ByteString
encodeUTF32 String
s = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> [Word8]) -> String -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Word8]
forall {p} {a}. (Integral p, Bits p, Num a) => p -> [a]
toUTF32 (Int -> [Word8]) -> (Char -> Int) -> Char -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) String
s
 where
  toUTF32 :: p -> [a]
toUTF32 p
v = [a
b0, a
b1, a
b2, a
b3]
   where
    b0 :: a
b0 = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
v p -> Int -> p
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
    b1 :: a
b1 = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((p
v p -> Int -> p
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0xff)
    b2 :: a
b2 = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((p
v p -> Int -> p
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)  p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0xff)
    b3 :: a
b3 = p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
v p -> p -> p
forall a. Bits a => a -> a -> a
.&. p
0xff)