
  0 | module Utils.Base64
  1 | 
  2 | import Data.Bits
  3 | import Data.List
  4 | import Data.Vect
  5 | import Utils.Bytes
  6 | import Utils.Misc
  7 | 
  8 | %default total
  9 | 
 10 | alphabets : Vect 64 Char
 11 | alphabets = fromList $ unpack "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 12 | 
 13 | padding : Char
 14 | padding = '='
 15 | 
 16 | export
 17 | is_base64_char : Char -> Bool
 18 | is_base64_char c = isAlphaNum c || c == '+' || c == '/' || c == '='
 19 | 
 20 | lookup_base64_char : Char -> Maybe Bits8
 21 | lookup_base64_char = map (cast . finToInteger) . flip elemIndex alphabets
 22 | 
 23 | many_to_bits8 : List Bits8 -> Either String (List Bits8)
 24 | many_to_bits8 [] = Right []
 25 | many_to_bits8 [x] = Left "underfed, not enough base64 chars"
 26 | many_to_bits8 [a, b] = Right [ (shiftL a 2) .|. (shiftR b 4) ]
 27 | many_to_bits8 [a, b, c] = Right [ (shiftL a 2) .|. (shiftR b 4), (shiftL b 4) .|. (shiftR c 2) ]
 28 | many_to_bits8 (a :: b :: c :: d :: xs) = map (four_to_three a b c d <+>) (many_to_bits8 xs)
 29 |   where
 30 |     four_to_three : Bits8 -> Bits8 -> Bits8 -> Bits8 -> List Bits8
 31 |     four_to_three a b c d = [(shiftL a 2) .|. (shiftR b 4), (shiftL b 4) .|. (shiftR c 2), (shiftL (c .&. 0b11) 6) .|. d]
 32 | 
 33 | parse_base64 : List Char -> Either String (List Bits8)
 34 | parse_base64 [] = pure []
 35 | parse_base64 ['='] = pure []
 36 | parse_base64 ['=', '='] = pure []
 37 | parse_base64 (c :: cs) = case lookup_base64_char c of
 38 |   Just b => [| pure b :: parse_base64 cs |]
 39 |   Nothing => Left $ "invalid base64 character: " <+> show c
 40 | 
 41 | three_to_four : Bits8 -> Bits8 -> Bits8 -> List Char
 42 | three_to_four a b c =
 43 |   let i = shiftR a 2
 44 |       j = (shiftL (a .&. 0b11) 4) .|. (shiftR b 4)
 45 |       k = (shiftL (b .&. 0b1111) 2) .|. (shiftR c 6)
 46 |       l = c .&. 0b111111
 47 |       ijkl =
 48 |         [ modFinNZ (cast i) 64 SIsNonZero
 49 |         , modFinNZ (cast j) 64 SIsNonZero
 50 |         , modFinNZ (cast k) 64 SIsNonZero
 51 |         , modFinNZ (cast l) 64 SIsNonZero
 52 |         ]
 53 |   in (\x => index x alphabets) <$> ijkl
 54 | 
 55 | bits8_to_many : List Bits8 -> List Char
 56 | bits8_to_many [] = []
 57 | bits8_to_many [a] = (take 2 $ three_to_four a 0 0) <+> [padding, padding]
 58 | bits8_to_many [a, b] = (take 3 $ three_to_four a b 0) <+> [padding]
 59 | bits8_to_many (a :: b :: c :: xs) = three_to_four a b c <+> bits8_to_many xs
 60 | 
 61 | export
 62 | base64_decode : String -> Either String (List Bits8)
 63 | base64_decode = many_to_bits8 <=< parse_base64 . unpack
 64 | 
 65 | export
 66 | base64_encode : List Bits8 -> String
 67 | base64_encode = pack . bits8_to_many
 68 |