{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}

-- |
-- Copyright   : 2019 Monadic GmbH
-- License     : BSD3
-- Maintainer  : kim@monadic.xyz, alfredo@monadic.xyz, team@monadic.xyz
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- Type-safe kitchen sink base-N encoding and decoding of strict 'ByteString's.
--

module Data.ByteString.BaseN
    ( Base(..)

    , AtBase
    , encodedBytes
    , encodedBuilder

    , Base2
    , Base16
    , Base58
    , Base64
    , BaseIdentity
    , Base16upper
    , Base32hex
    , Base32hexupper
    , Base32hexpad
    , Base32hexpadupper
    , Base32
    , Base32z
    , Base32upper
    , Base32pad
    , Base32padupper
    , Base58flickr
    , Base58btc
    , Base64pad
    , Base64url
    , Base64urlpad
    -- * Compact Representation
    , AtBaseCompact
    , compact
    , expand

    -- * Tagged
    -- $tagged
    , Base16Of
    , Base58Of
    , Base64Of

    -- ** Re-exports
    , tagWith
    , unTagged

    -- ** CBOR
    -- $cbor
    , DeserialiseError(..)
    , deserialiseAtBase

    -- * Encoding
    -- $encoding
    , encodeBase16
    , encodeBase58btc
    , encodeBase64
    , encodeAtBase

    -- * Decoding Bytes
    -- $decodingbytes
    , DecodeBase
    , decodeBase16
    , decodeBase16Either
    , decodeBase58btc
    , decodeBase64
    , decodeBase64Either
    , decodeBase64Lenient
    , decodeAtBase
    , decodeAtBaseEither

    -- * Decoding
    , decode

    -- ** Untrusted Input
    -- $untrusted
    , ValidBase
    , validBase16
    , validBase16Either
    , validBase58btc
    , validBase58btcEither
    , validBase64
    , validBase64Either
    , validAtBase
    , validAtBaseEither

    , validAndDecoded
    , validAndDecodedEither

    -- * 'Text'
    , encodedTextAtBase
    , encodedText
    , encodedTextBuilder

    -- * 'Formatting'
    , format
    , formatAtBase
    ) where

import           Prelude

import qualified Codec.Binary.Base32 as Base32
import qualified Codec.Binary.Base32Hex as Base32Hex
import           Codec.Serialise
                 ( DeserialiseFailure
                 , Serialise
                 , deserialiseOrFail
                 )
import           Control.DeepSeq (NFData)
import           Data.Aeson
                 ( FromJSON(..)
                 , FromJSONKey
                 , ToJSON(..)
                 , ToJSONKey
                 , withText
                 )
import qualified Data.Aeson.Encoding as JSON
import           Data.Bifunctor (bimap, first, second)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base32.Z as Base32z
import qualified Data.ByteString.Base58 as Base58
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Base64.URL as Base64Url
import           Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as Builder
import           Data.ByteString.Char8 (unpack)
import qualified Data.ByteString.Char8 as C8
import           Data.ByteString.Lazy (fromStrict)
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
import           Data.Char (toLower, toUpper)
import           Data.Hashable (Hashable)
import           Data.Proxy (Proxy(..))
import           Data.String (IsString(..))
import           Data.Tagged (Tagged, tagWith, unTagged)
import           Data.Text (Text)
import           Data.Text.Encoding (decodeLatin1, encodeUtf8)
import qualified Data.Text.Lazy.Builder as T
import qualified Formatting
import           GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import           Text.Show (Show(..), showParen, showString)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Test.QuickCheck
-- >>> import qualified Data.ByteString as BS
-- >>> newtype Bytes = Bytes ByteString deriving (Eq, Show)
-- >>> instance Arbitrary Bytes where arbitrary = Bytes . BS.pack <$> arbitrary

-- | Supported bases.
data Base (a :: Symbol) where
    BaseIdentity      :: Base "id"
    Base2             :: Base  "2"
    Base16            :: Base "16"
    Base64            :: Base "64"
    -- | hexadecimal, uppercase alphabet
    Base16upper       :: Base "16u"
    -- | RFC4648 no padding - highest char
    Base32hex         :: Base "32x"
    -- | RFC4648 no padding - highest char, uppercase alphabet
    Base32hexupper    :: Base "32xu"
    -- | RFC4648 with padding
    Base32hexpad      :: Base "32xp"
    -- | RFC4648 with padding, uppercase alphabet
    Base32hexpadupper :: Base "32xpu"
    -- | RFC4648 no padding
    Base32            :: Base "32"
    -- | z-base-32 (used by Tahoe-LAFS)
    Base32z           :: Base "32z"
    -- | RFC4648 no padding, uppercase alphabet
    Base32upper       :: Base "32u"
    -- | RFC4648 with padding
    Base32pad         :: Base "32p"
    -- | RFC4648 with padding, uppercase alphabet
    Base32padupper    :: Base "32pu"
    -- | base58 flickr alphabet
    Base58flickr      :: Base "58flickr"
    -- | base58 bitcoint alphabet
    Base58btc         :: Base "58btc"
    -- | RFC4648 with padding (MIME-encoding)
    Base64pad         :: Base "64p"
    -- | RFC4648 no padding
    Base64url         :: Base "64url"
    -- | RFC4648 with padding
    Base64urlpad      :: Base "64urlp"

-- | A 'ByteString' encoded at a specific base.
newtype AtBase (b :: Symbol) = BaseN { AtBase b -> ByteString
fromAtBase :: ByteString }
    deriving (AtBase b -> AtBase b -> Bool
(AtBase b -> AtBase b -> Bool)
-> (AtBase b -> AtBase b -> Bool) -> Eq (AtBase b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: Symbol). AtBase b -> AtBase b -> Bool
/= :: AtBase b -> AtBase b -> Bool
$c/= :: forall (b :: Symbol). AtBase b -> AtBase b -> Bool
== :: AtBase b -> AtBase b -> Bool
$c== :: forall (b :: Symbol). AtBase b -> AtBase b -> Bool
Eq, Eq (AtBase b)
Eq (AtBase b)
-> (AtBase b -> AtBase b -> Ordering)
-> (AtBase b -> AtBase b -> Bool)
-> (AtBase b -> AtBase b -> Bool)
-> (AtBase b -> AtBase b -> Bool)
-> (AtBase b -> AtBase b -> Bool)
-> (AtBase b -> AtBase b -> AtBase b)
-> (AtBase b -> AtBase b -> AtBase b)
-> Ord (AtBase b)
AtBase b -> AtBase b -> Bool
AtBase b -> AtBase b -> Ordering
AtBase b -> AtBase b -> AtBase b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (b :: Symbol). Eq (AtBase b)
forall (b :: Symbol). AtBase b -> AtBase b -> Bool
forall (b :: Symbol). AtBase b -> AtBase b -> Ordering
forall (b :: Symbol). AtBase b -> AtBase b -> AtBase b
min :: AtBase b -> AtBase b -> AtBase b
$cmin :: forall (b :: Symbol). AtBase b -> AtBase b -> AtBase b
max :: AtBase b -> AtBase b -> AtBase b
$cmax :: forall (b :: Symbol). AtBase b -> AtBase b -> AtBase b
>= :: AtBase b -> AtBase b -> Bool
$c>= :: forall (b :: Symbol). AtBase b -> AtBase b -> Bool
> :: AtBase b -> AtBase b -> Bool
$c> :: forall (b :: Symbol). AtBase b -> AtBase b -> Bool
<= :: AtBase b -> AtBase b -> Bool
$c<= :: forall (b :: Symbol). AtBase b -> AtBase b -> Bool
< :: AtBase b -> AtBase b -> Bool
$c< :: forall (b :: Symbol). AtBase b -> AtBase b -> Bool
compare :: AtBase b -> AtBase b -> Ordering
$ccompare :: forall (b :: Symbol). AtBase b -> AtBase b -> Ordering
$cp1Ord :: forall (b :: Symbol). Eq (AtBase b)
Ord, AtBase b -> ()
(AtBase b -> ()) -> NFData (AtBase b)
forall a. (a -> ()) -> NFData a
forall (b :: Symbol). AtBase b -> ()
rnf :: AtBase b -> ()
$crnf :: forall (b :: Symbol). AtBase b -> ()
NFData, Int -> AtBase b -> Int
AtBase b -> Int
(Int -> AtBase b -> Int)
-> (AtBase b -> Int) -> Hashable (AtBase b)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (b :: Symbol). Int -> AtBase b -> Int
forall (b :: Symbol). AtBase b -> Int
hash :: AtBase b -> Int
$chash :: forall (b :: Symbol). AtBase b -> Int
hashWithSalt :: Int -> AtBase b -> Int
$chashWithSalt :: forall (b :: Symbol). Int -> AtBase b -> Int
Hashable)

-- | Extract the base-n encoded bytes from an 'AtBase'.
--
-- To recover the original 'ByteString' (*not* base-n encoded), use 'decode'.
encodedBytes :: AtBase b -> ByteString
encodedBytes :: AtBase b -> ByteString
encodedBytes (BaseN ByteString
bs) = ByteString
bs

-- | Like 'encodedBytes', but return a 'Builder'.
encodedBuilder :: AtBase b -> Builder
encodedBuilder :: AtBase b -> Builder
encodedBuilder = ByteString -> Builder
Builder.byteString (ByteString -> Builder)
-> (AtBase b -> ByteString) -> AtBase b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtBase b -> ByteString
forall (b :: Symbol). AtBase b -> ByteString
encodedBytes

instance KnownSymbol b => Show (AtBase b) where
    showsPrec :: Int -> AtBase b -> ShowS
showsPrec Int
p (BaseN ByteString
bs) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString (String
"Base" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show (Proxy b -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy b
forall k (t :: k). Proxy t
Proxy @b)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ")
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ByteString
bs
        )

