Permalink
Browse files

createAuthMessage

  • Loading branch information...
singpolyma committed Mar 19, 2013
1 parent eab384a commit d3457291f758cef94249b80ae8bff284abd6a7bc
Showing with 22 additions and 1 deletion.
  1. +22 −1 Auth.hs
View
23 Auth.hs
@@ -3,6 +3,7 @@ module Auth where
import Numeric (showFFloat)
import Control.Monad (void)
import Data.Char (isDigit)
+import Data.List (stripPrefix)
import Data.Word (Word32)
import Data.Base58Address (RippleAddress)
import Network.URI (URI(..), URIAuth(..), escapeURIString, isUnescapedInURIComponent)
@@ -11,14 +12,34 @@ import Control.Monad.CryptoRandom (crandomR)
import Data.Attoparsec.Combinator (option)
import Data.Attoparsec.Text (Parser, parseOnly, decimal, string, endOfInput)
import qualified Data.Attoparsec.Text as Attoparsec
+import qualified Data.ByteString.Lazy as LZ
import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.OpenPGP as OpenPGP
+import qualified Data.OpenPGP.CryptoAPI as OpenPGP
data Destination = Destination {
name :: String,
address :: RippleAddress,
destinationTag :: Word32
} deriving (Eq, Show)
+createAuthMessage :: (CryptoRandomGen g) => OpenPGP.Message -> Destination -> g -> Either GenError (OpenPGP.Message, g)
+createAuthMessage k dest g = do
+ (uri, g') <- randomTinyTransferURI dest g
+ let msg = compressedDataMessage OpenPGP.BZip2 'u' "authURI.txt" 0
+ (TL.encodeUtf8 $ TL.pack $ show (httpPrefixRippleURI uri) ++ "\n")
+ OpenPGP.encrypt [] k OpenPGP.AES128 msg g'
+
+compressedDataMessage :: OpenPGP.CompressionAlgorithm -> Char -> String -> Word32 -> LZ.ByteString -> OpenPGP.Message
+compressedDataMessage compress format filename time content =
+ OpenPGP.Message [OpenPGP.CompressedDataPacket compress (
+ OpenPGP.Message [
+ OpenPGP.LiteralDataPacket format filename time content
+ ]
+ )]
+
escape :: String -> String
escape = escapeURIString isUnescapedInURIComponent
@@ -38,7 +59,7 @@ httpPrefixRippleURI u@(URI {uriPath = pth}) =
u {
uriScheme = "https:",
uriAuthority = Just (URIAuth "" "ripple.com" ""),
- uriPath = "//" ++ pth
+ uriPath = maybe ("//" ++ pth) (const pth) (stripPrefix "//" pth)
}
-- Always return drops

0 comments on commit d345729

Please sign in to comment.