-- | Module      : Data.BaseSystems
--   Description : Provides default implementations for BaseSystem
--   Copyright   : Zoey McBride (c) 2026
--   License     : BSD-3-Clause
--   Maintainer  : zoeymcbride@mailbox.org
--   Stability   : experimental
--
-- This file provides common implementations for BaseSystem. These can be used
-- by calling either `encoder <basename>` or `decoder <basename>`.
module Data.BaseSystems
  ( base2,
    base10,
    base16lower,
    base16upper,
    base32lower,
    base32lowerNP,
    base32upper,
    base32upperNP,
    base32hexlower,
    base32hexlowerNP,
    base32hexupper,
    base32hexupperNP,
    base58btc,
    base64,
    base64NP,
    base64url,
    base64urlNP,
  )
where

import Data.BaseSystem.Alphabet (Alphabet)
import Data.BaseSystem.Alphabets qualified as ABCs
import Data.BaseSystem.Internal

-- | Provides methods for building a base32 system, with an option to toggle
-- padding.
mkBaseSystem32 :: String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 :: String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
name Maybe Char
padchar Alphabet
abc =
  String
-> Alphabet
-> Int
-> Int
-> Int
-> Maybe PaddingMethod
-> BitwiseSystem
BitwiseSystem String
name Alphabet
abc Int
symbits Int
groupbytes Int
groupsymbols (Maybe PaddingMethod -> BitwiseSystem)
-> Maybe PaddingMethod -> BitwiseSystem
forall a b. (a -> b) -> a -> b
$
    Char -> (Int -> String) -> PaddingMethod
PaddingMethod (Char -> (Int -> String) -> PaddingMethod)
-> (Char -> Int -> String) -> Char -> PaddingMethod
forall a b. (Char -> a -> b) -> (Char -> a) -> Char -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Int -> String
forall {a}. a -> Int -> [a]
padImpl (Char -> PaddingMethod) -> Maybe Char -> Maybe PaddingMethod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
padchar
  where
    groupbytes :: Int
groupbytes = Int
5
    groupsymbols :: Int
groupsymbols = Int
8
    symbits :: Int
symbits = Int
5
    padImpl :: a -> Int -> [a]
padImpl a
padding Int
bytestotal
      | Int
bytestotal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 = a -> Int -> [a]
padImpl a
padding (Int -> [a]) -> Int -> [a]
forall a b. (a -> b) -> a -> b
$ Int
bytestotal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
symbits
      | Int
bytestotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = [a
padding]
      | Int
bytestotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
3 a
padding
      | Int
bytestotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
4 a
padding
      | Int
bytestotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
6 a
padding
      | Bool
otherwise = []

-- | Provides methods for building a base64 system, with an option to toggle
-- padding.
mkBaseSystem64 :: String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem64 :: String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem64 String
name Maybe Char
padchar Alphabet
abc =
  String
-> Alphabet
-> Int
-> Int
-> Int
-> Maybe PaddingMethod
-> BitwiseSystem
BitwiseSystem String
name Alphabet
abc Int
symbits Int
groupbytes Int
groupsymbols (Maybe PaddingMethod -> BitwiseSystem)
-> Maybe PaddingMethod -> BitwiseSystem
forall a b. (a -> b) -> a -> b
$
    Char -> (Int -> String) -> PaddingMethod
PaddingMethod (Char -> (Int -> String) -> PaddingMethod)
-> (Char -> Int -> String) -> Char -> PaddingMethod
forall a b. (Char -> a -> b) -> (Char -> a) -> Char -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Int -> String
forall {a}. a -> Int -> [a]
padImpl (Char -> PaddingMethod) -> Maybe Char -> Maybe PaddingMethod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
padchar
  where
    groupbytes :: Int
groupbytes = Int
3
    groupsymbols :: Int
groupsymbols = Int
4
    symbits :: Int
symbits = Int
6
    padImpl :: a -> Int -> [a]
padImpl a
padding Int
bytestotal
      | Int
bytestotal Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3 = a -> Int -> [a]
padImpl a
padding (Int -> [a]) -> Int -> [a]
forall a b. (a -> b) -> a -> b
$ Int
bytestotal Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
groupbytes
      | Int
bytestotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = [a
padding]
      | Int
bytestotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [a
padding, a
padding]
      | Bool
otherwise = []

-- | Defines the BaseSystem for binary. This could be a BitwiseSystem, but we
-- would have to support multiple character ABCs.Symbols; currently we can't
-- do this, because it depends on Text.chunksOf 1 to tokenize the utf8 codes.
base2 :: RadixSystem
base2 :: RadixSystem
base2 = String -> Alphabet -> RadixSystem
RadixSystem String
"base2" Alphabet
ABCs.binary