instance ValidBase b => IsString (AtBase b) where
    fromString :: String -> AtBase b
fromString = (String -> AtBase b)
-> (AtBase b -> AtBase b) -> Either String (AtBase b) -> AtBase b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> AtBase b
forall a. HasCallStack => String -> a
error AtBase b -> AtBase b
forall a. a -> a
id (Either String (AtBase b) -> AtBase b)
-> (String -> Either String (AtBase b)) -> String -> AtBase b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy b -> ByteString -> Either String (AtBase b)
forall (b :: Symbol) (proxy :: Symbol -> *).
ValidBase b =>
proxy b -> ByteString -> Either String (AtBase b)
validAtBaseEither (Proxy b
forall k (t :: k). Proxy t
Proxy @b) (ByteString -> Either String (AtBase b))
-> (String -> ByteString) -> String -> Either String (AtBase b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack

instance ToJSON (AtBase b) where
    toJSON :: AtBase b -> Value
toJSON     = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (AtBase b -> Text) -> AtBase b -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtBase b -> Text
forall (b :: Symbol). AtBase b -> Text
encodedText
    toEncoding :: AtBase b -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
JSON.text (Text -> Encoding) -> (AtBase b -> Text) -> AtBase b -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtBase b -> Text
forall (b :: Symbol). AtBase b -> Text
encodedText

instance (ValidBase b, KnownSymbol b) => FromJSON (AtBase b) where
    parseJSON :: Value -> Parser (AtBase b)
parseJSON =
        String -> (Text -> Parser (AtBase b)) -> Value -> Parser (AtBase b)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText (String
"AtBase " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show (Proxy b -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy b
forall k (t :: k). Proxy t
Proxy @b))) ((Text -> Parser (AtBase b)) -> Value -> Parser (AtBase b))
-> (Text -> Parser (AtBase b)) -> Value -> Parser (AtBase b)
forall a b. (a -> b) -> a -> b
$
            (String -> Parser (AtBase b))
