-- |
-- 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
(Int -> ASN1StringEncoding -> ShowS)
-> (ASN1StringEncoding -> String)
-> ([ASN1StringEncoding] -> ShowS)
-> Show ASN1StringEncoding
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
(ASN1StringEncoding -> ASN1StringEncoding -> Bool)
-> (ASN1StringEncoding -> ASN1StringEncoding -> Bool)
-> Eq ASN1StringEncoding
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
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
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
$cp1Ord :: Eq ASN1StringEncoding
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 encoding :: 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 (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 encoding :: ASN1StringEncoding
encoding s :: String
s =
    case ASN1StringEncoding
-> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions ASN1StringEncoding
encoding of
        Just (_, e :: String -> ByteString
e) -> ASN1StringEncoding -> ByteString -> ASN1CharacterString
ASN1CharacterString ASN1StringEncoding
encoding (String -> ByteString
e String
s)
        Nothing     -> String -> ASN1CharacterString
forall a. HasCallStack => String -> a
error ("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]
++ " from string")

-- | try to decode an 'ASN1CharacterString' to a String
asn1CharacterToString :: ASN1CharacterString -> Maybe String
asn1CharacterToString :: ASN1CharacterString -> Maybe String
asn1CharacterToString (ASN1CharacterString encoding :: ASN1StringEncoding
encoding bs :: ByteString
bs) =
    case ASN1StringEncoding
-> Maybe (ByteString -> String, String -> ByteString)
stringEncodingFunctions ASN1StringEncoding
encoding of
        Just (d :: ByteString -> String
d, _) -> String -> Maybe String
forall a. a -> Maybe a
Just (ByteString -> String
d ByteString
bs)
        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 (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
showList :: [ASN1CharacterString] -> ShowS
$cshowList :: [ASN1CharacterString] -> ShowS
show :: ASN1CharacterString -> String
$cshow :: ASN1CharacterString -> String
showsPrec :: Int -> ASN1CharacterString -> ShowS
$cshowsPrec :: Int -> ASN1CharacterString -> ShowS
Show,ASN1CharacterString -> ASN1CharacterString -> Bool
(ASN1CharacterString -> ASN1CharacterString -> Bool)
-> (ASN1CharacterString -> ASN1CharacterString -> Bool)
-> Eq ASN1CharacterString
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
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
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
$cp1Ord :: Eq ASN1CharacterString
Ord)

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

decodeUTF8 :: ByteString -> String
decodeUTF8 :: ByteString -> String
decodeUTF8 b :: ByteString
b = Int -> [Word8] -> String
loop 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 _   []     = []
        loop pos :: Int
pos (x :: Word8
x:xs :: [Word8]
xs)
            | Word8
x Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`isClear` 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
+1) [Word8]
xs
            | Word8
x Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`isClear` 6 = ShowS
forall a. HasCallStack => String -> a
error "continuation byte in heading context"
            | Word8
x Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`isClear` 5 = Int -> Word8 -> Int -> [Word8] -> String
uncont 1 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x1f) Int
pos [Word8]
xs
            | Word8
x Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`isClear` 4 = Int -> Word8 -> Int -> [Word8] -> String
uncont 2 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xf)  Int
pos [Word8]
xs
            | Word8
x Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`isClear` 3 = Int -> Word8 -> Int -> [Word8] -> String
uncont 3 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x7)  Int
pos [Word8]
xs
            | Bool
otherwise     = ShowS
forall a. HasCallStack => String -> a
error "too many byte"
        uncont :: Int -> Word8 -> Int -> [Word8] -> [Char]
        uncont :: Int -> Word8 -> Int -> [Word8] -> String
uncont 1 iniV :: Word8
iniV pos :: Int
pos xs :: [Word8]
xs =
            case [Word8]
xs of
                c1 :: Word8
c1:xs' :: [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
+2) [Word8]
xs'
                _      -> ShowS
forall a. HasCallStack => String -> a
error "truncated continuation, expecting 1 byte"
        uncont 2 iniV :: Word8
iniV pos :: Int
pos xs :: [Word8]
xs =
            case [Word8]
