Create a Public/Private Key from a PEM Base64Encode string in Haskell - haskell

I'm trying to use RSA from cryptonite package to handle encryption and try to create an X509 cert (Data.X509) from a pem encoded cert base64Encoded string so i can access the Public and Private Key. However, i kept getting a "StreamConstructionWrongSize" error. I think i'm missing something here when reading the base64Encoded string in. I included the snippet of the codes. Perhaps, someone can spot the mistake. I'd really appreciate any help.
import Data.String.Conversions (cs)
import Crypto.Hash (hash, SHA256(..), Digest)
import Data.ByteString (ByteString)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.IO as TIO
import System.IO (hFlush, stdout)
import Data.ByteArray.Encoding (convertToBase, Base (Base64))
import Data.X509
main :: IO ()
main = do
let certBS = encodeUtf8 "MIIFXjCCBEagAwIBAgIIKPOmOJqfnTIwDQYJKoZIhvcNAQELBQAwgbQxCzAJBgNVBAYTAlVTMRAwDgYDVQQIEwdBcml6b25hMRMwEQYDVQQHEwpTY290dHNkYWxlMRowGAYDVQQKExFHb0RhZGR5LmNvbSwgSW5jLjEtMCsGA1UECxMkaHR0cDovL2NlcnRzLmdvZGFkZHkuY29tL3JlcG9zaXRvcnkvMTMwMQYDVQQDEypHbyBEYWRkeSBTZWN1cmUgQ2VydGlmaWNhdGUgQXV0aG9yaXR5IC0gRzIwHhcNMTYwMjA5MjE1NzM5WhcNMTkwMzA3MjIzNTUxWjBrMQswCQYDVQQGEwJVUzENMAsGA1UECBMEVXRhaDEVMBMGA1UEBxMMU291dGggSm9yZGFuMRcwFQYDVQQKEw5BbGxlZ2lhbmNlIEluYzEdMBsGA1UEAwwUKi5hbGxlZ2lhbmNldGVjaC5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDHWaH6ziZnWy3Uy/wmM7zbHqrg/AmdsWk54x6wpe7+B2USbTbZg56rGjEL/I1Pe/PtcbM8uiPq1TshMxwePqWFCqKfJrj6/RS9/gKpWOwfh+Z2Qk78L3DQH97njDLJAYBf68MX0eKhM0PGBo+1BqKfAb9C3hEltROuABPEBO7GMFecZaDtZ6lDkYBidRs7nOqQnU91X8ly376U0dAEnTghVmDSh5v8yKvMm0AhOd8S7EulfXEg+cj6Y996pM56bDbv2H7NZNv7QD38FY2IQWTWT46z0riF/D93ilVF62cvNXtUwj2kx581Z/e4eB7+Q3cLFFG1KGLgnvDKIguuxK5LAgMBAAGjggG6MIIBtjAMBgNVHRMBAf8EAjAAMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAOBgNVHQ8BAf8EBAMCBaAwNQYDVR0fBC4wLDAqoCigJoYkaHR0cDovL2NybC5nb2RhZGR5LmNvbS9nZGlnMnMyLTIuY3JsMFMGA1UdIARMMEowSAYLYIZIAYb9bQEHFwIwOTA3BggrBgEFBQcCARYraHR0cDovL2NlcnRpZmljYXRlcy5nb2RhZGR5LmNvbS9yZXBvc2l0b3J5LzB2BggrBgEFBQcBAQRqMGgwJAYIKwYBBQUHMAGGGGh0dHA6Ly9vY3NwLmdvZGFkZHkuY29tLzBABggrBgEFBQcwAoY0aHR0cDovL2NlcnRpZmljYXRlcy5nb2RhZGR5LmNvbS9yZXBvc2l0b3J5L2dkaWcyLmNydDAfBgNVHSMEGDAWgBRAwr0njsw0gzCiM9f7bLPwtCyAzjAzBgNVHREELDAqghQqLmFsbGVnaWFuY2V0ZWNoLmNvbYISYWxsZWdpYW5jZXRlY2guY29tMB0GA1UdDgQWBBSFAVaoKHe4qj41Axk07GZrLVx38zANBgkqhkiG9w0BAQsFAAOCAQEApsEOT1kL51QIQbpQjkamjQ1y+HoEMXd7npM1YMfaLxL+v4b6qShMamtNUWac+aJ5ul8849UBhPj3nNfLz6PJtdFmztKOHs58Th8lz6ksSDt1z/GRi3/EcWR7beBuDD2AKFGnckcSkCls+lOBSh/BxAIKPdlD3wzUEpqLuD1scucRfcjwt6X0K3otthMJ9PZ9tJQMSOLnUFKLvG+ZFlnkY+K3pmKWsk2ZMrua2m9wvqVXq4ZgEKQ6xr91HYkPCjfLt14ExnL3vNdXS0DR7LtjJDyXJeFkT0Ev81W9c5dk7gzbwg+EM4UYxW6qz+7WyHvV+uLNnHNmwm1b17tVfYvu3w=="
cert = decodeSignedCertificate certBS
case cert of
Left st -> putStrLn $ "Error reading cert: " ++ st
Right scrt -> do
let crt = getCertificate scrt
putStrLn $ show crt