-> (AtBase b -> Parser (AtBase b))
-> Either String (AtBase b)
-> Parser (AtBase b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser (AtBase b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail AtBase b -> Parser (AtBase b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (AtBase b) -> Parser (AtBase b))
-> (Text -> Either String (AtBase b)) -> Text -> Parser (AtBase b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy b -> ByteString -> Either String (AtBase b)
forall (b :: Symbol) (proxy :: Symbol -> *).
ValidBase b =>
proxy b -> ByteString -> Either String (AtBase b)
validAtBaseEither (Proxy b
forall k (t :: k). Proxy t
Proxy @b) (ByteString -> Either String (AtBase b))
-> (Text -> ByteString) -> Text -> Either String (AtBase b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToJSONKey (AtBase b)
instance (ValidBase b, KnownSymbol b) => FromJSONKey (AtBase b)

type Base2             = AtBase  "2"
type Base16            = AtBase "16"
type Base58            = AtBase "58"
type Base64            = AtBase "64"
type BaseIdentity      = AtBase "id"
type Base16upper       = AtBase "16u"
type Base32hex         = AtBase "16x"
type Base32hexupper    = AtBase "16xu"
type Base32hexpad      = AtBase "16xp"
type Base32hexpadupper = AtBase "16xup"
type Base32            = AtBase "32"
type Base32z           = AtBase "32z"
type Base32upper       = AtBase "32u"
type Base32pad         = AtBase "32p"
type Base32padupper    = AtBase "32pu"
type Base58flickr      = AtBase "58flickr"
type Base58btc         = AtBase "58btc"
type Base64pad         = AtBase "64p"
type Base64url         = AtBase "64url"
type Base64urlpad      = AtBase "16urlp"

-- Compact ---------------------------------------------------------------------

-- | A more memory-efficient representation of base-n encoded bytes.
--
-- Uses 'ShortByteString', recommendations and caveats described there apply.
newtype AtBaseCompact (b :: Symbol) = BaseNShort
    { AtBaseCompact b -> ShortByteString
fromAtBaseCompact :: ShortByteString
    } deriving (AtBaseCompact b -> AtBaseCompact b -> Bool
(AtBaseCompact b -> AtBaseCompact b -> Bool)
-> (AtBaseCompact b -> AtBaseCompact b -> Bool)
-> Eq (AtBaseCompact b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
/= :: AtBaseCompact b -> AtBaseCompact b -> Bool
$c/= :: forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
== :: AtBaseCompact b -> AtBaseCompact b -> Bool
$c== :: forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
Eq, Eq (AtBaseCompact b)
Eq (AtBaseCompact b)
-> (AtBaseCompact b -> AtBaseCompact b -> Ordering)
-> (AtBaseCompact b -> AtBaseCompact b -> Bool)
-> (AtBaseCompact b -> AtBaseCompact b -> Bool)
-> (AtBaseCompact b -> AtBaseCompact b -> Bool)
-> (AtBaseCompact b -> AtBaseCompact b -> Bool)
-> (AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b)
-> (AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b)
-> Ord (AtBaseCompact b)
AtBaseCompact b -> AtBaseCompact b -> Bool
AtBaseCompact b -> AtBaseCompact b -> Ordering
AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (b :: Symbol). Eq (AtBaseCompact b)
forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
forall (b :: Symbol).
AtBaseCompact b -> AtBaseCompact b -> Ordering
forall (b :: Symbol).
AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b
min :: AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b
$cmin :: forall (b :: Symbol).
AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b
max :: AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b
$cmax :: forall (b :: Symbol).
AtBaseCompact b -> AtBaseCompact b -> AtBaseCompact b
>= :: AtBaseCompact b -> AtBaseCompact b -> Bool
$c>= :: forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
> :: AtBaseCompact b -> AtBaseCompact b -> Bool
$c> :: forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
<= :: AtBaseCompact b -> AtBaseCompact b -> Bool
$c<= :: forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
< :: AtBaseCompact b -> AtBaseCompact b -> Bool
$c< :: forall (b :: Symbol). AtBaseCompact b -> AtBaseCompact b -> Bool
compare :: AtBaseCompact b -> AtBaseCompact b -> Ordering
$ccompare :: forall (b :: Symbol).
AtBaseCompact b -> AtBaseCompact b -> Ordering
$cp1Ord :: forall (b :: Symbol). Eq (AtBaseCompact b)
Ord, Int -> AtBaseCompact b -> Int
AtBaseCompact b -> Int
(Int -> AtBaseCompact b -> Int)
-> (AtBaseCompact b -> Int) -> Hashable (AtBaseCompact b)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (b :: Symbol). Int -> AtBaseCompact b -> Int
forall (b :: Symbol). AtBaseCompact b -> Int
hash :: AtBaseCompact b -> Int
$chash :: forall (b :: Symbol). AtBaseCompact b -> Int
hashWithSalt :: Int -> AtBaseCompact b -> Int
$chashWithSalt :: forall (b :: Symbol). Int -> AtBaseCompact b -> Int
Hashable, AtBaseCompact b -> ()
(AtBaseCompact b -> ()) -> NFData (AtBaseCompact b)
forall a. (a -> ()) -> NFData a
forall (b :: Symbol). AtBaseCompact b -> ()
rnf :: AtBaseCompact b -> ()
$crnf :: forall (b :: Symbol). AtBaseCompact b -> ()
NFData)

instance KnownSymbol b => Show (AtBaseCompact b) where
    showsPrec :: Int -> AtBaseCompact b -> ShowS
showsPrec Int
p (BaseNShort ShortByteString
bs) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
        ( String -> ShowS
showString (String
"Base" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show (Proxy b -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy b
forall k (t :: k). Proxy t
Proxy @b)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Compact ")
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShortByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ShortByteString
bs
        )

compact :: AtBase b -> AtBaseCompact b
compact :: AtBase b -> AtBaseCompact b
compact = ShortByteString -> AtBaseCompact b
forall (b :: Symbol). ShortByteString -> AtBaseCompact b
BaseNShort (ShortByteString -> AtBaseCompact b)
-> (AtBase b -> ShortByteString) -> AtBase b -> AtBaseCompact b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
Short.toShort (ByteString -> ShortByteString)
-> (AtBase b -> ByteString) -> AtBase b -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtBase b -> ByteString
forall (b :: Symbol). AtBase b -> ByteString
fromAtBase

expand :: AtBaseCompact b -> AtBase b
expand :: AtBaseCompact b -> AtBase b
expand = ByteString -> AtBase b
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase b)
-> (AtBaseCompact b -> ByteString) -> AtBaseCompact b -> AtBase b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
Short.fromShort (ShortByteString -> ByteString)
-> (AtBaseCompact b -> ShortByteString)
-> AtBaseCompact b
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtBaseCompact b -> ShortByteString
forall (b :: Symbol). AtBaseCompact b -> ShortByteString
fromAtBaseCompact

-- $tagged
-- 'AtBase' values tagged by the type they're representing.

type Base16Of a = Tagged a (AtBase "16")
type Base58Of a = Tagged a (AtBase "58")
type Base64Of a = Tagged a (AtBase "64")

-- $cbor
-- Directly go from (presumed to be) base-n encoded 'ByteString' to
-- de-'Serialise'-able value.

data DeserialiseError =
      DecodeBaseError  String
    | DeserialiseError DeserialiseFailure
    deriving Int -> DeserialiseError -> ShowS
[DeserialiseError] -> ShowS
DeserialiseError -> String
(Int -> DeserialiseError -> ShowS)
-> (DeserialiseError -> String)
-> ([DeserialiseError] -> ShowS)
-> Show DeserialiseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeserialiseError] -> ShowS
$cshowList :: [DeserialiseError] -> ShowS
show :: DeserialiseError -> String
$cshow :: DeserialiseError -> String
showsPrec :: Int -> DeserialiseError -> ShowS
$cshowsPrec :: Int -> DeserialiseError -> ShowS
Show

deserialiseAtBase
    :: ( Serialise  a
       , DecodeBase b
       )
    => proxy b
    -> ByteString
    -> Either DeserialiseError a
deserialiseAtBase :: proxy b -> ByteString -> Either DeserialiseError a
deserialiseAtBase proxy b
base ByteString
bs = do
    ByteString
bs' <- (String -> DeserialiseError)
-> (ByteString -> ByteString)
-> Either String ByteString
-> Either DeserialiseError ByteString
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> DeserialiseError
DecodeBaseError ByteString -> ByteString
fromStrict (Either String ByteString -> Either DeserialiseError ByteString)
-> Either String ByteString -> Either DeserialiseError ByteString
forall a b. (a -> b) -> a -> b
$ proxy b -> ByteString -> Either String ByteString
forall (b :: Symbol) (proxy :: Symbol -> *).
DecodeBase b =>
proxy b -> ByteString -> Either String ByteString
decodeAtBaseEither proxy b
base ByteString
bs
    (DeserialiseFailure -> DeserialiseError)
-> Either DeserialiseFailure a -> Either DeserialiseError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserialiseFailure -> DeserialiseError
DeserialiseError (Either DeserialiseFailure a -> Either DeserialiseError a)
-> Either DeserialiseFailure a -> Either DeserialiseError a
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DeserialiseFailure a
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail ByteString
bs'

-- $encoding

encodeBase16 :: ByteString -> AtBase "16"
encodeBase16 :: ByteString -> AtBase "16"
encodeBase16 = ByteString -> AtBase "16"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "16")
-> (ByteString -> ByteString) -> ByteString -> AtBase "16"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
{-# INLINE encodeBase16 #-}

encodeBase64 :: ByteString -> AtBase "64"
encodeBase64 :: ByteString -> AtBase "64"
encodeBase64 = ByteString -> AtBase "64"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "64")
-> (ByteString -> ByteString) -> ByteString -> AtBase "64"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode
{-# INLINE encodeBase64 #-}

-- |
-- >>> fromAtBase $ encodeBase16upper "hello world"
-- "68656C6C6F20776F726C64"
encodeBase16upper :: ByteString -> AtBase "16u"
encodeBase16upper :: ByteString -> AtBase "16u"
encodeBase16upper = ByteString -> AtBase "16u"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "16u")
-> (ByteString -> ByteString) -> ByteString -> AtBase "16u"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toUpper (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
{-# INLINE encodeBase16upper #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase16upper (fromAtBase $ encodeBase16upper bytes) === Right bytes
decodeBase16upper :: ByteString -> Either String ByteString
decodeBase16upper :: ByteString -> Either String ByteString
decodeBase16upper = ByteString -> Either String ByteString
decodeBase16Either
{-# INLINE decodeBase16upper #-}

-- Base 32 ---------------------------------------------------------------------

-- |
-- >>> fromAtBase . encodeBase32hex $ "hello world"
-- "d1imor3f41rmusjccg"
encodeBase32hex :: ByteString -> AtBase "32x"
encodeBase32hex :: ByteString -> AtBase "32x"
encodeBase32hex = ByteString -> AtBase "32x"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32x")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32x"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toLower (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropPadding (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32Hex.encode
{-# INLINE encodeBase32hex #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32hex (fromAtBase $ encodeBase32hex bytes) === Right bytes
decodeBase32hex :: ByteString -> Either String ByteString
decodeBase32hex :: ByteString -> Either String ByteString
decodeBase32hex ByteString
bs
    | ByteString -> Bool
C8.null ByteString
bs = ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
forall a. Monoid a => a
mempty
    | Bool
otherwise  = ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32Hex.decode (ByteString -> Either (ByteString, ByteString) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
padTo Int
8 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toUpper (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32hex #-}

-- |
-- >>> fromAtBase . encodeBase32hexupper $ "hello world"
-- "D1IMOR3F41RMUSJCCG"
encodeBase32hexupper :: ByteString -> AtBase "32xu"
encodeBase32hexupper :: ByteString -> AtBase "32xu"
encodeBase32hexupper = ByteString -> AtBase "32xu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32xu")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32xu"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropPadding (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32Hex.encode
{-# INLINE encodeBase32hexupper #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32hexupper (fromAtBase $ encodeBase32hexupper bytes) === Right bytes
decodeBase32hexupper :: ByteString -> Either String ByteString
decodeBase32hexupper :: ByteString -> Either String ByteString
decodeBase32hexupper ByteString
bs = ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32Hex.decode (ByteString -> Either (ByteString, ByteString) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
padTo Int
8 (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32hexupper #-}

-- |
-- >>> fromAtBase . encodeBase32hexpad $ "hello world"
-- "d1imor3f41rmusjccg======"
encodeBase32hexpad :: ByteString -> AtBase "32xp"
encodeBase32hexpad :: ByteString -> AtBase "32xp"
encodeBase32hexpad = ByteString -> AtBase "32xp"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32xp")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32xp"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toLower (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32Hex.encode
{-# INLINE encodeBase32hexpad #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32hexpad (fromAtBase $ encodeBase32hexpad bytes) === Right bytes
decodeBase32hexpad :: ByteString -> Either String ByteString
decodeBase32hexpad :: ByteString -> Either String ByteString
decodeBase32hexpad ByteString
bs =
    ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32Hex.decode (ByteString -> Either (ByteString, ByteString) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toUpper (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32hexpad #-}

-- |
-- >>> fromAtBase . encodeBase32hexpadupper $ "hello world"
-- "D1IMOR3F41RMUSJCCG======"
encodeBase32hexpadupper :: ByteString -> AtBase "32xpu"
encodeBase32hexpadupper :: ByteString -> AtBase "32xpu"
encodeBase32hexpadupper = ByteString -> AtBase "32xpu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32xpu")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32xpu"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32Hex.encode
{-# INLINE encodeBase32hexpadupper #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32hexpadupper (fromAtBase $ encodeBase32hexpadupper bytes) === Right bytes
decodeBase32hexpadupper :: ByteString -> Either String ByteString
decodeBase32hexpadupper :: ByteString -> Either String ByteString
decodeBase32hexpadupper ByteString
bs = ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32Hex.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32hexpadupper #-}

-- |
-- >>> fromAtBase . encodeBase32 $ "hello world"
-- "nbswy3dpeb3w64tmmq"
encodeBase32 :: ByteString -> AtBase "32"
encodeBase32 :: ByteString -> AtBase "32"
encodeBase32 = ByteString -> AtBase "32"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toLower (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropPadding (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32.encode
{-# INLINE encodeBase32 #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32 (fromAtBase $ encodeBase32 bytes) === Right bytes
decodeBase32 :: ByteString -> Either String ByteString
decodeBase32 :: ByteString -> Either String ByteString
decodeBase32 ByteString
bs =
    ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32.decode (ByteString -> Either (ByteString, ByteString) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
padTo Int
8 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toUpper (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32 #-}

-- |
-- >>> fromAtBase . encodeBase32z $ "hello world"
-- "pb1sa5dxrb5s6hucco"
encodeBase32z :: ByteString -> AtBase "32z"
encodeBase32z :: ByteString -> AtBase "32z"
encodeBase32z = ByteString -> AtBase "32z"
forall (b :: Symbol). ByteString -> AtBase b
BaseN  (ByteString -> AtBase "32z")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32z"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32z.encode
{-# INLINE encodeBase32z #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32z (fromAtBase $ encodeBase32z bytes) === Right bytes
decodeBase32z :: ByteString -> Either String ByteString
decodeBase32z :: ByteString -> Either String ByteString
decodeBase32z = ByteString -> Either String ByteString
Base32z.decode (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toLower
{-# INLINE decodeBase32z #-}
-- |
-- >>> fromAtBase . encodeBase32upper $ "hello world"
-- "NBSWY3DPEB3W64TMMQ"
encodeBase32upper :: ByteString -> AtBase "32u"
encodeBase32upper :: ByteString -> AtBase "32u"
encodeBase32upper = ByteString -> AtBase "32u"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32u")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32u"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropPadding (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32.encode
{-# INLINE encodeBase32upper #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32upper (fromAtBase $ encodeBase32upper bytes) === Right bytes
decodeBase32upper :: ByteString -> Either String ByteString
decodeBase32upper :: ByteString -> Either String ByteString
decodeBase32upper ByteString
bs = ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32.decode (ByteString -> Either (ByteString, ByteString) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
padTo Int
8 (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32upper #-}

-- |
-- >>> fromAtBase . encodeBase32pad $ "hello world"
-- "nbswy3dpeb3w64tmmq======"
encodeBase32pad :: ByteString -> AtBase "32p"
encodeBase32pad :: ByteString -> AtBase "32p"
encodeBase32pad = ByteString -> AtBase "32p"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32p")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32p"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toLower (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32.encode
{-# INLINE encodeBase32pad #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32pad (fromAtBase $ encodeBase32pad bytes) === Right bytes
decodeBase32pad :: ByteString -> Either String ByteString
decodeBase32pad :: ByteString -> Either String ByteString
decodeBase32pad ByteString
bs = ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32.decode (ByteString -> Either (ByteString, ByteString) ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either (ByteString, ByteString) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
C8.map Char -> Char
toUpper (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32pad #-}

-- |
-- >>> fromAtBase . encodeBase32padupper $ "hello world"
-- "NBSWY3DPEB3W64TMMQ======"
encodeBase32padupper :: ByteString -> AtBase "32pu"
encodeBase32padupper :: ByteString -> AtBase "32pu"
encodeBase32padupper = ByteString -> AtBase "32pu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "32pu")
-> (ByteString -> ByteString) -> ByteString -> AtBase "32pu"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base32.encode
{-# INLINE encodeBase32padupper #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase32padupper (fromAtBase $ encodeBase32padupper bytes) === Right bytes
decodeBase32padupper :: ByteString -> Either String ByteString
decodeBase32padupper :: ByteString -> Either String ByteString
decodeBase32padupper ByteString
bs = ((ByteString, ByteString) -> String)
-> Either (ByteString, ByteString) ByteString
-> Either String ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
bs) (Either (ByteString, ByteString) ByteString
 -> Either String ByteString)
-> (ByteString -> Either (ByteString, ByteString) ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either (ByteString, ByteString) ByteString
Base32.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE decodeBase32padupper #-}

base32Err :: ByteString -> (ByteString, ByteString) -> String
base32Err :: ByteString -> (ByteString, ByteString) -> String
base32Err ByteString
orig (ByteString
x, ByteString
invalid) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"Decoded "
    , String
"`", ByteString -> String
unpack ByteString
orig, String
"`"
    , String
" to "
    , String
"`", ByteString -> String
unpack ByteString
x, String
"`"
    , String
" until invalid sequence: "
    , String
"`", ByteString -> String
unpack ByteString
invalid, String
"`"
    ]

-- Base 58 ---------------------------------------------------------------------

-- |
-- >>> fromAtBase . encodeBase58flickr $ "hello world"
-- "rTu1dk6cWsRYjYu"
encodeBase58flickr :: ByteString -> AtBase "58flickr"
encodeBase58flickr :: ByteString -> AtBase "58flickr"
encodeBase58flickr = ByteString -> AtBase "58flickr"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "58flickr")
-> (ByteString -> ByteString) -> ByteString -> AtBase "58flickr"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> ByteString
Base58.encodeBase58 Alphabet
Base58.flickrAlphabet
{-# INLINE encodeBase58flickr #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase58flickr (fromAtBase $ encodeBase58flickr bytes) === Right bytes
decodeBase58flickr :: ByteString -> Either String ByteString
decodeBase58flickr :: ByteString -> Either String ByteString
decodeBase58flickr =
    String -> Maybe ByteString -> Either String ByteString
forall a b. a -> Maybe b -> Either a b
note String
"Invalid characters in Base58flickr string"
        (Maybe ByteString -> Either String ByteString)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> Maybe ByteString
Base58.decodeBase58 Alphabet
Base58.flickrAlphabet
{-# INLINE decodeBase58flickr #-}

-- |
-- >>> fromAtBase . encodeBase58btc $ "hello world"
-- "StV1DL6CwTryKyV"
encodeBase58btc :: ByteString -> AtBase "58btc"
encodeBase58btc :: ByteString -> AtBase "58btc"
encodeBase58btc = ByteString -> AtBase "58btc"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "58btc")
-> (ByteString -> ByteString) -> ByteString -> AtBase "58btc"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> ByteString
Base58.encodeBase58 Alphabet
Base58.bitcoinAlphabet
{-# INLINE encodeBase58btc #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase58btc (fromAtBase $ encodeBase58btc bytes) === Right bytes
decodeBase58btc :: ByteString -> Either String ByteString
decodeBase58btc :: ByteString -> Either String ByteString
decodeBase58btc =
    String -> Maybe ByteString -> Either String ByteString
forall a b. a -> Maybe b -> Either a b
note String
"Invalid characters in Base58btc string"
        (Maybe ByteString -> Either String ByteString)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alphabet -> ByteString -> Maybe ByteString
Base58.decodeBase58 Alphabet
Base58.bitcoinAlphabet
{-# INLINE decodeBase58btc #-}

-- |
-- >>> fromAtBase . encodeBase64pad $ "hello world"
-- "aGVsbG8gd29ybGQ="
encodeBase64pad :: ByteString -> AtBase "64p"
encodeBase64pad :: ByteString -> AtBase "64p"
encodeBase64pad = ByteString -> AtBase "64p"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "64p")
-> (ByteString -> ByteString) -> ByteString -> AtBase "64p"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode
{-# INLINE encodeBase64pad #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase64pad (fromAtBase $ encodeBase64pad bytes) === Right bytes
decodeBase64pad :: ByteString -> Either String ByteString
decodeBase64pad :: ByteString -> Either String ByteString
decodeBase64pad = ByteString -> Either String ByteString
Base64.decode
{-# INLINE decodeBase64pad #-}

-- |
-- >>> fromAtBase . encodeBase64url $ "hello world"
-- "aGVsbG8gd29ybGQ"
encodeBase64url :: ByteString -> AtBase "64url"
encodeBase64url :: ByteString -> AtBase "64url"
encodeBase64url = ByteString -> AtBase "64url"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "64url")
-> (ByteString -> ByteString) -> ByteString -> AtBase "64url"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.spanEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64Url.encode
{-# INLINE encodeBase64url #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase64url (fromAtBase $ encodeBase64url bytes) === Right bytes
decodeBase64url :: ByteString -> Either String ByteString
decodeBase64url :: ByteString -> Either String ByteString
decodeBase64url = ByteString -> Either String ByteString
Base64Url.decode (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
padTo Int
4
{-# INLINE decodeBase64url #-}

-- |
-- >>> fromAtBase . encodeBase64urlpad $ "hello world"
-- "aGVsbG8gd29ybGQ="
encodeBase64urlpad :: ByteString -> AtBase "64urlp"
encodeBase64urlpad :: ByteString -> AtBase "64urlp"
encodeBase64urlpad = ByteString -> AtBase "64urlp"
forall (b :: Symbol). ByteString -> AtBase b
BaseN (ByteString -> AtBase "64urlp")
-> (ByteString -> ByteString) -> ByteString -> AtBase "64urlp"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64Url.encode
{-# INLINE encodeBase64urlpad #-}

-- |
-- prop> \(Bytes bytes) -> decodeBase64urlpad (fromAtBase $ encodeBase64urlpad bytes) === Right bytes
decodeBase64urlpad :: ByteString -> Either String ByteString
decodeBase64urlpad :: ByteString -> Either String ByteString
decodeBase64urlpad = ByteString -> Either String ByteString
Base64Url.decode
{-# INLINE decodeBase64urlpad #-}

-- | Encode at a base supplied at runtime.
encodeAtBase :: Base b -> ByteString -> AtBase b
encodeAtBase :: Base b -> ByteString -> AtBase b
encodeAtBase Base b
Base2             = ByteString -> AtBase b
forall (b :: Symbol). ByteString -> AtBase b
BaseN
encodeAtBase Base b
Base16            = ByteString -> AtBase b
ByteString -> AtBase "16"
encodeBase16
encodeAtBase Base b
Base64            = ByteString -> AtBase b
ByteString -> AtBase "64"
encodeBase64
encodeAtBase Base b
BaseIdentity      = ByteString -> AtBase b
forall (b :: Symbol). ByteString -> AtBase b
BaseN
encodeAtBase Base b
Base16upper       = ByteString -> AtBase b
ByteString -> AtBase "16u"
encodeBase16upper
encodeAtBase Base b
Base32hex         = ByteString -> AtBase b
ByteString -> AtBase "32x"
encodeBase32hex
encodeAtBase Base b
Base32hexupper    = ByteString -> AtBase b
ByteString -> AtBase "32xu"
encodeBase32hexupper
encodeAtBase Base b
Base32hexpad      = ByteString -> AtBase b
ByteString -> AtBase "32xp"
encodeBase32hexpad
encodeAtBase Base b
Base32hexpadupper = ByteString -> AtBase b
ByteString -> AtBase "32xpu"
encodeBase32hexpadupper
encodeAtBase Base b
Base32            = ByteString -> AtBase b
ByteString -> AtBase "32"
encodeBase32
encodeAtBase Base b
Base32z           = ByteString -> AtBase b
ByteString -> AtBase "32z"
encodeBase32z
encodeAtBase Base b
Base32upper       = ByteString -> AtBase b
ByteString -> AtBase "32u"
encodeBase32upper
encodeAtBase Base b
Base32pad         = ByteString -> AtBase b
ByteString -> AtBase "32p"
encodeBase32pad
encodeAtBase Base b
Base32padupper    = ByteString -> AtBase b
ByteString -> AtBase "32pu"
encodeBase32padupper
encodeAtBase Base b
Base58flickr      = ByteString -> AtBase b
ByteString -> AtBase "58flickr"
encodeBase58flickr
encodeAtBase Base b
Base58btc         = ByteString -> AtBase b
ByteString -> AtBase "58btc"
encodeBase58btc
encodeAtBase Base b
Base64pad         = ByteString -> AtBase b
ByteString -> AtBase "64p"
encodeBase64pad
encodeAtBase Base b
Base64url         = ByteString -> AtBase b
ByteString -> AtBase "64url"
encodeBase64url
encodeAtBase Base b
Base64urlpad      = ByteString -> AtBase b
ByteString -> AtBase "64urlp"
encodeBase64urlpad

-- $decodingbytes
-- Decode (presumed to be) base-n encoded 'ByteString's to their original
-- (base-2) value.

decodeBase16 :: ByteString -> Maybe ByteString
decodeBase16 :: ByteString -> Maybe ByteString
decodeBase16 = (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase16Either

decodeBase16Either :: ByteString -> Either String ByteString
decodeBase16Either :: ByteString -> Either String ByteString
decodeBase16Either = ByteString -> Either String ByteString
Base16.decode
{-# INLINE decodeBase16Either #-}

decodeBase64 :: ByteString -> Maybe ByteString
decodeBase64 :: ByteString -> Maybe ByteString
decodeBase64 = (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase64Either

decodeBase64Either :: ByteString -> Either String ByteString
decodeBase64Either :: ByteString -> Either String ByteString
decodeBase64Either = ByteString -> Either String ByteString
Base64.decode
{-# INLINE decodeBase64Either #-}

decodeBase64Lenient :: ByteString -> ByteString
decodeBase64Lenient :: ByteString -> ByteString
decodeBase64Lenient = ByteString -> ByteString
Base64.decodeLenient
{-# INLINE decodeBase64Lenient #-}

class DecodeBase (b :: Symbol) where
    decodeAtBase       :: proxy b -> ByteString -> Maybe ByteString
    decodeAtBaseEither :: proxy b -> ByteString -> Either String ByteString

instance DecodeBase "id" where
    decodeAtBase :: proxy "id" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "id" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    decodeAtBaseEither :: proxy "id" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "id" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "2" where
    decodeAtBase :: proxy "2" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "2" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    decodeAtBaseEither :: proxy "2" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "2" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "16" where
    decodeAtBase :: proxy "16" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "16" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const ByteString -> Maybe ByteString
decodeBase16
    decodeAtBaseEither :: proxy "16" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "16" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase16Either
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "16u" where
    decodeAtBase :: proxy "16u" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "16u" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase16upper)
    decodeAtBaseEither :: proxy "16u" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "16u" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase16upper
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32" where
    decodeAtBase :: proxy "32" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32)
    decodeAtBaseEither :: proxy "32" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32z" where
    decodeAtBase :: proxy "32z" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32z" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32z)
    decodeAtBaseEither :: proxy "32z" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32z" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32z
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32u" where
    decodeAtBase :: proxy "32u" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32u" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32upper)
    decodeAtBaseEither :: proxy "32u" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32u" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32upper
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32p" where
    decodeAtBase :: proxy "32p" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32p" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32pad)
    decodeAtBaseEither :: proxy "32p" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32p" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32pad
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32pu" where
    decodeAtBase :: proxy "32pu" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32pu" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32padupper)
    decodeAtBaseEither :: proxy "32pu" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32pu" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32padupper
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32x" where
    decodeAtBase :: proxy "32x" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32x" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32hex)
    decodeAtBaseEither :: proxy "32x" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32x" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32hex
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32xu" where
    decodeAtBase :: proxy "32xu" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32xu" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32hexupper)
    decodeAtBaseEither :: proxy "32xu" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32xu" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32hexupper
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32xp" where
    decodeAtBase :: proxy "32xp" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32xp" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32hexpad)
    decodeAtBaseEither :: proxy "32xp" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32xp" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32hexpad
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "32xpu" where
    decodeAtBase :: proxy "32xpu" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "32xpu" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase32hexpadupper)
    decodeAtBaseEither :: proxy "32xpu" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "32xpu" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase32hexpadupper
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "58btc" where
    decodeAtBase :: proxy "58btc" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "58btc" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase58btc)
    decodeAtBaseEither :: proxy "58btc" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "58btc" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase58btc
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "58flickr" where
    decodeAtBase :: proxy "58flickr" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "58flickr" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase58flickr)
    decodeAtBaseEither :: proxy "58flickr" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "58flickr" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase58flickr
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "64" where
    decodeAtBase :: proxy "64" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "64" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const ByteString -> Maybe ByteString
decodeBase64
    decodeAtBaseEither :: proxy "64" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "64" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase64Either
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "64p" where
    decodeAtBase :: proxy "64p" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "64p" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase64pad)
    decodeAtBaseEither :: proxy "64p" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "64p" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase64pad
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "64url" where
    decodeAtBase :: proxy "64url" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "64url" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase64url)
    decodeAtBaseEither :: proxy "64url" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "64url" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase64url
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

instance DecodeBase "64urlpad" where
    decodeAtBase :: proxy "64urlpad" -> ByteString -> Maybe ByteString
decodeAtBase       = (ByteString -> Maybe ByteString)
-> proxy "64urlpad" -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const (Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (Either String ByteString -> Maybe ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decodeBase64urlpad)
    decodeAtBaseEither :: proxy "64urlpad" -> ByteString -> Either String ByteString
decodeAtBaseEither = (ByteString -> Either String ByteString)
-> proxy "64urlpad" -> ByteString -> Either String ByteString
forall a b. a -> b -> a
const ByteString -> Either String ByteString
decodeBase64urlpad
    {-# INLINE decodeAtBase       #-}
    {-# INLINE decodeAtBaseEither #-}

-- | Recover the original 'ByteString' of a base-n encoded value.
decode :: DecodeBase b => AtBase b -> ByteString
decode :: AtBase b -> ByteString
decode AtBase b
at = case AtBase b -> ByteString -> Either String ByteString
forall (b :: Symbol) (proxy :: Symbol -> *).
DecodeBase b =>
proxy b -> ByteString -> Either String ByteString
decodeAtBaseEither AtBase b
at (AtBase b -> ByteString
forall (b :: Symbol). AtBase b -> ByteString
encodedBytes AtBase b
at) of
    Left  String
e -> String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Impossible: invalid base encoding: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
    Right ByteString
b -> ByteString
b

-- $untrusted
-- Construct 'AtBase's from raw 'ByteString's. Note that this attempts to decode
-- using the functions from $decoding, and throws away the result.

validBase16 :: ByteString -> Maybe (AtBase "16")
validBase16 :: ByteString -> Maybe (AtBase "16")
validBase16 ByteString
bs = ByteString -> AtBase "16"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "16" -> Maybe ByteString -> Maybe (AtBase "16")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Maybe ByteString
decodeBase16 ByteString
bs

validBase16Either :: ByteString -> Either String (AtBase "16")
validBase16Either :: ByteString -> Either String (AtBase "16")
validBase16Either ByteString
bs = (ByteString -> AtBase "16")
-> Either String ByteString -> Either String (AtBase "16")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "16" -> ByteString -> AtBase "16"
forall a b. a -> b -> a
const (AtBase "16" -> ByteString -> AtBase "16")
-> AtBase "16" -> ByteString -> AtBase "16"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "16"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "16"))
-> Either String ByteString -> Either String (AtBase "16")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase16Either ByteString
bs

validBase16upper :: ByteString -> Maybe (AtBase "16u")
validBase16upper :: ByteString -> Maybe (AtBase "16u")
validBase16upper ByteString
bs = ByteString -> AtBase "16u"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "16u" -> Maybe ByteString -> Maybe (AtBase "16u")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase16upper ByteString
bs)

validBase16upperEither :: ByteString -> Either String (AtBase "16u")
validBase16upperEither :: ByteString -> Either String (AtBase "16u")
validBase16upperEither ByteString
bs = (ByteString -> AtBase "16u")
-> Either String ByteString -> Either String (AtBase "16u")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "16u" -> ByteString -> AtBase "16u"
forall a b. a -> b -> a
const (AtBase "16u" -> ByteString -> AtBase "16u")
-> AtBase "16u" -> ByteString -> AtBase "16u"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "16u"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "16u"))
-> Either String ByteString -> Either String (AtBase "16u")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase16upper ByteString
bs

validBase32hex :: ByteString -> Maybe (AtBase "32x")
validBase32hex :: ByteString -> Maybe (AtBase "32x")
validBase32hex ByteString
bs = ByteString -> AtBase "32x"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32x" -> Maybe ByteString -> Maybe (AtBase "32x")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32hex ByteString
bs)

validBase32hexEither :: ByteString -> Either String (AtBase "32x")
validBase32hexEither :: ByteString -> Either String (AtBase "32x")
validBase32hexEither ByteString
bs = (ByteString -> AtBase "32x")
-> Either String ByteString -> Either String (AtBase "32x")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32x" -> ByteString -> AtBase "32x"
forall a b. a -> b -> a
const (AtBase "32x" -> ByteString -> AtBase "32x")
-> AtBase "32x" -> ByteString -> AtBase "32x"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32x"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32x"))
-> Either String ByteString -> Either String (AtBase "32x")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32hex ByteString
bs

validBase32hexupper :: ByteString -> Maybe (AtBase "32xu")
validBase32hexupper :: ByteString -> Maybe (AtBase "32xu")
validBase32hexupper ByteString
bs = ByteString -> AtBase "32xu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32xu" -> Maybe ByteString -> Maybe (AtBase "32xu")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32hexupper ByteString
bs)

validBase32hexupperEither :: ByteString -> Either String (AtBase "32xu")
validBase32hexupperEither :: ByteString -> Either String (AtBase "32xu")
validBase32hexupperEither ByteString
bs = (ByteString -> AtBase "32xu")
-> Either String ByteString -> Either String (AtBase "32xu")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32xu" -> ByteString -> AtBase "32xu"
forall a b. a -> b -> a
const (AtBase "32xu" -> ByteString -> AtBase "32xu")
-> AtBase "32xu" -> ByteString -> AtBase "32xu"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32xu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32xu"))
-> Either String ByteString -> Either String (AtBase "32xu")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32hexupper ByteString
bs

validBase32hexpad :: ByteString -> Maybe (AtBase "32xp")
validBase32hexpad :: ByteString -> Maybe (AtBase "32xp")
validBase32hexpad ByteString
bs = ByteString -> AtBase "32xp"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32xp" -> Maybe ByteString -> Maybe (AtBase "32xp")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32hexpad ByteString
bs)

validBase32hexpadEither :: ByteString -> Either String (AtBase "32xp")
validBase32hexpadEither :: ByteString -> Either String (AtBase "32xp")
validBase32hexpadEither ByteString
bs = (ByteString -> AtBase "32xp")
-> Either String ByteString -> Either String (AtBase "32xp")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32xp" -> ByteString -> AtBase "32xp"
forall a b. a -> b -> a
const (AtBase "32xp" -> ByteString -> AtBase "32xp")
-> AtBase "32xp" -> ByteString -> AtBase "32xp"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32xp"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32xp"))
-> Either String ByteString -> Either String (AtBase "32xp")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32hexpad ByteString
bs

validBase32hexpadupper :: ByteString -> Maybe (AtBase "32xpu")
validBase32hexpadupper :: ByteString -> Maybe (AtBase "32xpu")
validBase32hexpadupper ByteString
bs = ByteString -> AtBase "32xpu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32xpu" -> Maybe ByteString -> Maybe (AtBase "32xpu")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32hexpadupper ByteString
bs)

validBase32hexpadupperEither :: ByteString -> Either String (AtBase "32xpu")
validBase32hexpadupperEither :: ByteString -> Either String (AtBase "32xpu")
validBase32hexpadupperEither ByteString
bs = (ByteString -> AtBase "32xpu")
-> Either String ByteString -> Either String (AtBase "32xpu")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32xpu" -> ByteString -> AtBase "32xpu"
forall a b. a -> b -> a
const (AtBase "32xpu" -> ByteString -> AtBase "32xpu")
-> AtBase "32xpu" -> ByteString -> AtBase "32xpu"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32xpu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32xpu"))
-> Either String ByteString -> Either String (AtBase "32xpu")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32hexpadupper ByteString
bs

validBase32 :: ByteString -> Maybe (AtBase "32")
validBase32 :: ByteString -> Maybe (AtBase "32")
validBase32 ByteString
bs = ByteString -> AtBase "32"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32" -> Maybe ByteString -> Maybe (AtBase "32")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32 ByteString
bs)

validBase32Either :: ByteString -> Either String (AtBase "32")
validBase32Either :: ByteString -> Either String (AtBase "32")
validBase32Either ByteString
bs = (ByteString -> AtBase "32")
-> Either String ByteString -> Either String (AtBase "32")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32" -> ByteString -> AtBase "32"
forall a b. a -> b -> a
const (AtBase "32" -> ByteString -> AtBase "32")
-> AtBase "32" -> ByteString -> AtBase "32"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32"))
-> Either String ByteString -> Either String (AtBase "32")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32 ByteString
bs

validBase32z :: ByteString -> Maybe (AtBase "32z")
validBase32z :: ByteString -> Maybe (AtBase "32z")
validBase32z ByteString
bs = ByteString -> AtBase "32z"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32z" -> Maybe ByteString -> Maybe (AtBase "32z")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32z ByteString
bs)

validBase32zEither :: ByteString -> Either String (AtBase "32z")
validBase32zEither :: ByteString -> Either String (AtBase "32z")
validBase32zEither ByteString
bs = (ByteString -> AtBase "32z")
-> Either String ByteString -> Either String (AtBase "32z")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32z" -> ByteString -> AtBase "32z"
forall a b. a -> b -> a
const (AtBase "32z" -> ByteString -> AtBase "32z")
-> AtBase "32z" -> ByteString -> AtBase "32z"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32z"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32z"))
-> Either String ByteString -> Either String (AtBase "32z")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32z ByteString
bs

validBase32upper :: ByteString -> Maybe (AtBase "32u")
validBase32upper :: ByteString -> Maybe (AtBase "32u")
validBase32upper ByteString
bs = ByteString -> AtBase "32u"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32u" -> Maybe ByteString -> Maybe (AtBase "32u")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32upper ByteString
bs)

validBase32upperEither :: ByteString -> Either String (AtBase "32u")
validBase32upperEither :: ByteString -> Either String (AtBase "32u")
validBase32upperEither ByteString
bs = (ByteString -> AtBase "32u")
-> Either String ByteString -> Either String (AtBase "32u")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32u" -> ByteString -> AtBase "32u"
forall a b. a -> b -> a
const (AtBase "32u" -> ByteString -> AtBase "32u")
-> AtBase "32u" -> ByteString -> AtBase "32u"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32u"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32u"))
-> Either String ByteString -> Either String (AtBase "32u")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32upper ByteString
bs

validBase32pad :: ByteString -> Maybe (AtBase "32p")
validBase32pad :: ByteString -> Maybe (AtBase "32p")
validBase32pad ByteString
bs = ByteString -> AtBase "32p"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32p" -> Maybe ByteString -> Maybe (AtBase "32p")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32pad ByteString
bs)

validBase32padEither :: ByteString -> Either String (AtBase "32p")
validBase32padEither :: ByteString -> Either String (AtBase "32p")
validBase32padEither ByteString
bs = (ByteString -> AtBase "32p")
-> Either String ByteString -> Either String (AtBase "32p")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32p" -> ByteString -> AtBase "32p"
forall a b. a -> b -> a
const (AtBase "32p" -> ByteString -> AtBase "32p")
-> AtBase "32p" -> ByteString -> AtBase "32p"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32p"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32p"))
-> Either String ByteString -> Either String (AtBase "32p")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32pad ByteString
bs

validBase32padupper :: ByteString -> Maybe (AtBase "32pu")
validBase32padupper :: ByteString -> Maybe (AtBase "32pu")
validBase32padupper ByteString
bs = ByteString -> AtBase "32pu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "32pu" -> Maybe ByteString -> Maybe (AtBase "32pu")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase32padupper ByteString
bs)

validBase32padupperEither :: ByteString -> Either String (AtBase "32pu")
validBase32padupperEither :: ByteString -> Either String (AtBase "32pu")
validBase32padupperEither ByteString
bs = (ByteString -> AtBase "32pu")
-> Either String ByteString -> Either String (AtBase "32pu")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "32pu" -> ByteString -> AtBase "32pu"
forall a b. a -> b -> a
const (AtBase "32pu" -> ByteString -> AtBase "32pu")
-> AtBase "32pu" -> ByteString -> AtBase "32pu"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "32pu"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "32pu"))
-> Either String ByteString -> Either String (AtBase "32pu")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase32padupper ByteString
bs

validBase58btc :: ByteString -> Maybe (AtBase "58btc")
validBase58btc :: ByteString -> Maybe (AtBase "58btc")
validBase58btc ByteString
bs = ByteString -> AtBase "58btc"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "58btc" -> Maybe ByteString -> Maybe (AtBase "58btc")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase58btc ByteString
bs)

validBase58btcEither :: ByteString -> Either String (AtBase "58btc")
validBase58btcEither :: ByteString -> Either String (AtBase "58btc")
validBase58btcEither ByteString
bs = (ByteString -> AtBase "58btc")
-> Either String ByteString -> Either String (AtBase "58btc")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "58btc" -> ByteString -> AtBase "58btc"
forall a b. a -> b -> a
const (AtBase "58btc" -> ByteString -> AtBase "58btc")
-> AtBase "58btc" -> ByteString -> AtBase "58btc"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "58btc"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "58btc"))
-> Either String ByteString -> Either String (AtBase "58btc")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase58btc ByteString
bs

validBase58flickr :: ByteString -> Maybe (AtBase "58flickr")
validBase58flickr :: ByteString -> Maybe (AtBase "58flickr")
validBase58flickr ByteString
bs = ByteString -> AtBase "58flickr"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "58flickr" -> Maybe ByteString -> Maybe (AtBase "58flickr")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase58flickr ByteString
bs)

validBase58flickrEither :: ByteString -> Either String (AtBase "58flickr")
validBase58flickrEither :: ByteString -> Either String (AtBase "58flickr")
validBase58flickrEither ByteString
bs = (ByteString -> AtBase "58flickr")
-> Either String ByteString -> Either String (AtBase "58flickr")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "58flickr" -> ByteString -> AtBase "58flickr"
forall a b. a -> b -> a
const (AtBase "58flickr" -> ByteString -> AtBase "58flickr")
-> AtBase "58flickr" -> ByteString -> AtBase "58flickr"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "58flickr"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "58flickr"))
-> Either String ByteString -> Either String (AtBase "58flickr")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase58flickr ByteString
bs

validBase64 :: ByteString -> Maybe (AtBase "64")
validBase64 :: ByteString -> Maybe (AtBase "64")
validBase64 ByteString
bs = ByteString -> AtBase "64"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "64" -> Maybe ByteString -> Maybe (AtBase "64")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Maybe ByteString
decodeBase64 ByteString
bs

validBase64Either :: ByteString -> Either String (AtBase "64")
validBase64Either :: ByteString -> Either String (AtBase "64")
validBase64Either ByteString
bs = (ByteString -> AtBase "64")
-> Either String ByteString -> Either String (AtBase "64")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "64" -> ByteString -> AtBase "64"
forall a b. a -> b -> a
const (AtBase "64" -> ByteString -> AtBase "64")
-> AtBase "64" -> ByteString -> AtBase "64"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "64"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "64"))
-> Either String ByteString -> Either String (AtBase "64")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase64Either ByteString
bs

validBase64pad :: ByteString -> Maybe (AtBase "64p")
validBase64pad :: ByteString -> Maybe (AtBase "64p")
validBase64pad ByteString
bs = ByteString -> AtBase "64p"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "64p" -> Maybe ByteString -> Maybe (AtBase "64p")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase64pad ByteString
bs)

validBase64padEither :: ByteString -> Either String (AtBase "64p")
validBase64padEither :: ByteString -> Either String (AtBase "64p")
validBase64padEither ByteString
bs = (ByteString -> AtBase "64p")
-> Either String ByteString -> Either String (AtBase "64p")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "64p" -> ByteString -> AtBase "64p"
forall a b. a -> b -> a
const (AtBase "64p" -> ByteString -> AtBase "64p")
-> AtBase "64p" -> ByteString -> AtBase "64p"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "64p"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "64p"))
-> Either String ByteString -> Either String (AtBase "64p")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase64pad ByteString
bs

validBase64url :: ByteString -> Maybe (AtBase "64url")
validBase64url :: ByteString -> Maybe (AtBase "64url")
validBase64url ByteString
bs = ByteString -> AtBase "64url"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "64url" -> Maybe ByteString -> Maybe (AtBase "64url")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase64url ByteString
bs)

validBase64urlEither :: ByteString -> Either String (AtBase "64url")
validBase64urlEither :: ByteString -> Either String (AtBase "64url")
validBase64urlEither ByteString
bs = (ByteString -> AtBase "64url")
-> Either String ByteString -> Either String (AtBase "64url")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "64url" -> ByteString -> AtBase "64url"
forall a b. a -> b -> a
const (AtBase "64url" -> ByteString -> AtBase "64url")
-> AtBase "64url" -> ByteString -> AtBase "64url"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "64url"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "64url"))
-> Either String ByteString -> Either String (AtBase "64url")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase64url ByteString
bs

validBase64urlpad :: ByteString -> Maybe (AtBase "64urlpad")
validBase64urlpad :: ByteString -> Maybe (AtBase "64urlpad")
validBase64urlpad ByteString
bs = ByteString -> AtBase "64urlpad"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs AtBase "64urlpad" -> Maybe ByteString -> Maybe (AtBase "64urlpad")
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Either String ByteString -> Maybe ByteString
forall a b. Either a b -> Maybe b
hush (ByteString -> Either String ByteString
decodeBase64urlpad ByteString
bs)

validBase64urlpadEither :: ByteString -> Either String (AtBase "64urlpad")
validBase64urlpadEither :: ByteString -> Either String (AtBase "64urlpad")
validBase64urlpadEither ByteString
bs = (ByteString -> AtBase "64urlpad")
-> Either String ByteString -> Either String (AtBase "64urlpad")
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (AtBase "64urlpad" -> ByteString -> AtBase "64urlpad"
forall a b. a -> b -> a
const (AtBase "64urlpad" -> ByteString -> AtBase "64urlpad")
-> AtBase "64urlpad" -> ByteString -> AtBase "64urlpad"
forall a b. (a -> b) -> a -> b
$ ByteString -> AtBase "64urlpad"
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs) (Either String ByteString -> Either String (AtBase "64urlpad"))
-> Either String ByteString -> Either String (AtBase "64urlpad")
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
decodeBase64urlpad ByteString
bs

class KnownSymbol b => ValidBase (b :: Symbol) where
    validAtBase       :: proxy b -> ByteString -> Maybe (AtBase b)
    validAtBaseEither :: proxy b -> ByteString -> Either String (AtBase b)

instance ValidBase "id" where
    validAtBase :: proxy "id" -> ByteString -> Maybe (AtBase "id")
validAtBase       = (ByteString -> Maybe (AtBase "id"))
-> proxy "id" -> ByteString -> Maybe (AtBase "id")
forall a b. a -> b -> a
const (AtBase "id" -> Maybe (AtBase "id")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtBase "id" -> Maybe (AtBase "id"))
-> (ByteString -> AtBase "id") -> ByteString -> Maybe (AtBase "id")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AtBase "id"
forall (b :: Symbol). ByteString -> AtBase b
BaseN)
    validAtBaseEither :: proxy "id" -> ByteString -> Either String (AtBase "id")
