Skip to content

Instantly share code, notes, and snippets.

@chakrit
Last active June 11, 2019 16:00
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save chakrit/70384778156853398ac7d226188e8d88 to your computer and use it in GitHub Desktop.
Save chakrit/70384778156853398ac7d226188e8d88 to your computer and use it in GitHub Desktop.
Base64 URL encoding
module Base64 exposing
( base64FromBytes
, base64ToBytes
, fromBase64String
, toBase64String
)
import Bitwise as Bits
import Bytes exposing (Bytes)
import Bytes.Decode as D
import Bytes.Encode as E
import Dict exposing (Dict)
toBase64String : String -> Maybe String
toBase64String =
stringToBytes >> base64FromBytes
fromBase64String : String -> Maybe String
fromBase64String =
base64ToBytes >> Maybe.map stringFromBytes
stringToBytes : String -> Bytes
stringToBytes str =
E.encode (E.string str)
stringFromBytes : Bytes -> String
stringFromBytes bytes =
D.decode (D.string (Bytes.width bytes)) bytes
|> Maybe.withDefault "(string decode error)"
base64ToBytes : String -> Maybe Bytes
base64ToBytes str =
decode (String.toList str)
|> Maybe.map (E.sequence >> E.encode)
decode : List Char -> Maybe (List E.Encoder)
decode l =
case l of
[] ->
Just []
a :: b :: '=' :: '=' :: [] ->
dec2 a b |> Maybe.map List.singleton
a :: b :: [] ->
dec2 a b |> Maybe.map List.singleton
a :: b :: c :: '=' :: [] ->
dec3 a b c |> Maybe.map List.singleton
a :: b :: c :: [] ->
dec3 a b c |> Maybe.map List.singleton
a :: b :: c :: d :: tail ->
case ( dec4 a b c d, decode tail ) of
( Just e, Just list ) ->
Just <| e :: list
_ ->
Nothing
_ ->
Nothing
{-| base64 1111 1122 2222 3333 3344 4444
|||| bytes 1111 1111 2222 2222 3333 3333
-}
dec4 : Char -> Char -> Char -> Char -> Maybe E.Encoder
dec4 a b c d =
case [ b64byte a, b64byte b, b64byte c, b64byte d ] of
[ Just aa, Just bb, Just cc, Just dd ] ->
Just <|
E.sequence
[ E.unsignedInt8 ((aa |> Bits.shiftLeftBy 2) + (bb |> Bits.shiftRightZfBy 4))
, E.unsignedInt8 ((bb |> Bits.shiftLeftBy 4) + (cc |> Bits.shiftRightZfBy 2))
, E.unsignedInt8 ((cc |> Bits.shiftLeftBy 6) + dd)
]
_ ->
Nothing
{-| base64 1111 1122 2222 3333 33
|||| bytes 1111 1111 2222 2222 ..
-}
dec3 : Char -> Char -> Char -> Maybe E.Encoder
dec3 a b c =
case ( b64byte a, b64byte b, b64byte c ) of
( Just aa, Just bb, Just cc ) ->
Just <|
E.sequence
[ E.unsignedInt8 ((aa |> Bits.shiftLeftBy 2) + (bb |> Bits.shiftRightZfBy 4))
, E.unsignedInt8 ((bb |> Bits.shiftLeftBy 4) + (cc |> Bits.shiftRightZfBy 2))
]
_ ->
Nothing
{-| base64 1111 1122 2222 ....
|||| bytes 1111 1111 .... ....
-}
dec2 : Char -> Char -> Maybe E.Encoder
dec2 a b =
case ( b64byte a, b64byte b ) of
( Just aa, Just bb ) ->
Just <| E.unsignedInt8 ((aa |> Bits.shiftLeftBy 2) + (bb |> Bits.shiftRightZfBy 4))
_ ->
Nothing
base64FromBytes : Bytes -> Maybe String
base64FromBytes bytes =
let
get3 =
D.map3 enc3 D.unsignedInt8 D.unsignedInt8 D.unsignedInt8
get2 =
D.map2 enc2 D.unsignedInt8 D.unsignedInt8
get1 =
D.map enc1 D.unsignedInt8
process : DecoderState -> D.Decoder (D.Step DecoderState (List Char))
process state =
if state.processed >= state.total then
D.succeed <| D.Done state.output
else
D.map D.Loop <|
case state.total - state.processed of
1 ->
get1 |> D.map (appendState 1 state)
2 ->
get2 |> D.map (appendState 2 state)
_ ->
-- 3 or more
get3 |> D.map (appendState 3 state)
decoder =
D.loop (initialState bytes) process
|> D.map String.fromList
in
D.decode decoder bytes
{-| bytes 1111 1111 2222 2222 3333 3333
|| base64 1111 1122 2222 3333 3344 4444
-}
enc3 : Int -> Int -> Int -> List Char
enc3 a b c =
[ Bits.shiftRightBy 2 a |> Bits.and 0x3F |> b64char
, (Bits.shiftLeftBy 4 a + Bits.shiftRightBy 4 b) |> Bits.and 0x3F |> b64char
, (Bits.shiftLeftBy 2 b + Bits.shiftRightBy 6 c) |> Bits.and 0x3F |> b64char
, c |> Bits.and 0x3F |> b64char
]
{-| bytes 1111 1111 2222 2222 .... ....
|| base64 1111 1122 2222 3333 33.. ....
-}
enc2 : Int -> Int -> List Char
enc2 a b =
[ Bits.shiftRightBy 2 a |> Bits.and 0x3F |> b64char
, (Bits.shiftLeftBy 4 a + Bits.shiftRightBy 4 b) |> Bits.and 0x3F |> b64char
, Bits.shiftLeftBy 2 b |> Bits.and 0x3F |> b64char
, '='
]
{-| bytes 1111 1111 .... ....
|| base64 1111 1122 2222 ....
-}
enc1 : Int -> List Char
enc1 a =
[ Bits.shiftRightBy 2 a |> Bits.and 0x3F |> b64char
, Bits.shiftLeftBy 4 a |> Bits.and 0x3F |> b64char
, '='
, '='
]
type alias DecoderState =
{ total : Int
, processed : Int
, output : List Char
}
initialState : Bytes -> DecoderState
initialState bytes =
{ total = Bytes.width bytes
, processed = 0
, output = []
}
appendState : Int -> DecoderState -> List Char -> DecoderState
appendState count state chars =
{ state
| processed = state.processed + count
, output = List.append state.output chars
}
b64byte : Char -> Maybe Int
b64byte c =
Dict.get c backwardTable
b64char : Int -> Char
b64char n =
Dict.get n forwardTable
|> Maybe.withDefault '?'
backwardTable : Dict Char Int
backwardTable =
Dict.fromList
[ ( 'A', 0 )
, ( 'B', 1 )
, ( 'C', 2 )
, ( 'D', 3 )
, ( 'E', 4 )
, ( 'F', 5 )
, ( 'G', 6 )
, ( 'H', 7 )
, ( 'I', 8 )
, ( 'J', 9 )
, ( 'K', 10 )
, ( 'L', 11 )
, ( 'M', 12 )
, ( 'N', 13 )
, ( 'O', 14 )
, ( 'P', 15 )
, ( 'Q', 16 )
, ( 'R', 17 )
, ( 'S', 18 )
, ( 'T', 19 )
, ( 'U', 20 )
, ( 'V', 21 )
, ( 'W', 22 )
, ( 'X', 23 )
, ( 'Y', 24 )
, ( 'Z', 25 )
, ( 'a', 26 )
, ( 'b', 27 )
, ( 'c', 28 )
, ( 'd', 29 )
, ( 'e', 30 )
, ( 'f', 31 )
, ( 'g', 32 )
, ( 'h', 33 )
, ( 'i', 34 )
, ( 'j', 35 )
, ( 'k', 36 )
, ( 'l', 37 )
, ( 'm', 38 )
, ( 'n', 39 )
, ( 'o', 40 )
, ( 'p', 41 )
, ( 'q', 42 )
, ( 'r', 43 )
, ( 's', 44 )
, ( 't', 45 )
, ( 'u', 46 )
, ( 'v', 47 )
, ( 'w', 48 )
, ( 'x', 49 )
, ( 'y', 50 )
, ( 'z', 51 )
, ( '0', 52 )
, ( '1', 53 )
, ( '2', 54 )
, ( '3', 55 )
, ( '4', 56 )
, ( '5', 57 )
, ( '6', 58 )
, ( '7', 59 )
, ( '8', 60 )
, ( '9', 61 )
, ( '-', 62 )
, ( '_', 63 )
]
forwardTable : Dict Int Char
forwardTable =
Dict.fromList
[ ( 0, 'A' )
, ( 1, 'B' )
, ( 2, 'C' )
, ( 3, 'D' )
, ( 4, 'E' )
, ( 5, 'F' )
, ( 6, 'G' )
, ( 7, 'H' )
, ( 8, 'I' )
, ( 9, 'J' )
, ( 10, 'K' )
, ( 11, 'L' )
, ( 12, 'M' )
, ( 13, 'N' )
, ( 14, 'O' )
, ( 15, 'P' )
, ( 16, 'Q' )
, ( 17, 'R' )
, ( 18, 'S' )
, ( 19, 'T' )
, ( 20, 'U' )
, ( 21, 'V' )
, ( 22, 'W' )
, ( 23, 'X' )
, ( 24, 'Y' )
, ( 25, 'Z' )
, ( 26, 'a' )
, ( 27, 'b' )
, ( 28, 'c' )
, ( 29, 'd' )
, ( 30, 'e' )
, ( 31, 'f' )
, ( 32, 'g' )
, ( 33, 'h' )
, ( 34, 'i' )
, ( 35, 'j' )
, ( 36, 'k' )
, ( 37, 'l' )
, ( 38, 'm' )
, ( 39, 'n' )
, ( 40, 'o' )
, ( 41, 'p' )
, ( 42, 'q' )
, ( 43, 'r' )
, ( 44, 's' )
, ( 45, 't' )
, ( 46, 'u' )
, ( 47, 'v' )
, ( 48, 'w' )
, ( 49, 'x' )
, ( 50, 'y' )
, ( 51, 'z' )
, ( 52, '0' )
, ( 53, '1' )
, ( 54, '2' )
, ( 55, '3' )
, ( 56, '4' )
, ( 57, '5' )
, ( 58, '6' )
, ( 59, '7' )
, ( 60, '8' )
, ( 61, '9' )
, ( 62, '-' )
, ( 63, '_' )
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment