2 people like it.
Like the snippet!

Base64, Base32, Base16 encoding and decoding

String module extensions to add 4 functions to encode and decode strings to Base16, Base32, Base64 formats according to RFC 4648. https://tools.ietf.org/html/rfc4648

module String = begin
  //  Implements 4 new functions to encode/decode UTF8 strings as
  //  Base16, Base32, and Base64 as per RFC 4648
  //  https://tools.ietf.org/html/rfc4648
  

  
  /// Encodes a UTF8 string as a Base16 string
  let encodeBase16 text =
    // RFC 4648: The Base 16 Alphabet
    let A = "012345678ABCDEF"
    let byteToChar (i:byte) = A.[int i]
    (text:string)
    |> System.Text.Encoding.UTF8.GetBytes
    |> Array.collect (fun x -> [| x &&& 0xF0uy >>> 4; x &&& 0x0Fuy; |])
    |> Array.map byteToChar
    |> System.String.Concat



  /// Decodes a Base16 string to a UTF8 string
  let decodeBase16 text =
    if (text:string).Length % 2 <> 0 then "" else
      // RFC 4648: The Base 16 Alphabet
      let A = [for c in "012345678ABCDEF" -> c]
              |> List.mapi (fun i a -> a, byte i)
              |> Map.ofList

      let (.@) (m: Map<char, byte>) key = try m.[System.Char.ToUpper key] |> byte with _ -> 0uy

      let rec parse result input =
        match input with
        | x :: y :: tail -> parse (result @ [ (A.@ x <<< 4) ||| (A.@ y) ]) tail
        | _              -> result

      [for c in text -> c]
      |> parse []
      |> List.toArray
      |> System.Text.Encoding.UTF8.GetString



  /// Encodes a UTF8 string as a Base32 string
  let encodeBase32 text =
    let quintupletToList ending (x0, x1, x2, x3, x4) =
      // RFC 4648: The Base 32 Alphabet
      let A = "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567="

      // RFC 4648: The "Extended Hex" Base 32 Alphabet
      // let A = "0123456789ABCDEFGHIJKLMNOPQRSTUV="

      let quintuplet = (int64 x0 <<< 32)
                   ||| (int64 x1 <<< 24)
                   ||| (int64 x2 <<< 16)
                   ||| (int64 x3 <<<  8)
                   ||| (int64 x4)
      let a0 = (quintuplet &&& 0xF800000000L) >>> 35 |> int
      let a1 = (quintuplet &&& 0x07C0000000L) >>> 30 |> int
      let a2 = (quintuplet &&& 0x003E000000L) >>> 25 |> int
      let a3 = (quintuplet &&& 0x0001F00000L) >>> 20 |> int
      let a4 = (quintuplet &&& 0x00000F8000L) >>> 15 |> int
      let a5 = (quintuplet &&& 0x0000007C00L) >>> 10 |> int
      let a6 = (quintuplet &&& 0x00000003E0L) >>>  5 |> int
      let a7 = (quintuplet &&& 0x000000001FL)        |> int
      match ending with
      | 1 -> [A.[a0]; A.[a1];   '=' ;   '=' ;   '=' ;   '=' ;   '=' ;   '=' ;] // 01======
      | 2 -> [A.[a0]; A.[a1]; A.[a2]; A.[a3];   '=' ;   '=' ;   '=' ;   '=' ;] // 0123====
      | 3 -> [A.[a0]; A.[a1]; A.[a2]; A.[a3]; A.[a4];   '=' ;   '=' ;   '=' ;] // 01234===
      | 4 -> [A.[a0]; A.[a1]; A.[a2]; A.[a3]; A.[a4]; A.[a5]; A.[a6];   '=' ;] // 0123456=
      | _ -> [A.[a0]; A.[a1]; A.[a2]; A.[a3]; A.[a4]; A.[a5]; A.[a6]; A.[a7];] // 01234567

    let rec parse result input =
      match input with
      | x0 :: x1 :: x2 :: x3 :: x4 :: tail -> parse (result @ quintupletToList 5 (x0, x1, x2, x3, x4)) tail
      | x0 :: x1 :: x2 :: x3 :: []         -> result @ quintupletToList 4 (x0,  x1,  x2,  x3, 0uy)
      | x0 :: x1 :: x2 :: []               -> result @ quintupletToList 3 (x0,  x1,  x2, 0uy, 0uy)
      | x0 :: x1 :: []                     -> result @ quintupletToList 2 (x0,  x1, 0uy, 0uy, 0uy)
      | x0 :: []                           -> result @ quintupletToList 1 (x0, 0uy, 0uy, 0uy, 0uy)
      | []                                 -> result
  
    (text:string)
    |> System.Text.Encoding.UTF8.GetBytes
    |> Array.toList
    |> parse []
    |> List.toArray
    |> System.String.Concat



  /// Decodes a Base32 string to a UTF8 string
  let decodeBase32 text = 
    if (text:string).Length % 8 <> 0 then "" else
      // RFC 4648: The Base 32 alphabet
      let A = [for c in "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567=" -> c]
              |> List.mapi (fun i a -> a, i)
              |> Map.ofList

      // RFC 4648: The "Extended Hex" Base 32 alphabet
      // let A = [for c in "0123456789ABCDEFGHIJKLMNOPQRSTUV=" -> c]
      //         |> List.mapi (fun i a -> a, i)
      //         |> Map.ofList
                  
      let (.@) (m: Map<char, int>) key = try m.[System.Char.ToUpper key] |> int64 with _ -> 0L
    
      let octetToList ending (a0, a1, a2, a3, a4, a5, a6, a7) =
        let octet = (A.@ a0 &&& 0x1FL <<< 35)
                ||| (A.@ a1 &&& 0x1FL <<< 30)
                ||| (A.@ a2 &&& 0x1FL <<< 25)
                ||| (A.@ a3 &&& 0x1FL <<< 20)
                ||| (A.@ a4 &&& 0x1FL <<< 15)
                ||| (A.@ a5 &&& 0x1FL <<< 10)
                ||| (A.@ a6 &&& 0x1FL <<<  5)
                ||| (A.@ a7 &&& 0x1FL)
        let x0 = (octet &&& 0xFF00000000L) >>> 32 |> byte
        let x1 = (octet &&& 0x00FF000000L) >>> 24 |> byte
        let x2 = (octet &&& 0x0000FF0000L) >>> 16 |> byte
        let x3 = (octet &&& 0x000000FF00L) >>>  8 |> byte
        let x4 = (octet &&& 0x00000000FFL)        |> byte
        match ending with
        | 2 -> [x0;]
        | 4 -> [x0; x1;]
        | 5 -> [x0; x1; x2;]
        | 7 -> [x0; x1; x2; x3;]
        | _ -> [x0; x1; x2; x3; x4;]
    
      let rec parse result input =
        match input with
        | a0 :: a1 :: '=':: '=':: '=':: '=':: '=':: '=':: _    -> result @ octetToList 2 (a0, a1,'=','=','=','=','=','=')
        | a0 :: a1 :: a2 :: a3 :: '=':: '=':: '=':: '=':: _    -> result @ octetToList 4 (a0, a1, a2, a3,'=','=','=','=')
        | a0 :: a1 :: a2 :: a3 :: a4 :: '=':: '=':: '=':: _    -> result @ octetToList 5 (a0, a1, a2, a3, a4,'=','=','=')
        | a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: '=':: _    -> result @ octetToList 7 (a0, a1, a2, a3, a4, a5, a6,'=')
        | a0 :: a1 :: a2 :: a3 :: a4 :: a5 :: a6 :: a7 :: tail -> parse (result @ octetToList 8 (a0, a1, a2, a3, a4, a5, a6, a7)) tail
        | _                                                    -> result

      [for c in text -> c]
      |> parse []
      |> List.toArray
      |> System.Text.Encoding.UTF8.GetString



  /// Encodes a UTF8 string as a Base64 string
  let encodeBase64 text =
    let tripletToList ending (x, y, z) =
      // RFC 4648: The Base 64 Alphabet
      let A = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

      // RFC 4648: The "URL and Filename safe" Base 64 Alphabet
      // let A = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_="

      let triplet = (int x <<< 16)
                ||| (int y <<<  8)
                ||| (int z)
      let a = (triplet &&& 0xFC0000) >>> 18
      let b = (triplet &&& 0x03F000) >>> 12
      let c = (triplet &&& 0x000FC0) >>>  6
      let d = (triplet &&& 0x00003F)
      match ending with
      | 1 -> [A.[a]; A.[b];  '=' ;  '=' ;] // 01==
      | 2 -> [A.[a]; A.[b]; A.[c];  '=' ;] // 
      | _ -> [A.[a]; A.[b]; A.[c]; A.[d];] // 

    let rec parse result input =
      match input with
      | a :: b :: c :: tail -> parse (result @ tripletToList 3 (a, b, c)) tail
      | a :: b :: []        -> result @ tripletToList 2 (a,   b, 0uy)
      | a :: []             -> result @ tripletToList 1 (a, 0uy, 0uy)
      | []                  -> result
  
    (text:string)
    |> System.Text.Encoding.UTF8.GetBytes
    |> Array.toList
    |> parse []
    |> List.toArray
    |> System.String.Concat



  /// Decodes a Base64 string to a UTF8 string
  let decodeBase64 text = 
    if (text:string).Length % 4 <> 0 then "" else
      // RFC 4648: The Base 64 Alphabet
      let A = [for c in "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" -> c]
              |> List.mapi (fun i a -> a, i)
              |> Map.ofList

      // RFC 4648: The "URL and Filename safe" Base 64 Alphabet
      // let A = [for c in "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_=" -> c]
      //         |> List.mapi (fun i a -> a, i)
      //         |> Map.ofList

      let (.@) (m: Map<char, int>) key = try m.[key] with _ -> 0
    
      let quadToList ending (a, b, c, d) =
        let quad = (A.@ a &&& 0x3F <<< 18)
               ||| (A.@ b &&& 0x3F <<< 12)
               ||| (A.@ c &&& 0x3F <<<  6)
               ||| (A.@ d &&& 0x3F)
        let x = (quad &&& 0xFF0000) >>> 16
        let y = (quad &&& 0x00FF00) >>>  8
        let z = (quad &&& 0x0000FF)
        match ending with
        | 2 -> [byte x;]
        | 3 -> [byte x; byte y;]
        | _ -> [byte x; byte y; byte z;]
    
      let rec parse result input =
        match input with
        | a :: b ::'='::'=':: []   -> result @ quadToList 2 (a, b, '=', '=')
        | a :: b :: c ::'=':: []   -> result @ quadToList 3 (a, b,  c , '=')
        | a :: b :: c :: d :: tail -> parse (result @ quadToList 4 (a, b, c, d)) tail
        | _                        -> result

      [for c in text -> c]
      |> parse []
      |> List.toArray
      |> System.Text.Encoding.UTF8.GetString