validAtBaseEither = (ByteString -> Either String (AtBase "id"))
-> proxy "id" -> ByteString -> Either String (AtBase "id")
forall a b. a -> b -> a
const (AtBase "id" -> Either String (AtBase "id")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtBase "id" -> Either String (AtBase "id"))
-> (ByteString -> AtBase "id")
-> ByteString
-> Either String (AtBase "id")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AtBase "id"
forall (b :: Symbol). ByteString -> AtBase b
BaseN)
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "2" where
    validAtBase :: proxy "2" -> ByteString -> Maybe (AtBase "2")
validAtBase       = (ByteString -> Maybe (AtBase "2"))
-> proxy "2" -> ByteString -> Maybe (AtBase "2")
forall a b. a -> b -> a
const (AtBase "2" -> Maybe (AtBase "2")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtBase "2" -> Maybe (AtBase "2"))
-> (ByteString -> AtBase "2") -> ByteString -> Maybe (AtBase "2")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AtBase "2"
forall (b :: Symbol). ByteString -> AtBase b
BaseN)
    validAtBaseEither :: proxy "2" -> ByteString -> Either String (AtBase "2")
validAtBaseEither = (ByteString -> Either String (AtBase "2"))
-> proxy "2" -> ByteString -> Either String (AtBase "2")
forall a b. a -> b -> a
const (AtBase "2" -> Either String (AtBase "2")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtBase "2" -> Either String (AtBase "2"))
-> (ByteString -> AtBase "2")
-> ByteString
-> Either String (AtBase "2")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AtBase "2"
forall (b :: Symbol). ByteString -> AtBase b
BaseN)
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "16" where
    validAtBase :: proxy "16" -> ByteString -> Maybe (AtBase "16")
