-- |
-- Module      : Data.ASN1.Types.String
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Different String types available in ASN1
--
module Data.ASN1.Types.String
    ( ASN1StringEncoding(..)
    , ASN1CharacterString(..)
    , asn1CharacterString
    , asn1CharacterToString
    ) where

import Data.String
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Bits
import Data.Word

-- a note on T61 encodings. The actual specification of a T61 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 ASN1 String encoding.
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 (Int -> ASN1StringEncoding -> ShowS
[ASN1StringEncoding] -> ShowS
ASN1StringEncoding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASN1StringEncoding] -> ShowS
$cshowList :: [ASN1StringEncoding] -> ShowS
show :: ASN1StringEncoding -> String
$cshow :: ASN1StringEncoding -> String
showsPrec :: Int -> ASN1StringEncoding -> ShowS
$cshowsPrec :: Int -> ASN1StringEncoding -> ShowS
Show,ASN1StringEncoding -> ASN1StringEncoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ASN1StringEncoding -> ASN1StringEncoding -> Bool
$c/= :: ASN1StringEncoding -> ASN1StringEncoding -> Bool
== :: ASN1StringEncoding -> ASN1StringEncoding -> Bool
$c== :: ASN1StringEncoding -> ASN1StringEncoding -> Bool
Eq,Eq 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
min :: ASN1StringEncoding -> ASN1StringEncoding -> ASN1StringEncoding
$cmin :: ASN1StringEncoding -> ASN1StringEncoding -> ASN1StringEncoding
max :: ASN1StringEncoding -> ASN1StringEncoding -> ASN1StringEncoding
$cmax :: ASN1StringEncoding -> ASN1StringEncoding -> ASN1StringEncoding
>= :: ASN1StringEncoding -> ASN1StringEncoding -> Bool
$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
compare :: ASN1StringEncoding -> ASN1StringEncoding -> Ordering
$ccompare :: ASN1StringEncoding -> ASN1StringEncoding -> Ordering
Ord)

-- | provide a way to possibly encode or decode character string based on character encoding
stringEncodingFunctions :: ASN1StringEncoding
                        -> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions :: ASN1StringEncoding
-> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions ASN1StringEncoding
encoding
    | ASN1StringEncoding
encoding forall a. Eq a => a -> a -> Bool
== ASN1StringEncoding
UTF8                   = forall a. a -> Maybe a
Just (ByteString -> String
decodeUTF8, String -> ByteString
encodeUTF8)
    | ASN1StringEncoding
encoding forall a. Eq a => a -> a -> Bool
== ASN1StringEncoding
BMP                    = forall a. a -> Maybe a
Just (ByteString -> String
decodeBMP, String -> ByteString
encodeBMP)
    | ASN1StringEncoding
encoding forall a. Eq a => a -> a -> Bool
== ASN1StringEncoding
UTF32                  = forall a. a -> Maybe a
Just (ByteString -> String
decodeUTF32, String -> ByteString
encodeUTF32)
    | ASN1StringEncoding
encoding forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ASN1StringEncoding]
asciiLikeEncodings = forall a. a -> Maybe a
Just (ByteString -> String
decodeASCII, String -> ByteString
encodeASCII)
    | Bool
otherwise                          = 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     -> forall a. HasCallStack => String -> a
error (String
"cannot encode ASN1 Character String " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1StringEncoding
encoding 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
_) -> forall a. a -> Maybe a
Just (ByteString -> String
d ByteString
bs)
        Maybe (ByteString -> String, String -> ByteString)
Nothing     -> forall a. Maybe a
Nothing

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

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 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 forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
7 = forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posforall a. Num a => a -> a -> a
+Int
1) [Word8]
xs
            | Word8
x forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
6 = forall a. HasCallStack => String -> a
error String
"continuation byte in heading context"
            | Word8
x forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
5 = Int -> Word8 -> Int -> [Word8] -> String
uncont Int
1 (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0x1f) Int
pos [Word8]
xs
            | Word8
x forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
4 = Int -> Word8 -> Int -> [Word8] -> String
uncont Int
2 (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0xf)  Int
pos [Word8]
xs
            | Word8
x forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
3 = Int -> Word8 -> Int -> [Word8] -> String
uncont Int
3 (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0x7)  Int
pos [Word8]
xs
            | Bool
otherwise     = 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] forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posforall a. Num a => a -> a -> a
+Int
2) [Word8]
xs'
                [Word8]
_      -> 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] forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posforall a. Num a => a -> a -> a
+Int
3) [Word8]
xs'
                [Word8]
_         -> 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] forall a. a -> [a] -> [a]
: Int -> [Word8] -> String
loop (Int
posforall a. Num a => a -> a -> a
+Int
4) [Word8]
xs'
                [Word8]
_            -> forall a. HasCallStack => String -> a
error String
"truncated continuation, expecting 3 bytes"
        uncont Int
_ Word8
_ Int
_ [Word8]
_ = 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
            | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. Bits a => a -> Bool
isContByte [Word8]
l = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
acc Word8
v -> (Int
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
iniV) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Word8
v -> Word8
v forall a. Bits a => a -> a -> a
.&. Word8
0x3f) [Word8]
l
            | Bool
otherwise        = forall a. HasCallStack => String -> a
error String
"continuation bytes invalid"
        isContByte :: a -> Bool
isContByte a
v = a
v forall {a}. Bits a => a -> Int -> Bool
`testBit` Int
7 Bool -> Bool -> Bool
&& a
v forall {a}. Bits a => a -> Int -> Bool
`isClear` Int
6
        isClear :: a -> Int -> Bool
isClear a
v Int
i = Bool -> Bool
not (a
v forall {a}. Bits a => a -> Int -> Bool
`testBit` Int
i)

encodeUTF8 :: String -> ByteString
encodeUTF8 :: String -> ByteString
encodeUTF8 String
s = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a} {a}. (Integral a, Num a, Bits a) => a -> [a]
toUTF8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) String
s
  where toUTF8 :: a -> [a]
toUTF8 a
e
            | a
e forall a. Ord a => a -> a -> Bool
< a
0x80      = [forall a b. (Integral a, Num b) => a -> b
fromIntegral a
e]
            | a
e forall a. Ord a => a -> a -> Bool
< a
0x800     = [forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0xc0 forall a. Bits a => a -> a -> a
.|. (a
e forall a. Bits a => a -> Int -> a
`shiftR` Int
6)), forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont a
e]
            | a
e forall a. Ord a => a -> a -> Bool
< a
0x10000   = [forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0xe0 forall a. Bits a => a -> a -> a
.|. (a
e forall a. Bits a => a -> Int -> a
`shiftR` Int
12))
                              ,forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont (a
e forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
                              ,forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont a
e]
            | a
e forall a. Ord a => a -> a -> Bool
< a
0x200000  = [forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0xf0 forall a. Bits a => a -> a -> a
.|. (a
e forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
                              , forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont (a
e forall a. Bits a => a -> Int -> a
`shiftR` Int
12)
                              , forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont (a
e forall a. Bits a => a -> Int -> a
`shiftR` Int
6)
                              , forall {a} {b}. (Integral a, Bits a, Num b) => a -> b
toCont a
e]
            | Bool
otherwise     = forall a. HasCallStack => String -> a
error String
"not a valid value"
        toCont :: a -> b
toCont a
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
0x80 forall a. Bits a => a -> a -> a
.|. (a
v 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
    | forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
b) = forall a. HasCallStack => String -> a
error String
"not a valid BMP string"
    | Bool
otherwise        = forall {a} {a}. (Integral a, Enum a) => [a] -> [a]
fromUCS2 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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b0 forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b1
             in forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v) forall a. a -> [a] -> [a]
: [a] -> [a]
fromUCS2 [a]
l
        fromUCS2 [a]
_ = forall a. HasCallStack => String -> a
error String
"decodeBMP: internal error"
encodeBMP :: String -> ByteString
encodeBMP :: String -> ByteString
encodeBMP String
s = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {p} {a}. (Integral p, Bits p, Num a) => p -> [a]
toUCS2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) String
s
  where toUCS2 :: p -> [a]
toUCS2 p
v = [a
b0,a
b1]
            where b0 :: a
b0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
v forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
                  b1 :: a
b1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (p
v forall a. Bits a => a -> a -> a
.&. p
0xff)

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