0 | module Data.String.Base64
 1 |
 2 | import Data.Buffer
 3 | import Data.Buffer.Core
 4 | import Data.Buffer.Indexed
 5 | import Data.List as List
 6 | import UTF8
 7 |
 8 | export
 9 | setBytes : Buffer -> Int -> List Bits8 -> IO Unit
10 | setBytes buf offset [] = pure ()
11 | setBytes buf offset (x :: xs) = do
12 |   Buffer.setBits8 buf offset x
13 |   setBytes buf (offset + 1) xs
14 |
15 | ||| Given a length of data to be base64 encoded, this function yields the length of the encoded data
16 | export
17 | base64EncodeLength: Int -> Int
18 | base64EncodeLength a = (a+2) `div` 3 * 4 -- from chromiumbase64.h, but modified to remove the null
19 |
20 | ||| Given a length of base64 encoded data, this function yields the maximum length of the data after decoding
21 | export
22 | base64DecodeLength: Int -> Int
23 | base64DecodeLength a = a `div` 4 * 3 + 2 -- from chromiumbase64.h
24 |
25 | %foreign "C:fast_avx512bw_base64_encode,libbase64-idris"
26 | prim__enc: Buffer -> Buffer -> Int -> PrimIO Int
27 |
28 | %foreign "C:fast_avx512bw_base64_decode,libbase64-idris"
29 | prim__dec: Buffer -> Buffer -> Int -> PrimIO Int
30 |
31 | ||| @ dest is the destination buffer, in which the result is written.
32 | ||| @ str is the source buffer.
33 | ||| @ strlen is the length of the source buffer.
34 | export
35 | base64EncodeBuffer: Buffer -> Buffer -> Int -> IO Int
36 | base64EncodeBuffer dest str len = primIO $ prim__enc dest str len
37 |
38 | export
39 | base64Encode: List Bits8 -> List Bits8
40 | base64Encode inp = unsafePerformIO $ do
41 |   let
42 |     len : Int
43 |     len = cast $ the Nat $ List.length inp
44 |   Just destBuf <- newBuffer (base64EncodeLength len)
45 |   | Nothing => pure []
46 |   Just srcBuf <- newBuffer len
47 |   | Nothing => pure []
48 |   setBytes srcBuf 0 inp
49 |   _ <- base64EncodeBuffer destBuf srcBuf len
50 |   ints <- bufferData destBuf
51 |   pure (map (the (Int -> Bits8) cast) ints)
52 |
53 | export
54 | base64EncodeString: List Bits8 -> String
55 | base64EncodeString inp =
56 |   -- Since base64Encode always returns valid ASCII, and ASCII is also valid
57 |   -- UTF-8, we can decode this with no errors.
58 |   let inp'  = base64Encode inp
59 |       inp'' = bufferL inp'
60 |     in utf8Decode inp''
61 |
62 | ||| @ out must be large enough (see base64DecodeLength). The result is written here.
63 | ||| @ src must be at least as large as srclen denotes
64 | ||| @ srclen must be zero or positive
65 | ||| Returns MAX_INT of Int when there was an error
66 | export
67 | base64DecodeBuffer: Buffer -> Buffer -> Int -> IO Int
68 | base64DecodeBuffer out src srclen = primIO $ prim__dec out src srclen
69 |
70 | decodeBuf : Buffer -> IO (Maybe (List Bits8))
71 | decodeBuf srcBuf = do
72 |   srcLen <- rawSize srcBuf
73 |   Just out <- newBuffer (base64DecodeLength srcLen)
74 |   | Nothing => pure Nothing
75 |   ret <- base64DecodeBuffer out srcBuf srcLen
76 |   if ret == 0xFFFF_FFFF_FFFF_FFFF
77 |      then pure Nothing
78 |      else do
79 |        Just resized <- resizeBuffer out ret
80 |        | Nothing => pure Nothing
81 |        ints <- bufferData resized
82 |        pure . Just $ map (the (Int -> Bits8) cast) ints
83 |
84 | export
85 | base64DecodeString: String -> IO (Maybe (List Bits8))
86 | base64DecodeString str =
87 |   -- This function would only get called if str were ASCII, since that is all base64 works on.
88 |   -- If str is ASCII, decoding using UTF-8 is always successful.
89 |   let srcBuf = utf8Encode str
90 |     in decodeBuf $ unsafeGetBuffer srcBuf
91 |
92 | export
93 | base64DecodeBits8: List Bits8 -> Maybe (List Bits8)
94 | base64DecodeBits8 bits8 = unsafePerformIO $ do
95 |   Just srcBuf <- newBuffer (the (Nat -> Int) cast $ List.length bits8)
96 |   | Nothing => pure Nothing
97 |   setBytes srcBuf 0 bits8
98 |   decodeBuf srcBuf
99 |