validAtBase       = (ByteString -> Maybe (AtBase "16"))
-> proxy "16" -> ByteString -> Maybe (AtBase "16")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "16")
validBase16
    validAtBaseEither :: proxy "16" -> ByteString -> Either String (AtBase "16")
validAtBaseEither = (ByteString -> Either String (AtBase "16"))
-> proxy "16" -> ByteString -> Either String (AtBase "16")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "16")
validBase16Either
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "16u" where
    validAtBase :: proxy "16u" -> ByteString -> Maybe (AtBase "16u")
validAtBase       = (ByteString -> Maybe (AtBase "16u"))
-> proxy "16u" -> ByteString -> Maybe (AtBase "16u")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "16u")
validBase16upper
    validAtBaseEither :: proxy "16u" -> ByteString -> Either String (AtBase "16u")
validAtBaseEither = (ByteString -> Either String (AtBase "16u"))
-> proxy "16u" -> ByteString -> Either String (AtBase "16u")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "16u")
validBase16upperEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32x" where
    validAtBase :: proxy "32x" -> ByteString -> Maybe (AtBase "32x")
validAtBase       = (ByteString -> Maybe (AtBase "32x"))
-> proxy "32x" -> ByteString -> Maybe (AtBase "32x")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32x")
validBase32hex
    validAtBaseEither :: proxy "32x" -> ByteString -> Either String (AtBase "32x")