Updated: I found the solution to my question. Hope this helps other who has the same problem
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.String.Conversions (cs)
import Crypto.Hash (hash, SHA256(..), Digest)
import qualified Data.ByteString as BS (ByteString, readFile)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.IO as TIO
import System.IO (hFlush, stdout)
import Data.ByteArray.Encoding (convertToBase, Base (Base64))
import Data.List (head)
import Data.Text (Text(..))
----- Read file import
import Data.Monoid ((<>))
import Control.Applicative
import Data.ASN1.Types
import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.Maybe
import qualified Data.X509 as X509
import Data.X509.Memory (pemToKey)
import Data.PEM (pemParseLBS, pemParseBS, pemWriteBS, pemContent, pemName, PEM)
import qualified Data.ByteString.Lazy as L
-------------------------
main :: IO ()
main = do
--pems <- readPEMs "./certs/test.pem" -- read from file
let cert1 = "-----BEGIN CERTIFICATE-----\n" ++ "MIIFXjCCBEagAwIBAgIIKPOmOJqfnTIwDQYJKoZIhvcNAQELBQAwgbQxCzAJBgNVBAYTAlVTMRAwDgYDVQQIEwdBcml6b25hMRMwEQYDVQQHEwpTY290dHNkYWxlMRowGAYDVQQKExFHb0RhZGR5LmNvbSwgSW5jLjEtMCsGA1UECxMkaHR0cDovL2NlcnRzLmdvZGFkZHkuY29tL3JlcG9zaXRvcnkvMTMwMQYDVQQDEypHbyBEYWRkeSBTZWN1cmUgQ2VydGlmaWNhdGUgQXV0aG9yaXR5IC0gRzIwHhcNMTYwMjA5MjE1NzM5WhcNMTkwMzA3MjIzNTUxWjBrMQswCQYDVQQGEwJVUzENMAsGA1UECBMEVXRhaDEVMBMGA1UEBxMMU291dGggSm9yZGFuMRcwFQYDVQQKEw5BbGxlZ2lhbmNlIEluYzEdMBsGA1UEAwwUKi5hbGxlZ2lhbmNldGVjaC5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDHWaH6ziZnWy3Uy/wmM7zbHqrg/AmdsWk54x6wpe7+B2USbTbZg56rGjEL/I1Pe/PtcbM8uiPq1TshMxwePqWFCqKfJrj6/RS9/gKpWOwfh+Z2Qk78L3DQH97njDLJAYBf68MX0eKhM0PGBo+1BqKfAb9C3hEltROuABPEBO7GMFecZaDtZ6lDkYBidRs7nOqQnU91X8ly376U0dAEnTghVmDSh5v8yKvMm0AhOd8S7EulfXEg+cj6Y996pM56bDbv2H7NZNv7QD38FY2IQWTWT46z0riF/D93ilVF62cvNXtUwj2kx581Z/e4eB7+Q3cLFFG1KGLgnvDKIguuxK5LAgMBAAGjggG6MIIBtjAMBgNVHRMBAf8EAjAAMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAOBgNVHQ8BAf8EBAMCBaAwNQYDVR0fBC4wLDAqoCigJoYkaHR0cDovL2NybC5nb2RhZGR5LmNvbS9nZGlnMnMyLTIuY3JsMFMGA1UdIARMMEowSAYLYIZIAYb9bQEHFwIwOTA3BggrBgEFBQcCARYraHR0cDovL2NlcnRpZmljYXRlcy5nb2RhZGR5LmNvbS9yZXBvc2l0b3J5LzB2BggrBgEFBQcBAQRqMGgwJAYIKwYBBQUHMAGGGGh0dHA6Ly9vY3NwLmdvZGFkZHkuY29tLzBABggrBgEFBQcwAoY0aHR0cDovL2NlcnRpZmljYXRlcy5nb2RhZGR5LmNvbS9yZXBvc2l0b3J5L2dkaWcyLmNydDAfBgNVHSMEGDAWgBRAwr0njsw0gzCiM9f7bLPwtCyAzjAzBgNVHREELDAqghQqLmFsbGVnaWFuY2V0ZWNoLmNvbYISYWxsZWdpYW5jZXRlY2guY29tMB0GA1UdDgQWBBSFAVaoKHe4qj41Axk07GZrLVx38zANBgkqhkiG9w0BAQsFAAOCAQEApsEOT1kL51QIQbpQjkamjQ1y+HoEMXd7npM1YMfaLxL+v4b6qShMamtNUWac+aJ5ul8849UBhPj3nNfLz6PJtdFmztKOHs58Th8lz6ksSDt1z/GRi3/EcWR7beBuDD2AKFGnckcSkCls+lOBSh/BxAIKPdlD3wzUEpqLuD1scucRfcjwt6X0K3otthMJ9PZ9tJQMSOLnUFKLvG+ZFlnkY+K3pmKWsk2ZMrua2m9wvqVXq4ZgEKQ6xr91HYkPCjfLt14ExnL3vNdXS0DR7LtjJDyXJeFkT0Ev81W9c5dk7gzbwg+EM4UYxW6qz+7WyHvV+uLNnHNmwm1b17tVfYvu3w==" ++ "\n-----END CERTIFICATE-----"
pems <- readPEM cert1
let certx = X509.decodeSignedObject $ pemContent $ head pems
case certx of
Left st1 -> putStrLn $ "Error reading cert: " ++ st1
Right scrt1 -> do
let crt1 = X509.getCertificate scrt1
print crt1
readPEM :: String -> IO [PEM]
readPEM content = --do
return $ either error id $ pemParseBS $ cs content
readPEMs :: FilePath -> IO [PEM]
readPEMs filepath = do
content <- BS.readFile filepath
return $ either error id $ pemParseBS content