xs of
                c1 :: Word8
c1:c2 :: Word8
c2:xs' :: [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
+3) [Word8]
xs'
                _         -> ShowS
forall a. HasCallStack => String -> a
error "truncated continuation, expecting 2 bytes"
        uncont 3 iniV :: Word8
iniV pos :: Int
pos xs :: [Word8]
xs =
            case [Word8]
xs of
                c1 :: Word8
c1:c2 :: Word8
c2:c3 :: Word8
c3:xs' :: [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
+4) [Word8]
xs'
                _            -> ShowS
forall a. HasCallStack => String -> a
error "truncated continuation, expecting 3 bytes"
        uncont _ _ _ _ = ShowS
forall a. HasCallStack => String -> a
error "invalid number of bytes for continuation"
        decodeCont :: Word8 -> [Word8] -> Char
        decodeCont :: Word8 -> [Word8] -> Char
decodeCont iniV :: Word8
iniV l :: [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 (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\acc :: Int
acc v :: Word8
v -> (Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 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] -> Int) -> [Word8] -> Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\v :: Word8
v -> Word8
v Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x3f) [Word8]
l
            | Bool
otherwise        = String -> Char
forall a. HasCallStack => String -> a
error "continuation bytes invalid"
        isContByte :: a -> Bool
isContByte v :: a
v = a
v a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` 7 Bool -> Bool -> Bool
&& a
v a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`isClear` 6
        isClear :: a -> Int -> Bool
isClear v :: a
v i :: 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 s :: 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 e :: a
e
            | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 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
< 0x800     = [a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (0xc0 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 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
< 0x10000   = [a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (0xe0 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 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` 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
< 0x200000  = [a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (0xf0 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
e a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 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` 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` 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 "not a valid value"
        toCont :: a -> b
toCont v :: a
v = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (0x80 a -> a -> a
forall a. Bits a => a -> a -> a
.|. (a
v a -> a -> a
forall a. Bits 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 b :: ByteString
b
    | Int -> Bool
forall a. Integral a => a -> Bool
odd (ByteString -> Int
B.length ByteString
b) = ShowS
forall a. HasCallStack => String -> a
error "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 (b0 :: a
b0:b1 :: a
b1:l :: [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` 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 _ = String -> [a]
forall a. HasCallStack => String -> a
error "decodeBMP: internal error"
encodeBMP :: String -> ByteString
encodeBMP :: String -> ByteString
encodeBMP s :: 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, Bits a, Num a) => a -> [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 :: a -> [a]
toUCS2 v :: a
v = [a
b0,a
b1]
            where b0 :: a
b0 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 8)
                  b1 :: a
b1 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. 0xff)

decodeUTF32 :: ByteString -> String
decodeUTF32 :: ByteString -> String
decodeUTF32 bs :: ByteString
bs
    | (ByteString -> Int
B.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = ShowS
forall a. HasCallStack => String -> a
error "not a valid UTF32 string"
    | Bool
otherwise                  = Int -> String
fromUTF32 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 ofs :: 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 = ByteString -> Int -> Word8
B.index ByteString
bs Int
ofs
                    b :: Word8
b = ByteString -> Int -> Word8
B.index ByteString
bs (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                    c :: Word8
c = ByteString -> Int -> Word8
B.index ByteString
bs (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
                    d :: Word8
d = ByteString -> Int -> Word8
B.index ByteString
bs (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+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` 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` 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` 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
+4)
encodeUTF32 :: String -> ByteString
encodeUTF32 :: String -> ByteString
encodeUTF32 s :: 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, Bits a, Num a) => a -> [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 :: a -> [a]
toUTF32 v :: a
v = [a
b0,a
b1,a
b2,a
b3]
            where b0 :: a
b0 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 24)
                  b1 :: a
b1 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 16) a -> a -> a
forall a. Bits a => a -> a -> a
.&. 0xff)
                  b2 :: a
b2 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((a
v a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` 8)  a -> a -> a
forall a. Bits a => a -> a -> a
.&. 0xff)
                  b3 :: a
b3 = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. 0xff)