{-# LANGUAGE OverloadedStrings #-}

module Network.DomainAuth.Pubkey.Base64 (
    decode,
    decode',
) where

import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Data.Word
import Network.DomainAuth.Utils

isBase64 :: Word8 -> Bool
isBase64 :: Word8 -> Bool
isBase64 Word8
c = Word8 -> Bool
isAlphaNum Word8
c Bool -> Bool -> Bool
|| (Word8
c Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
cPlus, Word8
cSlash, Word8
cEqual])

decode :: ByteString -> ByteString
decode :: ByteString -> ByteString
decode = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decode'

decode' :: ByteString -> BL.ByteString
decode' :: ByteString -> ByteString
decode' = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
dec (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
BS.filter Word8 -> Bool
isBase64

dec :: ByteString -> Builder
dec :: ByteString -> Builder
dec ByteString
bs
    | ByteString -> Bool
BS.null ByteString
bs = Builder
forall a. Monoid a => a
empty
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&& Word8
c3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cEqual = Word8 -> Word8 -> Builder
dec1' Word8
x1 Word8
x2
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&& Word8
c4 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cEqual = Word8 -> Word8 -> Word8 -> Builder
dec2' Word8
x1 Word8
x2 Word8
x3
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 = Word8 -> Word8 -> Word8 -> Word8 -> Builder
dec' Word8
x1 Word8
x2 Word8
x3 Word8
x4 Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
+++ ByteString -> Builder
dec ByteString
bs'
    | Bool
otherwise = [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"dec"
  where
    len :: Int
len = ByteString -> Int
BS.length ByteString
bs
    c1 :: Word8
c1 = ByteString
bs ByteString -> Int -> Word8
!!! Int
0
    c2 :: Word8
c2 = ByteString
bs ByteString -> Int -> Word8
!!! Int
1
    c3 :: Word8
c3 = ByteString
bs ByteString -> Int -> Word8
!!! Int
2
    c4 :: Word8
c4 = ByteString
bs ByteString -> Int -> Word8
!!! Int
3
    x1 :: Word8
x1 = Word8 -> Word8
fromChar Word8
c1
    x2 :: Word8
x2 = Word8 -> Word8
fromChar Word8
c2
    x3 :: Word8
x3 = Word8 -> Word8
fromChar Word8
c3
    x4 :: Word8
x4 = Word8 -> Word8
fromChar Word8
c4
    bs' :: ByteString
bs' = Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
bs

dec' :: Word8 -> Word8 -> Word8 -> Word8 -> Builder
dec' :: Word8 -> Word8 -> Word8 -> Word8 -> Builder
dec' Word8
x1 Word8
x2 Word8
x3 Word8
x4 = Word8 -> Builder
BB.word8 Word8
d1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
d2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
d3
  where
    d1 :: Word8
d1 = (Word8
x1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
x2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
    d2 :: Word8
d2 = ((Word8
x2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF0) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
x3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
    d3 :: Word8
d3 = ((Word8
x3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xC0) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
x4

dec1' :: Word8 -> Word8 -> Builder
dec1' :: Word8 -> Word8 -> Builder
dec1' Word8
x1 Word8
x2 = Word8 -> Builder
BB.word8 Word8
d1
  where
    d1 :: Word8
d1 = (Word8
x1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
x2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)

dec2' :: Word8 -> Word8 -> Word8 -> Builder
dec2' :: Word8 -> Word8 -> Word8 -> Builder
dec2' Word8
x1 Word8
x2 Word8
x3 = Word8 -> Builder
BB.word8 Word8
d1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
d2
  where
    d1 :: Word8
d1 = (Word8
x1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
x2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
    d2 :: Word8
d2 = ((Word8
x2 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF0) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
x3 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2)

fromChar :: Word8 -> Word8
fromChar :: Word8 -> Word8
fromChar Word8
c
    | Word8 -> Bool
isUpper Word8
c = Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
cA
    | Word8 -> Bool
isLower Word8
c = Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
cSmallA Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
26
    | Word8 -> Bool
isDigit Word8
c = Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
cZero Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
52
    | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cPlus = Word8
62
    | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
cSlash = Word8
63
    | Bool
otherwise = [Char] -> Word8
forall a. HasCallStack => [Char] -> a
error ([Char]
"fromChar: Can't happen: Bad input: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
c)

{-
splits :: Int -> [a] -> [[a]]
splits _ [] = []
splits n xs = case splitAt n xs of
                  (ys, zs) -> ys:splits n zs
-}