validAtBaseEither = (ByteString -> Either String (AtBase "32x"))
-> proxy "32x" -> ByteString -> Either String (AtBase "32x")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32x")
validBase32hexEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32xu" where
    validAtBase :: proxy "32xu" -> ByteString -> Maybe (AtBase "32xu")
validAtBase       = (ByteString -> Maybe (AtBase "32xu"))
-> proxy "32xu" -> ByteString -> Maybe (AtBase "32xu")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32xu")
validBase32hexupper
    validAtBaseEither :: proxy "32xu" -> ByteString -> Either String (AtBase "32xu")
validAtBaseEither = (ByteString -> Either String (AtBase "32xu"))
-> proxy "32xu" -> ByteString -> Either String (AtBase "32xu")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32xu")
validBase32hexupperEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32xp" where
    validAtBase :: proxy "32xp" -> ByteString -> Maybe (AtBase "32xp")
validAtBase       = (ByteString -> Maybe (AtBase "32xp"))
-> proxy "32xp" -> ByteString -> Maybe (AtBase "32xp")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32xp")
validBase32hexpad
    validAtBaseEither :: proxy "32xp" -> ByteString -> Either String (AtBase "32xp")
validAtBaseEither = (ByteString -> Either String (AtBase "32xp"))
-> proxy "32xp" -> ByteString -> Either String (AtBase "32xp")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32xp")
validBase32hexpadEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32xpu" where
    validAtBase :: proxy "32xpu" -> ByteString -> Maybe (AtBase "32xpu")