end

module String

from Microsoft.FSharp.Core

val encodeBase16 : text:string -> string

Full name: Script.String.encodeBase16

Encodes a UTF8 string as a Base16 string

val text : string

val A : string

val byteToChar : (byte -> char)

val i : byte

Multiple items
val byte : value:'T -> byte (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.byte

--------------------
type byte = System.Byte

Full name: Microsoft.FSharp.Core.byte

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string

namespace System

namespace System.Text

type Encoding =
  member BodyName : string
  member Clone : unit -> obj
  member CodePage : int
  member DecoderFallback : DecoderFallback with get, set
  member EncoderFallback : EncoderFallback with get, set
  member EncodingName : string
  member Equals : value:obj -> bool
  member GetByteCount : chars:char[] -> int + 3 overloads
  member GetBytes : chars:char[] -> byte[] + 5 overloads
  member GetCharCount : bytes:byte[] -> int + 2 overloads
  ...

Full name: System.Text.Encoding

property System.Text.Encoding.UTF8: System.Text.Encoding

System.Text.Encoding.GetBytes(s: string) : byte []
System.Text.Encoding.GetBytes(chars: char []) : byte []
System.Text.Encoding.GetBytes(chars: char [], index: int, count: int) : byte []
System.Text.Encoding.GetBytes(chars: nativeptr<char>, charCount: int, bytes: nativeptr<byte>, byteCount: int) : int
System.Text.Encoding.GetBytes(s: string, charIndex: int, charCount: int, bytes: byte [], byteIndex: int) : int
System.Text.Encoding.GetBytes(chars: char [], charIndex: int, charCount: int, bytes: byte [], byteIndex: int) : int

module Array

from Microsoft.FSharp.Collections

val collect : mapping:('T -> 'U []) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.collect

val x : byte

val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.map

Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
System.String(value: nativeptr<char>) : unit
System.String(value: nativeptr<sbyte>) : unit
System.String(value: char []) : unit
System.String(c: char, count: int) : unit
System.String(value: nativeptr<char>, startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
System.String(value: char [], startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: System.Text.Encoding) : unit

System.String.Concat([<System.ParamArray>] values: string []) : string
   (+0 other overloads)
System.String.Concat(values: System.Collections.Generic.IEnumerable<string>) : string
   (+0 other overloads)
System.String.Concat<'T>(values: System.Collections.Generic.IEnumerable<'T>) : string
   (+0 other overloads)
System.String.Concat([<System.ParamArray>] args: obj []) : string
   (+0 other overloads)
System.String.Concat(arg0: obj) : string
   (+0 other overloads)
System.String.Concat(str0: string, str1: string) : string
   (+0 other overloads)
System.String.Concat(arg0: obj, arg1: obj) : string
   (+0 other overloads)
System.String.Concat(str0: string, str1: string, str2: string) : string
   (+0 other overloads)
System.String.Concat(arg0: obj, arg1: obj, arg2: obj) : string
   (+0 other overloads)
