45 lines
1.4 KiB
Plaintext
45 lines
1.4 KiB
Plaintext
|
module App.Validation.Token where
|
||
|
|
||
|
import Prelude
|
||
|
|
||
|
import Control.Alt ((<|>))
|
||
|
import Data.Either (Either(..))
|
||
|
import Data.String.CodeUnits as CU
|
||
|
import Data.Maybe (Maybe(..))
|
||
|
import Data.Validation.Semigroup (V, invalid, toEither)
|
||
|
|
||
|
import GenericParser.RFC5234 (vchar)
|
||
|
import GenericParser.SomeParsers as SomeParsers
|
||
|
import GenericParser.Parser as G
|
||
|
|
||
|
data TokenParsingError
|
||
|
= CannotParse
|
||
|
| CannotEntirelyParse
|
||
|
| Size Int Int Int
|
||
|
|
||
|
data Error
|
||
|
= ParsingError (G.Error TokenParsingError)
|
||
|
|
||
|
-- | TODO: this number should be exactly the size of the provided token.
|
||
|
min_token_size :: Int
|
||
|
min_token_size = 20
|
||
|
max_token_size :: Int
|
||
|
max_token_size = 60
|
||
|
|
||
|
parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
|
||
|
parse (G.Parser p) str c = case p { string: str, position: 0 } of
|
||
|
Left x -> invalid $ [c x]
|
||
|
Right x -> pure x.result
|
||
|
|
||
|
token_parser :: G.Parser TokenParsingError String
|
||
|
token_parser = do
|
||
|
l <- G.many1 vchar <|> G.Parser \i -> G.failureError i.position (Just CannotParse)
|
||
|
_ <- SomeParsers.eof <|> G.Parser \i -> G.failureError i.position (Just CannotEntirelyParse)
|
||
|
pos <- G.current_position
|
||
|
if pos < min_token_size || pos > max_token_size
|
||
|
then G.Parser \i -> G.failureError i.position (Just $ Size min_token_size max_token_size pos)
|
||
|
else pure $ CU.fromCharArray l
|
||
|
|
||
|
token :: String -> Either (Array Error) String
|
||
|
token s = toEither $ parse token_parser s ParsingError
|