Hécate
41e999ed99
This commit brings in an HLint configuration file and several recommended modifications such as: * End-of-line extra spaces removal; * Import lines ordering; * Redundant $ removal; * Generalisation of ++ and map to <> and fmap; * Preferring `pure` over `return`; * Removing extraenous extensions. And finally, a `stylish-haskell` helper script that detects if code files are dirty. Can be useful for CI, although manually calling it can be nice if you would rather first implement then beautify.
51 lines
1.8 KiB
Haskell
51 lines
1.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import qualified Data.ASN1.BinaryEncoding as ASN1
|
|
import qualified Data.ASN1.Encoding as ASN1
|
|
import qualified Data.ASN1.Error as ASN1
|
|
import qualified Data.ASN1.Parse as ASN1P
|
|
import qualified Data.ASN1.Types as ASN1
|
|
import qualified Data.ByteString as BS
|
|
import Data.Maybe (fromMaybe)
|
|
import Debug.Trace (trace)
|
|
|
|
-- import Hash2Pub.Fedichord
|
|
|
|
-- encoding values as ASN.1 types is done using Data.ASN1.Prim
|
|
someASN1 :: [ASN1.ASN1]
|
|
someASN1 = ASN1.Start ASN1.Sequence : ASN1.ASN1String (ASN1.asn1CharacterString ASN1.Visible domain) : ASN1.ASN1String (ASN1.asn1CharacterString ASN1.UTF8 unicode) : fmap ASN1.IntVal xs <> [ASN1.End ASN1.Sequence]
|
|
where
|
|
domain = "domains.are.ascii.on.ly"
|
|
unicode = "Hähä, but unicode string!"
|
|
xs = [ 23, 42, 2342 ]
|
|
|
|
asn1AsDer :: [ASN1.ASN1] -> BS.ByteString
|
|
asn1AsDer = ASN1.encodeASN1' ASN1.DER
|
|
|
|
derToAsn1 :: BS.ByteString -> Either ASN1.ASN1Error [ASN1.ASN1]
|
|
derToAsn1 = ASN1.decodeASN1' ASN1.DER
|
|
|
|
getUnicodeField :: [ASN1.ASN1] -> String
|
|
getUnicodeField (ASN1.Start ASN1.Sequence : _ : ASN1.ASN1String strASN1 : _) = fromMaybe "" $ ASN1.asn1CharacterToString strASN1
|
|
|
|
testParser :: ASN1P.ParseASN1 String
|
|
testParser = do
|
|
foo <- ASN1P.onNextContainer ASN1.Sequence getAll
|
|
pure $ show foo
|
|
|
|
getAll :: ASN1P.ParseASN1 [ASN1.ASN1]
|
|
getAll = ASN1P.getMany ASN1P.getNext
|
|
|
|
--stringParser asn1obj =
|
|
-- fmap (fromMaybe "" $ ASN1.asn1CharacterToString) ASN1P.getNext
|
|
|
|
main = do
|
|
print someASN1
|
|
print $ asn1AsDer someASN1
|
|
print $ derToAsn1 . asn1AsDer $ someASN1
|
|
putStrLn $ getUnicodeField someASN1
|
|
print $ ASN1.decodeASN1Repr' ASN1.DER $ asn1AsDer someASN1
|
|
putStrLn "\nLet's try a real parser combinator:"
|
|
print $ ASN1P.runParseASN1State testParser someASN1
|