Related

How can I process citations using Pandoc's Citeproc, in Haskell?

Starting with "A Simple Example" from the Pandoc documentation, I want to add citation processing functionality. The docs for Text.Pandoc.Citeproc show a function processCitations which supposedly processes citations. Yet given simple org-mode input, and a citation [#test2022], it doesn't seem to work. It compiles and runs just fine, but the output of the code below is: <p><span class="spurious-link" target="url"><em>testing</em></span> [#test2022]</p>, i.e., the citation isn't actually processed. What am I doing wrong? And how can I get this to process my citation?
import Text.Pandoc
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Text.Pandoc.Filter
import Text.Pandoc.Citeproc
main :: IO ()
main = do
result <- runIO $ do
doc <- readOrg def (T.pack "#+bibliography: test.bib\n [[url][testing]]\n[#test2022]")
processed <- processCitations doc
writeHtml5String def processed
html <- handleError result
TIO.putStrLn html
For reference, here's my test.bib bibtex file:
#Book{test2022,
author = {Barus, Foobius},
title = {The Very Persistent Foo or Bar},
publisher = {Foobar Publications, Inc},
year = {2022}
}
I figured this out myself, eventually. Turns out you have to set some extensions, and some options, and set the metadata for the document:
{-# LANGUAGE OverloadedStrings #-}
import Text.Pandoc
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Text.Pandoc.Filter
import Text.Pandoc.Citeproc
import qualified Data.Map as M
import Text.Pandoc.Builder (setMeta)
main :: IO ()
main = do
let exts = extensionsFromList [ Ext_citations ]
let readerOptions = def{ readerExtensions = exts}
let writerOptions = def{ writerExtensions = exts}
result <- runIO $ do
doc <- readMarkdown readerOptions (T.pack "Testing testing\n[#test2022]\n")
let doc' = setMeta (T.pack "bibliography") (T.pack "test.bib") doc :: Pandoc
processed <- processCitations doc'
writeHtml5String writerOptions processed
html <- handleError result
TIO.putStrLn html

Effect of import order on ByteString type signature

I'm puzzled by GHCI's behavior around Data.ByteString and Data.ByteString.Char8. If I load a file with the following imports
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.Text.Encoding as E
I get
*Main> :t E.encodeUtf8
E.encodeUtf8 :: T.Text -> BC.ByteString
If I reverse the second and third import lines to
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString as B
import qualified Data.Text.Encoding as E
I get
*Main> :t E.encodeUtf8
E.encodeUtf8 :: T.Text -> B.ByteString
What that suggests to me is that Data.ByteString and Data.ByteString.Char8 are sharing the same ByteString type, but I don't know how to make sense of that.
I think sjakobi's comment answers the question:
These modules do export the very same ByteString type. The
difference between these modules is in the functions they expose.

Converting ByteString Generated by System.Entropy to Text

When I run this code, I get a decode error from Data.Text. What am I doing wrong?
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8)
import Data.ByteString (ByteString)
import System.Entropy
randBS :: IO ByteString
randBS = do
randBytes <- getEntropy 2048
return randBytes
main :: IO ()
main = do
r <- randBS
putStrLn $ unpack $ decodeUtf8 r
Runtime Error:
Cannot decode byte '\xc4': Data.Text.Internal.Encoding.Fusion.streamUtf8:
Invalid UTF-8 stream
I would like to generate some random bytes that will be used as an auth token.
I am on Mac OS X (Yosemite) and GHC Version 7.10.1
randBS returns random bytes not utf-8 encoded data!
What you have is not a representation of Text so it doesn't matter which function you use you will encounter some decoding error, and so you'll have to use something like decodeUtf8With and use an error handler to replace invalid bytes with their literal counterpart.
Something like:
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8With)
import Data.ByteString (ByteString)
import Data.Char (chr)
import Control.Applicative ((<$>))
import System.Entropy
handler _ x = chr <$> fromIntegral <$> x
randBS :: IO ByteString
randBS = do
randBytes <- getEntropy 2048
return randBytes
main :: IO ()
main = do
r <- randBS
putStrLn $ unpack $ decodeUtf8With handler r
Not tested, in this moment I don't have GHC installed :s
Probably even better is to simply use hexadecimal encoding instead of utf-8 + error handler. You can do so with the base16-bytestring library. So you'd first use the encode :: ByteString -> ByteString to obtain a representation with only ASCII values:
import Data.Text (Text, pack, unpack)
import Data.ByteString (ByteString)
import Data.ByteString.Encoding (decodeUtf8)
import Data.ByteString.Base16 (encode)
import System.Entropy
--- ... randBS as before
main = do
r <- randBS
putStrLn $ unpack $ decodeUtf8 $ encode r