validAtBase       = (ByteString -> Maybe (AtBase "32xpu"))
-> proxy "32xpu" -> ByteString -> Maybe (AtBase "32xpu")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32xpu")
validBase32hexpadupper
    validAtBaseEither :: proxy "32xpu" -> ByteString -> Either String (AtBase "32xpu")
validAtBaseEither = (ByteString -> Either String (AtBase "32xpu"))
-> proxy "32xpu" -> ByteString -> Either String (AtBase "32xpu")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32xpu")
validBase32hexpadupperEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32" where
    validAtBase :: proxy "32" -> ByteString -> Maybe (AtBase "32")
validAtBase       = (ByteString -> Maybe (AtBase "32"))
-> proxy "32" -> ByteString -> Maybe (AtBase "32")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32")
validBase32
    validAtBaseEither :: proxy "32" -> ByteString -> Either String (AtBase "32")
validAtBaseEither = (ByteString -> Either String (AtBase "32"))
-> proxy "32" -> ByteString -> Either String (AtBase "32")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32")
validBase32Either
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32z" where
    validAtBase :: proxy "32z" -> ByteString -> Maybe (AtBase "32z")
validAtBase       = (ByteString -> Maybe (AtBase "32z"))
-> proxy "32z" -> ByteString -> Maybe (AtBase "32z")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32z")
validBase32z
    validAtBaseEither :: proxy "32z" -> ByteString -> Either String (AtBase "32z")
validAtBaseEither = (ByteString -> Either String (AtBase "32z"))
-> proxy "32z" -> ByteString -> Either String (AtBase "32z")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32z")
validBase32zEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32u" where
    validAtBase :: proxy "32u" -> ByteString -> Maybe (AtBase "32u")
