{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
module Crypto.JOSE.Types.Internal
(
objectPairs
, encodeB64
, parseB64
, encodeB64Url
, parseB64Url
, bsToInteger
, integerToBS
, intBytes
, sizedIntegerToBS
, base64url
) where
import Data.Bifunctor (first)
import Data.Monoid ((<>))
import Data.Tuple (swap)
import Data.Word (Word8)
import Control.Lens
import Control.Lens.Cons.Extras
import Crypto.Number.Basic (log2)
import Data.Aeson.Types
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.URL as B64U
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
objectPairs :: Value -> [Pair]
objectPairs (Object o) = M.toList o
objectPairs _ = []
parseB64 :: (B.ByteString -> Parser a) -> T.Text -> Parser a
parseB64 f = either fail f . decodeB64
where
decodeB64 = B64.decode . E.encodeUtf8
encodeB64 :: B.ByteString -> Value
encodeB64 = String . E.decodeUtf8 . B64.encode
base64url ::
( AsEmpty s1, AsEmpty s2
, Cons s1 s1 Word8 Word8
, Cons s2 s2 Word8 Word8
) => Prism' s1 s2
base64url = reconsIso . b64u . reconsIso
where
b64u = prism B64U.encodeUnpadded (\s -> first (const s) (B64U.decodeUnpadded s))
reconsIso = iso (view recons) (view recons)
parseB64Url :: (B.ByteString -> Parser a) -> T.Text -> Parser a
parseB64Url f = maybe (fail "Not valid base64url") f . preview base64url . E.encodeUtf8
encodeB64Url :: B.ByteString -> Value
encodeB64Url = String . E.decodeUtf8 . review base64url
bsToInteger :: B.ByteString -> Integer
bsToInteger = B.foldl (\acc x -> acc * 256 + toInteger x) 0
integerToBS :: Integral a => a -> B.ByteString
integerToBS = B.reverse . B.unfoldr (fmap swap . f)
where
f 0 = Nothing
f x = Just (fromIntegral <$> quotRem x 256)
sizedIntegerToBS :: Integral a => Int -> a -> B.ByteString
sizedIntegerToBS w = zeroPad . integerToBS
where zeroPad xs = B.replicate (w - B.length xs) 0 `B.append` xs
intBytes :: Integer -> Int
intBytes n = (log2 n `div` 8) + 1