Unable to create a custom header to use it in "withManager"

I can't create a custom header without using OverloadedStrings
import Data.Aeson
import qualified Data.ByteString.Lazy as B
import Network.HTTP.Conduit
import qualified Network.HTTP.Headers as HHeaders
import qualified Network.HTTP.Types as HTypes
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy.Char8 as LC8
-- myHeader1 = (HHeaders.HdrAccept $ C8.pack "some data")
myHeader1 = HHeaders.mkHeader HHeaders.HdrAccept "some data"
get :: String -> IO (Response LC8.ByteString)
get url1 = do
req1 <- parseUrl url1
res1 <- withManager $ httpLbs req1 { method = HTypes.methodGet, requestHeaders = [myHeader1] }
return res1
An error:
Couldn't match type ‘HHeaders.Header’
with ‘(HTypes.HeaderName, C8.ByteString)’
Expected type: HTypes.Header
Actual type: HHeaders.Header
In the expression: myHeader1
In the ‘requestHeaders’ field of a record
What am I doing wrong?
Network.HTTP.Conduit and Network.HTTP.Headers are from incompatible HTTP libraries. Request headers for http-conduit/http-client can be created using the http-types library:
import Data.Aeson
import qualified Data.ByteString.Lazy as B
import Network.HTTP.Conduit as HHeaders
import qualified Network.HTTP.Types as HTypes
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy.Char8 as LC8
myHeader1 = (HTypes.hAccept, C8.pack "some data")
get :: String -> IO (Response LC8.ByteString)
get url1 = do
req1 <- parseUrl "some url"
res1 <- withManager $ httpLbs req1 { method = HTypes.methodGet, requestHeaders = [myHeader1] }
return res1
To clarify:
You were importing Network.HTTP.Headers from the HTTP library. Although the imports look similar, this is a self-contained library which defines it's own header types and not intended to be used with http-types.
http-client is compatible with the http-types. If you follow the definition for RequestHeader it will lead you to http-types.
In the future, one way to check the compatibility of orthogonal libraries is to look at the build depends on the Hackage index or follow the types as far as possible.

Warning: Pattern match(es) are overlapped when matching on strings

I am trying to make a simple url route in Haskell and can't get around the warning:
Warning: Pattern match(es) are overlapped
In a case alternative: "/" -> ...
Ok, modules loaded: Main.
the snippet:
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Debug (debug)
import Network.HTTP.Types (statusOK, status404)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Data.Text.Lazy as T
import Control.Monad.IO.Class (liftIO, MonadIO)
application req = do
case unpack $ rawPathInfo req of
"/items" -> itemsJSON
"/" -> indexPage
_ -> return $ responseLBS status404 [("Content-Type", "text/plain")]
"Not found"
indexPage = do
page <- liftIO $ L.readFile "templates/index.html"
return $ responseLBS statusOK [("Content-Type", "text/html; charset=utf-8")] page
itemsJSON =
return $ responseLBS statusOK
[("Content-Type", "application/json; charset=utf-8")] "hi"
main = do
run 3000 $ debug $ application
UPD:
replaced snippet with complete program, and
$ ghc -V
The Glorious Glasgow Haskell Compilation System, version 6.12.1
This is a bug, and is fixed in newer versions of GHC.

Resources