validAtBase       = (ByteString -> Maybe (AtBase "32u"))
-> proxy "32u" -> ByteString -> Maybe (AtBase "32u")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32u")
validBase32upper
    validAtBaseEither :: proxy "32u" -> ByteString -> Either String (AtBase "32u")
validAtBaseEither = (ByteString -> Either String (AtBase "32u"))
-> proxy "32u" -> ByteString -> Either String (AtBase "32u")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32u")
validBase32upperEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32p" where
    validAtBase :: proxy "32p" -> ByteString -> Maybe (AtBase "32p")
validAtBase       = (ByteString -> Maybe (AtBase "32p"))
-> proxy "32p" -> ByteString -> Maybe (AtBase "32p")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32p")
validBase32pad
    validAtBaseEither :: proxy "32p" -> ByteString -> Either String (AtBase "32p")
validAtBaseEither = (ByteString -> Either String (AtBase "32p"))
-> proxy "32p" -> ByteString -> Either String (AtBase "32p")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32p")
validBase32padEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "32pu" where
    validAtBase :: proxy "32pu" -> ByteString -> Maybe (AtBase "32pu")
validAtBase       = (ByteString -> Maybe (AtBase "32pu"))
-> proxy "32pu" -> ByteString -> Maybe (AtBase "32pu")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "32pu")
validBase32padupper
    validAtBaseEither :: proxy "32pu" -> ByteString -> Either String (AtBase "32pu")
validAtBaseEither = (ByteString -> Either String (AtBase "32pu"))
-> proxy "32pu" -> ByteString -> Either String (AtBase "32pu")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "32pu")
validBase32padupperEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "58btc" where
    validAtBase :: proxy "58btc" -> ByteString -> Maybe (AtBase "58btc")
validAtBase       = (ByteString -> Maybe (AtBase "58btc"))
-> proxy "58btc" -> ByteString -> Maybe (AtBase "58btc")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "58btc")
validBase58btc
    validAtBaseEither :: proxy "58btc" -> ByteString -> Either String (AtBase "58btc")
validAtBaseEither = (ByteString -> Either String (AtBase "58btc"))
-> proxy "58btc" -> ByteString -> Either String (AtBase "58btc")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "58btc")
validBase58btcEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "58flickr" where
    validAtBase :: proxy "58flickr" -> ByteString -> Maybe (AtBase "58flickr")
validAtBase       = (ByteString -> Maybe (AtBase "58flickr"))
-> proxy "58flickr" -> ByteString -> Maybe (AtBase "58flickr")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "58flickr")
validBase58flickr
    validAtBaseEither :: proxy "58flickr" -> ByteString -> Either String (AtBase "58flickr")
validAtBaseEither = (ByteString -> Either String (AtBase "58flickr"))
-> proxy "58flickr"
-> ByteString
-> Either String (AtBase "58flickr")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "58flickr")
validBase58flickrEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "64" where
    validAtBase :: proxy "64" -> ByteString -> Maybe (AtBase "64")
validAtBase       = (ByteString -> Maybe (AtBase "64"))
-> proxy "64" -> ByteString -> Maybe (AtBase "64")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "64")
validBase64
    validAtBaseEither :: proxy "64" -> ByteString -> Either String (AtBase "64")
validAtBaseEither = (ByteString -> Either String (AtBase "64"))
-> proxy "64" -> ByteString -> Either String (AtBase "64")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "64")
validBase64Either
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "64p" where
    validAtBase :: proxy "64p" -> ByteString -> Maybe (AtBase "64p")
validAtBase       = (ByteString -> Maybe (AtBase "64p"))
-> proxy "64p" -> ByteString -> Maybe (AtBase "64p")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "64p")
validBase64pad
    validAtBaseEither :: proxy "64p" -> ByteString -> Either String (AtBase "64p")
validAtBaseEither = (ByteString -> Either String (AtBase "64p"))
-> proxy "64p" -> ByteString -> Either String (AtBase "64p")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "64p")
validBase64padEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "64url" where
    validAtBase :: proxy "64url" -> ByteString -> Maybe (AtBase "64url")
validAtBase       = (ByteString -> Maybe (AtBase "64url"))
-> proxy "64url" -> ByteString -> Maybe (AtBase "64url")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "64url")
validBase64url
    validAtBaseEither :: proxy "64url" -> ByteString -> Either String (AtBase "64url")
validAtBaseEither = (ByteString -> Either String (AtBase "64url"))
-> proxy "64url" -> ByteString -> Either String (AtBase "64url")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "64url")
validBase64urlEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

instance ValidBase "64urlpad" where
    validAtBase :: proxy "64urlpad" -> ByteString -> Maybe (AtBase "64urlpad")
validAtBase       = (ByteString -> Maybe (AtBase "64urlpad"))
-> proxy "64urlpad" -> ByteString -> Maybe (AtBase "64urlpad")
forall a b. a -> b -> a
const ByteString -> Maybe (AtBase "64urlpad")
validBase64urlpad
    validAtBaseEither :: proxy "64urlpad" -> ByteString -> Either String (AtBase "64urlpad")
validAtBaseEither = (ByteString -> Either String (AtBase "64urlpad"))
-> proxy "64urlpad"
-> ByteString
-> Either String (AtBase "64urlpad")
forall a b. a -> b -> a
const ByteString -> Either String (AtBase "64urlpad")
validBase64urlpadEither
    {-# INLINE validAtBase       #-}
    {-# INLINE validAtBaseEither #-}

-- | Like 'validAtBase', but also return the decoded 'ByteString'.
validAndDecoded
    :: DecodeBase b
    => proxy b
    -> ByteString
    -> Maybe (AtBase b, ByteString)
validAndDecoded :: proxy b -> ByteString -> Maybe (AtBase b, ByteString)
validAndDecoded proxy b
at ByteString
bs = (ByteString -> AtBase b
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs,) (ByteString -> (AtBase b, ByteString))
-> Maybe ByteString -> Maybe (AtBase b, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> proxy b -> ByteString -> Maybe ByteString
forall (b :: Symbol) (proxy :: Symbol -> *).
DecodeBase b =>
proxy b -> ByteString -> Maybe ByteString
decodeAtBase proxy b
at ByteString
bs

-- | Like 'validAtBaseEither', but also return the decoded 'ByteString'.
validAndDecodedEither
    :: DecodeBase b
    => proxy b
    -> ByteString
    -> Either String (AtBase b, ByteString)
validAndDecodedEither :: proxy b -> ByteString -> Either String (AtBase b, ByteString)
validAndDecodedEither proxy b
at ByteString
bs = (ByteString -> AtBase b
forall (b :: Symbol). ByteString -> AtBase b
BaseN ByteString
bs,) (ByteString -> (AtBase b, ByteString))
-> Either String ByteString -> Either String (AtBase b, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> proxy b -> ByteString -> Either String ByteString
forall (b :: Symbol) (proxy :: Symbol -> *).
DecodeBase b =>
proxy b -> ByteString -> Either String ByteString
decodeAtBaseEither proxy b
at ByteString
bs

-- Text ------------------------------------------------------------------------

-- | Like 'encodeAtBase', but from a 'Text' value.
encodedTextAtBase :: Base b -> Text -> AtBase b
encodedTextAtBase :: Base b -> Text -> AtBase b
encodedTextAtBase Base b
b = Base b -> ByteString -> AtBase b
forall (b :: Symbol). Base b -> ByteString -> AtBase b
encodeAtBase Base b
b (ByteString -> AtBase b)
-> (Text -> ByteString) -> Text -> AtBase b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
{-# INLINE encodedTextAtBase #-}

-- | Like 'encodedBytes', but returns a 'Text' value.
encodedText :: AtBase b -> Text
encodedText :: AtBase b -> Text
encodedText (BaseN ByteString
bs) = ByteString -> Text
decodeLatin1 ByteString
bs
{-# INLINE encodedText #-}

-- | Like 'encodedBuilder', but returns a text 'T.Builder'.
encodedTextBuilder :: AtBase b -> T.Builder
encodedTextBuilder :: AtBase b -> Builder
encodedTextBuilder = Text -> Builder
T.fromText (Text -> Builder) -> (AtBase b -> Text) -> AtBase b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AtBase b -> Text
forall (b :: Symbol). AtBase b -> Text
encodedText
{-# INLINE encodedTextBuilder #-}

-- Formatting ------------------------------------------------------------------

-- | Format a base-n encoded value.
format, formatAtBase :: Formatting.Format r (AtBase b -> r)
format :: Format r (AtBase b -> r)
format = (AtBase b -> Builder) -> Format r (AtBase b -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
Formatting.later AtBase b -> Builder
forall (b :: Symbol). AtBase b -> Builder
encodedTextBuilder

formatAtBase :: Format r (AtBase b -> r)
formatAtBase = Format r (AtBase b -> r)
forall r (b :: Symbol). Format r (AtBase b -> r)
format
{-# INLINE formatAtBase #-}

-- Helpers ---------------------------------------------------------------------

dropPadding :: ByteString -> ByteString
dropPadding :: ByteString -> ByteString
dropPadding = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.spanEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')
{-# INLINE dropPadding #-}

padTo :: Int -> ByteString -> ByteString
padTo :: Int -> ByteString -> ByteString
padTo Int
multipleof ByteString
bs =
    case ByteString -> Int
C8.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
multipleof of
        Int
0 -> ByteString
bs
        Int
x -> ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend ByteString
bs (Int -> Char -> ByteString
C8.replicate (Int
multipleof Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) Char
'=')

note :: a -> Maybe b -> Either a b
note :: a -> Maybe b -> Either a b
note a
a = Either a b -> (b -> Either a b) -> Maybe b -> Either a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a b
forall a b. a -> Either a b
Left a
a) b -> Either a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

hush :: Either a b -> Maybe b
hush :: Either a b -> Maybe b
hush = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just