System.String.Concat(str0: string, str1: string, str2: string, str3: string) : string
   (+0 other overloads)

val decodeBase16 : text:string -> string

Full name: Script.String.decodeBase16

Decodes a Base16 string to a UTF8 string

val A : Map<char,byte>

val c : char

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>

val mapi : mapping:(int -> 'T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.mapi

val i : int

val a : char

Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>

val ofList : elements:('Key * 'T) list -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofList

val m : Map<char,byte>

Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = System.Char

Full name: Microsoft.FSharp.Core.char

val key : char

type Char =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 1 overload
    static val MaxValue : char
    static val MinValue : char
    static member ConvertFromUtf32 : utf32:int -> string
    static member ConvertToUtf32 : highSurrogate:char * lowSurrogate:char -> int + 1 overload
    static member GetNumericValue : c:char -> float + 1 overload
    ...
  end

Full name: System.Char

System.Char.ToUpper(c: char) : char
System.Char.ToUpper(c: char, culture: System.Globalization.CultureInfo) : char

val parse : (byte list -> char list -> byte list)

val result : byte list

val input : char list

val x : char

val y : char

val tail : char list

val toArray : list:'T list -> 'T []

Full name: Microsoft.FSharp.Collections.List.toArray

System.Text.Encoding.GetString(bytes: byte []) : string
System.Text.Encoding.GetString(bytes: byte [], index: int, count: int) : string

val encodeBase32 : text:string -> string

Full name: Script.String.encodeBase32

Encodes a UTF8 string as a Base32 string

val quintupletToList : (int -> byte * byte * byte * byte * byte -> char list)

val ending : int

val x0 : byte

val x1 : byte

val x2 : byte

val x3 : byte

val x4 : byte

val quintuplet : int64

Multiple items
val int64 : value:'T -> int64 (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int64

--------------------
type int64 = System.Int64

Full name: Microsoft.FSharp.Core.int64

--------------------
type int64<'Measure> = int64

Full name: Microsoft.FSharp.Core.int64<_>

val a0 : int

val a1 : int

val a2 : int

val a3 : int

val a4 : int

val a5 : int

val a6 : int

val a7 : int

val parse : (char list -> byte list -> char list)

val result : char list

val input : byte list

val tail : byte list

val toList : array:'T [] -> 'T list

Full name: Microsoft.FSharp.Collections.Array.toList

val decodeBase32 : text:string -> string

Full name: Script.String.decodeBase32

Decodes a Base32 string to a UTF8 string

val A : Map<char,int>

val m : Map<char,int>

val octetToList : (int -> char * char * char * char * char * char * char * char -> byte list)

val a0 : char

val a1 : char

val a2 : char

val a3 : char

val a4 : char

val a5 : char

val a6 : char

val a7 : char

val octet : int64

val encodeBase64 : text:string -> string

Full name: Script.String.encodeBase64

Encodes a UTF8 string as a Base64 string

val tripletToList : (int -> byte * byte * byte -> char list)

val y : byte

val z : byte

val triplet : int

val a : int

val b : int

val c : int

val d : int

val a : byte

val b : byte

val c : byte

val decodeBase64 : text:string -> string

Full name: Script.String.decodeBase64

Decodes a Base64 string to a UTF8 string

val quadToList : (int -> char * char * char * char -> byte list)

val b : char

val d : char

val quad : int

val x : int

val y : int

val z : int

Raw view Test code New version

More information

Link:	http://fssnip.net/7PR
Posted:	8 years ago
Author:	Dmitry Achkasov
Tags:	base64 encoding , base64 decoding , base32 encoding , base32 decoding , base16 encoding , base16 decoding , rfc 4648