-- | Defines base10 as RadixSystem.
base10 :: RadixSystem
base10 :: RadixSystem
base10 = String -> Alphabet -> RadixSystem
RadixSystem String
"base10" Alphabet
ABCs.decimal

-- | Defines Bitcoin's base58 implementation. Flickr apparently has one too.
base58btc :: RadixSystem
base58btc :: RadixSystem
base58btc = String -> Alphabet -> RadixSystem
RadixSystem String
"base58btc" Alphabet
ABCs.btc58

-- | Defines uppercase hexidecimal on BitwiseSystem. Orignally, this was on
-- RadixSystem, but I believe BitwiseSystem can become the more optimized
-- implementation. Either works.
base16upper :: RadixSystem
base16upper :: RadixSystem
base16upper = String -> Alphabet -> RadixSystem
RadixSystem String
"base16upper" Alphabet
ABCs.hexupper

-- | Defines lowercase hexadecimal on BitwiseSystem.
base16lower :: RadixSystem
base16lower :: RadixSystem
base16lower = String -> Alphabet -> RadixSystem
RadixSystem String
"base16lower" Alphabet
ABCs.hexlower

-- | Defines lowercase base32 from RFC4648, with padding.
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6
base32lower :: BitwiseSystem
base32lower :: BitwiseSystem
base32lower = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32lower" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'=') Alphabet
ABCs.b32lower

-- | Defines lowercase base32 from RFC4648. No padding!
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6
base32lowerNP :: BitwiseSystem
base32lowerNP :: BitwiseSystem
base32lowerNP = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32lowerNP" Maybe Char
forall a. Maybe a
Nothing Alphabet
ABCs.b32lower

-- | Defines uppercase base32 from RFC4648, with padding.
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6
base32upper :: BitwiseSystem
base32upper :: BitwiseSystem
base32upper = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32upper" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'=') Alphabet
ABCs.b32upper

-- | Defines uppercase base32 from RFC4648. No padding!
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6
base32upperNP :: BitwiseSystem
base32upperNP :: BitwiseSystem
base32upperNP = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32upperNP" Maybe Char
forall a. Maybe a
Nothing Alphabet
ABCs.b32upper

-- | Defines lowercase base32 from RFC4648, extended hex version, with padding.
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7
base32hexlower :: BitwiseSystem
base32hexlower :: BitwiseSystem
base32hexlower = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32hexlower" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'=') Alphabet
ABCs.b32hexlower

-- | Defines lowercase base32 from RFC4648, extended hex version. No padding!
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7
base32hexlowerNP :: BitwiseSystem
base32hexlowerNP :: BitwiseSystem
base32hexlowerNP = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32hexlowerNP" Maybe Char
forall a. Maybe a
Nothing Alphabet
ABCs.b32hexlower

-- | Defines lowercase base32 from RFC4648, extended hex version, with padding.
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7
base32hexupper :: BitwiseSystem
base32hexupper :: BitwiseSystem
base32hexupper = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32hexupper" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'=') Alphabet
ABCs.b32hexupper

-- | Defines uppercase base32 from RFC4648, extended hex version. No padding!
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7
base32hexupperNP :: BitwiseSystem
base32hexupperNP :: BitwiseSystem
base32hexupperNP = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem32 String
"base32hexupperNP" Maybe Char
forall a. Maybe a
Nothing Alphabet
ABCs.b32hexupper

-- | Defines base64 from RFC4648, with padding.
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4
base64 :: BitwiseSystem
base64 :: BitwiseSystem
base64 = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem64 String
"base64" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'=') Alphabet
ABCs.b64

-- | Defines base64 from RFC4648. No padding!
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4
base64NP :: BitwiseSystem
base64NP :: BitwiseSystem
base64NP = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem64 String
"base64NP" Maybe Char
forall a. Maybe a
Nothing Alphabet
ABCs.b64

-- | Defines URL safe base64 from RFC4648, with padding.
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5
base64url :: BitwiseSystem
base64url :: BitwiseSystem
base64url = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem64 String
"base64url" (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'=') Alphabet
ABCs.b64url

-- | Defines URL safe base64 from RFC4648. No padding!
-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5
base64urlNP :: BitwiseSystem
base64urlNP :: BitwiseSystem
base64urlNP = String -> Maybe Char -> Alphabet -> BitwiseSystem
mkBaseSystem64 String
"base64urlNP" Maybe Char
forall a. Maybe a
Nothing Alphabet
ABCs.b64url