{-# LANGUAGE OverloadedStrings #-}

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

import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString as BS
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 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
dec 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               = forall a. Monoid a => a
empty
    | Int
len forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&& Word8
c3 forall a. Eq a => a -> a -> Bool
== Word8
cEqual = Word8 -> Word8 -> Builder
dec1' Word8
x1 Word8
x2
    | Int
len forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
&& Word8
c4 forall a. Eq a => a -> a -> Bool
== Word8
cEqual = Word8 -> Word8 -> Word8 -> Builder
dec2' Word8
x1 Word8
x2 Word8
x3
    | Int
len forall a. Ord a => a -> a -> Bool
>= Int
4                 = Word8 -> Word8 -> Word8 -> Word8 -> Builder
dec' Word8
x1 Word8
x2 Word8
x3 Word8
x4 forall a. Monoid a => a -> a -> a
+++ ByteString -> Builder
dec ByteString
bs'
    | Bool
otherwise                = 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 forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
d2 forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
d3
  where
    d1 :: Word8
d1 =  (Word8
x1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2)           forall a. Bits a => a -> a -> a
.|. (Word8
x2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
    d2 :: Word8
d2 = ((Word8
x2 forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.&. Word8
0xF0) forall a. Bits a => a -> a -> a
.|. (Word8
x3 forall a. Bits a => a -> Int -> a
`shiftR` Int
2)
    d3 :: Word8
d3 = ((Word8
x3 forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Bits a => a -> a -> a
.&. Word8
0xC0) 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 forall a. Bits a => a -> Int -> a
`shiftL` Int
2)           forall a. Bits a => a -> a -> a
.|. (Word8
x2 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 forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BB.word8 Word8
d2
  where
    d1 :: Word8
d1 =  (Word8
x1 forall a. Bits a => a -> Int -> a
`shiftL` Int
2)           forall a. Bits a => a -> a -> a
.|. (Word8
x2 forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
    d2 :: Word8
d2 = ((Word8
x2 forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.&. Word8
0xF0) forall a. Bits a => a -> a -> a
.|. (Word8
x3 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 forall a. Num a => a -> a -> a
- Word8
cA
 | Word8 -> Bool
isLower Word8
c   = Word8
c forall a. Num a => a -> a -> a
- Word8
cSmallA forall a. Num a => a -> a -> a
+ Word8
26
 | Word8 -> Bool
isDigit Word8
c   = Word8
c forall a. Num a => a -> a -> a
- Word8
cZero   forall a. Num a => a -> a -> a
+ Word8
52
 | Word8
c forall a. Eq a => a -> a -> Bool
== Word8
cPlus  = Word8
62
 | Word8
c forall a. Eq a => a -> a -> Bool
== Word8
cSlash = Word8
63
 | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error ([Char]
"fromChar: Can't happen: Bad input: " forall a. [a] -> [a] -> [a]
++ 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
-}