Initial commit

bundled/Network/Stellar/Asset.hs

@@ -0,0 +1,43 @@
+module Network.Stellar.Asset
+  ( Asset(..)
+  , toXdrAsset
+  , toXdrAsset'
+  )
+where
+
+import           Control.Monad ((<=<))
+import qualified Data.Text as T
+import           Data.Text.Encoding (encodeUtf8)
+import           Network.ONCRPC.XDR
+import           Network.Stellar.Keypair
+import qualified Network.Stellar.TransactionXdr as X
+
+data Asset = AssetNative
+           | AssetAlphaNum4 { assetCode :: T.Text, assetIssuer :: T.Text }
+           | AssetAlphaNum12 { assetCode :: T.Text, assetIssuer :: T.Text }
+
+toXdrAsset :: Asset -> Maybe X.Asset
+toXdrAsset AssetNative = Just X.Asset'ASSET_TYPE_NATIVE
+toXdrAsset (AssetAlphaNum4 code issuer) =
+  X.Asset'ASSET_TYPE_CREDIT_ALPHANUM4
+  <$> (X.AlphaNum4 <$> lengthArray (encodeUtf8 code) <*> toXdrAccount issuer)
+toXdrAsset (AssetAlphaNum12 code issuer) =
+  X.Asset'ASSET_TYPE_CREDIT_ALPHANUM12
+  <$> (X.AlphaNum12 <$> lengthArray (encodeUtf8 code) <*> toXdrAccount issuer)
+
+toXdrAsset' :: Asset -> X.Asset
+toXdrAsset' AssetNative = X.Asset'ASSET_TYPE_NATIVE
+toXdrAsset' (AssetAlphaNum4 code issuer) =
+  X.Asset'ASSET_TYPE_CREDIT_ALPHANUM4 $
+  X.AlphaNum4 (lengthArray' $ encodeUtf8 code) (toXdrAccount' issuer)
+toXdrAsset' (AssetAlphaNum12 code issuer) =
+  X.Asset'ASSET_TYPE_CREDIT_ALPHANUM12 $
+  X.AlphaNum12 (lengthArray' $ encodeUtf8 code) (toXdrAccount' issuer)
+
+toXdrAccount :: T.Text -> Maybe X.AccountID
+toXdrAccount =
+  fmap X.PublicKey'PUBLIC_KEY_TYPE_ED25519 . lengthArray <=< decodePublic
+
+toXdrAccount' :: T.Text -> X.AccountID
+toXdrAccount' =
+  X.PublicKey'PUBLIC_KEY_TYPE_ED25519 . lengthArray' . decodePublic'

bundled/Network/Stellar/Builder.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE DataKinds #-}
+
+module Network.Stellar.Builder
+    ( TransactionBuilder(..)
+    , transactionBuilder
+    , addOperation
+    , setTimeBounds
+    , buildWithFee
+    , build
+    , toEnvelope
+    , viewAccount
+    )
+where
+
+import qualified Crypto.Sign.Ed25519 as C
+import           Data.Maybe (fromMaybe)
+import           Data.Word (Word64)
+
+import           Network.ONCRPC.XDR.Array (boundLengthArrayFromList,
+                                           emptyBoundedLengthArray,
+                                           lengthArray', unLengthArray)
+import           Network.Stellar.TransactionXdr
+
+baseFee :: Uint32
+baseFee = 100
+
+data TransactionBuilder = TransactionBuilder
+                    { tbSourceAccount  :: C.PublicKey
+                    , tbSequenceNumber :: SequenceNumber
+                    , tbTimeBounds     :: Maybe TimeBounds
+                    , tbMemo           :: Maybe Memo
+                    , tbOperations     :: [Operation]
+                    }
+
+viewAccount :: AccountID -> C.PublicKey
+viewAccount (PublicKey'PUBLIC_KEY_TYPE_ED25519 key) =
+    C.PublicKey $ unLengthArray key
+
+transactionBuilder :: C.PublicKey -> SequenceNumber -> TransactionBuilder
+transactionBuilder acc seqNum = TransactionBuilder acc seqNum Nothing Nothing []
+
+addOperation :: TransactionBuilder -> Operation -> TransactionBuilder
+addOperation tb op = tb{ tbOperations = tbOperations tb ++ [op] }
+
+setTimeBounds :: TransactionBuilder -> Word64 -> Word64 -> TransactionBuilder
+setTimeBounds tb mintime maxtime = tb{ tbTimeBounds = Just $ TimeBounds mintime maxtime }
+
+buildWithFee :: Uint32 -> TransactionBuilder -> TransactionV0
+buildWithFee fee (TransactionBuilder acc seqNum bounds memo ops) =
+    TransactionV0
+        (buildAccount acc)
+        (fee * fromIntegral (length ops))
+        seqNum
+        bounds
+        mm
+        (boundLengthArrayFromList ops)
+        0
+  where
+    mm = fromMaybe Memo'MEMO_NONE memo
+    buildAccount (C.PublicKey key) = lengthArray' key
+
+build :: TransactionBuilder -> TransactionV0
+build = buildWithFee baseFee
+
+toEnvelope :: TransactionV0 -> TransactionEnvelope
+toEnvelope tx =
+    TransactionEnvelope'ENVELOPE_TYPE_TX_V0 $
+    TransactionV0Envelope tx emptyBoundedLengthArray

bundled/Network/Stellar/Horizon.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+
+module Network.Stellar.Horizon
+    ( HorizonServer
+    , publicHorizon
+    , testHorizon
+    , httpServer
+    , httpsServer
+    )
+where
+
+import Data.Text
+import Network.HTTP.Req (Url, Scheme(..), http, https)
+
+type HorizonServer (scheme :: Scheme) = Url scheme
+
+publicHorizon :: HorizonServer 'Https
+publicHorizon = httpsServer "horizon.stellar.org"
+
+testHorizon :: HorizonServer 'Https
+testHorizon = httpsServer "horizon-testnet.stellar.org"
+
+httpServer :: Text -> HorizonServer 'Http
+httpServer = http
+
+httpsServer :: Text -> HorizonServer 'Https
+httpsServer = https

bundled/Network/Stellar/Keypair.hs

@@ -0,0 +1,125 @@
+module Network.Stellar.Keypair
+    ( KeyPair(..)
+    , PublicKey(..)
+    , EncodingVersion(..)
+    , fromPrivateKey
+    , fromPrivateKey'
+    , signatureHint
+    , encodePublic
+    , encodePublicKey
+    , decodePublic
+    , decodePublicKey
+    , decodePublic'
+    , decodePublicKey'
+    , encodePrivate
+    , decodePrivate
+    , decodePrivate'
+    , encodeKey
+    )where
+
+import           Control.Monad (guard)
+import           Crypto.Random (getSystemDRG, randomBytesGenerate)
+import           Crypto.Sign.Ed25519
+import           Data.Bits
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import           Data.ByteString.Base32 (decodeBase32, encodeBase32)
+import           Data.Maybe (fromJust, fromMaybe)
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import           Data.Text.Encoding (encodeUtf8)
+import           Data.Word (Word16, Word8)
+import           GHC.Stack (HasCallStack)
+
+data KeyPair = KeyPair
+    { kpPublicKey   :: PublicKey
+    , kpPrivateKey  :: SecretKey
+    , kpSeed        :: ByteString
+    }
+
+instance Show KeyPair where
+    show (KeyPair public _ seed) =
+        "KeyPair {" ++ Text.unpack (encodePublic $ unPublicKey public) ++ ", "
+        ++ Text.unpack (encodePrivate seed) ++ "}"
+
+fromSeed :: ByteString -> KeyPair
+fromSeed seed = KeyPair public private seed
+    where (public, private) = fromJust $ createKeypairFromSeed_ seed
+
+fromPrivateKey :: Text -> Maybe KeyPair
+fromPrivateKey = fmap fromSeed . decodePrivate
+
+fromPrivateKey' :: HasCallStack => Text -> KeyPair
+fromPrivateKey' = fromSeed . decodePrivate'
+
+signatureHint :: KeyPair -> ByteString
+signatureHint = BS.drop 28 . unPublicKey . kpPublicKey
+
+
+encodePublic :: ByteString -> Text
+encodePublic = encodeKey EncodingAccount
+
+encodePublicKey :: PublicKey -> Text
+encodePublicKey = encodePublic . unPublicKey
+
+encodePrivate :: ByteString -> Text
+encodePrivate = encodeKey EncodingSeed
+
+decodePublic :: Text -> Maybe ByteString
+decodePublic = decodeKey EncodingAccount
+
+decodePublicKey :: Text -> Maybe PublicKey
+decodePublicKey = fmap PublicKey . decodeKey EncodingAccount
+
+decodePublic' :: Text -> ByteString
+decodePublic' = decodeKey' EncodingAccount
+
+decodePublicKey' :: Text -> PublicKey
+decodePublicKey' = PublicKey . decodePublic'
+
+decodePrivate :: Text -> Maybe ByteString
+decodePrivate = decodeKey EncodingSeed
+
+decodePrivate' :: HasCallStack => Text -> ByteString
+decodePrivate' = decodeKey' EncodingSeed
+
+decodeKey :: EncodingVersion -> Text -> Maybe ByteString
+decodeKey version key = do
+    keyBlob <- either (const Nothing) Just $ decodeBase32 $ encodeUtf8 key
+    let (payload, checksum) = BS.splitAt (BS.length keyBlob - 2) keyBlob
+    (versionByte, keyData) <- BS.uncons payload
+    let versionCheck = versionByte == versionByteName version
+        checksumCheck = crc16XmodemLE payload == checksum
+    guard (versionCheck && checksumCheck)
+    pure keyData
+
+decodeKey' :: HasCallStack => EncodingVersion -> Text -> ByteString
+decodeKey' version key =
+    fromMaybe (error $ "Decoding key failed " ++ Text.unpack key) $
+    decodeKey version key
+
+data EncodingVersion = EncodingAccount | EncodingSeed | EncodingPreAuthTx | EncodingSha256Hash
+
+versionByteName :: EncodingVersion -> Word8
+versionByteName EncodingAccount    = 48
+versionByteName EncodingSeed       = 144
+versionByteName EncodingPreAuthTx  = 152
+versionByteName EncodingSha256Hash = 184
+
+encodeKey :: EncodingVersion -> ByteString -> Text
+encodeKey version key = encodeBase32 $ payload <> checksum
+    where
+        versionByte = versionByteName version
+        payload = versionByte `BS.cons` key
+        checksum = crc16XmodemLE payload
+
+crc16XmodemLE :: ByteString -> ByteString
+crc16XmodemLE bs = BS.pack [fromIntegral $ checksum .&. 0xFF, fromIntegral $ checksum `shiftR` 8]
+    where checksum = BS.foldl crcRound 0 bs
+
+crcRound :: Word16 -> Word8 -> Word16
+crcRound crc byte = crc2
+    where
+        code = (crc `shiftR` 8) `xor` fromIntegral byte
+        code2 = code `xor` (code `shiftR` 4)
+        crc2 = (crc `shiftL` 8) `xor` code2 `xor` (code2 `shiftL` 5) `xor` (code2 `shiftL` 12)

bundled/Network/Stellar/Network.hs

@@ -0,0 +1,25 @@
+module Network.Stellar.Network
+  ( Network
+  , publicNetwork
+  , testNetwork
+  )
+where
+
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
+import Data.Digest.Pure.SHA (sha256, bytestringDigest)
+
+type Network = B.ByteString
+
+hashPassphrase :: String -> Network
+hashPassphrase = LB.toStrict . bytestringDigest . sha256 . LB.fromStrict . B.pack
+
+publicPassphrase :: String
+publicPassphrase = "Public Global Stellar Network ; September 2015"
+publicNetwork :: Network
+publicNetwork = hashPassphrase publicPassphrase
+
+testPassphrase :: String
+testPassphrase = "Test SDF Network ; September 2015"
+testNetwork :: Network
+testNetwork = hashPassphrase testPassphrase

bundled/Network/Stellar/Operation.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE DataKinds #-}
+
+module Network.Stellar.Operation
+    ( makeCreateAccountOperation
+    , makePaymentOperation
+    , makeNativePaymentOperation
+    , makeChangeTrustOperation
+    , makeAllowTrustOperation
+    , makeAccountMergeOperation
+    , makeInflationOperation
+    , makeManageDataOperation
+    )
+where
+
+-- import qualified Crypto.Sign.Ed25519 as C
+-- import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+-- import qualified Data.Word (Word8)
+import           Network.Stellar.TransactionXdr
+import qualified Network.ONCRPC.XDR as XDR
+
+makeOperationGeneric2
+    :: (a -> OperationBody) -> (c -> b -> a) -> c -> b -> Operation
+makeOperationGeneric2 opBodyCons opCons a1 =
+    Operation Nothing . opBodyCons . opCons a1
+
+makeOperationGeneric3
+    :: (a -> OperationBody) -> (d -> c -> b -> a) -> d -> c -> b -> Operation
+makeOperationGeneric3 opBodyCons opCons a1 a2 =
+    Operation Nothing . opBodyCons . opCons a1 a2
+
+makeAssetIdentifier
+    :: (XDR.FixedOpaque 4 -> a) -> (XDR.FixedOpaque 12 -> a) -> String -> a
+makeAssetIdentifier shortCons longCons assetname
+    | length assetname <= 4 =
+        shortCons $ XDR.padLengthArray (BC.pack assetname) 0
+    | length assetname <= 12 =
+        longCons $ XDR.padLengthArray (BC.pack assetname) 0
+    | otherwise =
+        error $ "Name of asset " ++ assetname ++ " is too long."
+
+
+makeCreateAccountOperation :: AccountID -> Int64 -> Operation
+makeCreateAccountOperation destination amount = Operation Nothing $ OperationBody'CREATE_ACCOUNT $ CreateAccountOp destination amount
+
+makePaymentOperation :: MuxedAccount -> Asset -> Int64 -> Operation
+makePaymentOperation = makeOperationGeneric3 OperationBody'PAYMENT PaymentOp
+
+makeNativePaymentOperation :: MuxedAccount -> Int64 -> Operation
+makeNativePaymentOperation destination =
+    makePaymentOperation destination Asset'ASSET_TYPE_NATIVE
+
+makeChangeTrustOperation :: Asset -> Int64 -> Operation
+makeChangeTrustOperation = makeOperationGeneric2 OperationBody'CHANGE_TRUST ChangeTrustOp
+
+makeAllowTrustOperation :: AccountID -> String -> Bool -> Operation
+makeAllowTrustOperation trustor asset =
+    makeOperationGeneric3 OperationBody'ALLOW_TRUST AllowTrustOp trustor
+        (makeAssetIdentifier
+            AllowTrustOpAsset'ASSET_TYPE_CREDIT_ALPHANUM4
+            AllowTrustOpAsset'ASSET_TYPE_CREDIT_ALPHANUM12
+            asset)
+
+makeAccountMergeOperation :: MuxedAccount -> Operation
+makeAccountMergeOperation = Operation Nothing . OperationBody'ACCOUNT_MERGE
+
+makeInflationOperation :: Operation
+makeInflationOperation = Operation Nothing OperationBody'INFLATION
+
+makeManageDataOperation :: String -> Maybe String -> Operation
+makeManageDataOperation name value =
+    makeOperationGeneric2 OperationBody'MANAGE_DATA ManageDataOp (XDR.boundLengthArray $ BC.pack name) ((XDR.boundLengthArray.BC.pack) `fmap` value)

bundled/Network/Stellar/Query.hs

@@ -0,0 +1,213 @@
+{-# OPTIONS -Wno-orphans #-} -- MonandHttp IO
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DataKinds #-}
+
+module Network.Stellar.Query where
+
+import Prelude hiding (lookup)
+
+import           Control.Exception (throwIO)
+import qualified Crypto.Sign.Ed25519 as C
+import           Data.Aeson (Value(Object, String), FromJSON)
+import           Data.Aeson.KeyMap (lookup)
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.Text as T
+import           Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import           Data.Word (Word64)
+import           Network.HTTP.Req
+import qualified Network.ONCRPC.XDR as XDR
+import           Network.Stellar.Asset
+import           Network.Stellar.Horizon
+import           Network.Stellar.Keypair
+import qualified Network.Stellar.TransactionXdr as TX
+
+instance MonadHttp IO where
+    handleHttpException = throwIO
+
+query :: (FromJSON a) => HorizonServer scheme -> [T.Text] -> IO a
+query server pathSegments = queryWithParams server pathSegments []
+
+queryWithParams :: (FromJSON a) => HorizonServer scheme -> [T.Text] -> [(T.Text, T.Text)] -> IO a
+queryWithParams server pathSegments params = do
+    response <- req GET (foldl (/:) server pathSegments) NoReqBody jsonResponse $ foldMap (uncurry (=:)) params
+    return $ responseBody response
+
+postWithBody :: (FromJSON a) => HorizonServer scheme -> [T.Text] -> (T.Text, T.Text) -> IO a
+postWithBody server pathSegments (q,value) = do
+    response <- req POST (foldl (/:) server pathSegments) (ReqBodyUrlEnc $ q =: value) jsonResponse mempty
+    return $ responseBody response
+
+getSequenceNumber :: HorizonServer scheme -> C.PublicKey -> IO TX.SequenceNumber
+getSequenceNumber server acc = do
+    response <- query server ["accounts", encodePublic $ C.unPublicKey acc]
+    case response of
+        Object hm ->
+            case lookup "sequence" hm of
+                Just (String s) ->
+                    pure $ fromIntegral (read $ T.unpack s :: Integer)
+                Just x -> fail $ "Value is not a number " ++ show x
+                Nothing -> fail "No sequence in account"
+        _ -> fail $ "Sequence number response is not an object " ++ show response
+
+submitTransaction :: HorizonServer scheme -> TX.TransactionEnvelope -> IO TX.TransactionResult
+submitTransaction server tx = do
+    response <-
+        postWithBody
+            server
+            ["transactions"]
+            ("tx", decodeUtf8 $ B64.encode $ XDR.xdrSerialize tx)
+    case response of
+        Object hm ->
+            case lookup "result_xdr" hm of
+                Just (String t) ->
+                    either fail pure $
+                    XDR.xdrDeserialize =<< B64.decode (encodeUtf8 t)
+                Just x -> fail $ "Value is not a string " ++ show x
+                Nothing -> fail "No result_xdr in transaction"
+        _ -> fail $ "Transaction response is not an object " ++ show response
+
+type HorizonQuery = ([T.Text], [(T.Text, T.Text)])
+runQuery :: HorizonServer scheme -> HorizonQuery -> IO Value
+runQuery server (pathSegments, params) = queryWithParams server pathSegments params
+
+
+-- data CallBuilder (baseSegment :: [T.Text] -> [T.Text]) = CallBuilder { otherPathSegments :: [T.Text] }
+-- instance Monoid (CallBuilder baseSegment) where
+--     mempty =
+-- newtype EffectsCallBuilder = CallBuilder (++["effects"]) deriving Monoid
+
+-- buildQuery :: CallBuilder baseSegment -> T.Text
+-- buildQuery ()
+
+
+-- Queries related to accounts
+
+getAccount :: C.PublicKey -> HorizonQuery
+getAccount account =
+    (["accounts", encodePublic $ C.unPublicKey account], [])
+
+getAccountData :: C.PublicKey -> T.Text -> HorizonQuery
+getAccountData account key =
+    (["accounts", encodePublic $ C.unPublicKey account, "data", key], [])
+
+getAccountX :: T.Text -> C.PublicKey -> [(T.Text, T.Text)] -> HorizonQuery
+getAccountX x account params =
+    (["accounts", encodePublic $ C.unPublicKey account, x], params)
+
+getAccountEffects :: C.PublicKey -> [(T.Text, T.Text)] -> HorizonQuery
+getAccountEffects = getAccountX "effects"
+
+getAccountOffers :: C.PublicKey -> [(T.Text, T.Text)] -> HorizonQuery
+getAccountOffers = getAccountX "offers"
+
+getAccountOperations :: C.PublicKey -> [(T.Text, T.Text)] -> HorizonQuery
+getAccountOperations = getAccountX "operations"
+
+getAccountPayments :: C.PublicKey -> [(T.Text, T.Text)] -> HorizonQuery
+getAccountPayments = getAccountX "payments"
+
+getAccountTransactions :: C.PublicKey -> [(T.Text, T.Text)] -> HorizonQuery
+getAccountTransactions = getAccountX "transactions"
+
+-- optional parameters: asset_code, asset_issuer
+getAssets :: [(T.Text, T.Text)] -> HorizonQuery
+getAssets params =
+    (["assets"], params)
+
+getEffects :: [(T.Text, T.Text)] -> HorizonQuery
+getEffects params =
+    (["effects"], params)
+
+-- Queries related to ledgers
+
+getAllLedgers :: [(T.Text, T.Text)] -> HorizonQuery
+getAllLedgers params = (["ledgers"], params)
+
+getLedger :: T.Text -> HorizonQuery
+getLedger ledgerId = (["ledgers", ledgerId], [])
+
+getLedgerX :: T.Text -> T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getLedgerX x ledger params = (["ledgers", ledger, x], params)
+
+getLedgerEffects :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getLedgerEffects = getLedgerX "effects"
+
+getLedgerOperations :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getLedgerOperations = getLedgerX "operations"
+
+getLedgerPayments :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getLedgerPayments = getLedgerX "payments"
+
+getLedgerTransactions :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getLedgerTransactions = getLedgerX "transactions"
+
+-- Queries related to operations
+
+getAllOperations :: [(T.Text, T.Text)] -> HorizonQuery
+getAllOperations params = (["operations"], params)
+
+getOperation :: T.Text -> HorizonQuery
+getOperation op = (["operations", op], [])
+
+getOperationEffects :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getOperationEffects op params = (["operations", op, "effects"], params)
+
+-- Queries related to transactions
+
+getAllTransactions :: [(T.Text, T.Text)] -> HorizonQuery
+getAllTransactions params = (["transactions"], params)
+
+getTransaction :: T.Text -> HorizonQuery
+getTransaction tx = (["transactions", tx], [])
+
+getTransactionX :: T.Text -> T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getTransactionX x tx params = (["transactions", tx, x], params)
+
+getTransactionEffects :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getTransactionEffects = getTransactionX "effects"
+
+getTransactionOperations :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getTransactionOperations = getTransactionX "operations"
+
+getTransactionPayments :: T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getTransactionPayments = getTransactionX "payments"
+
+
+-- Queries related to trading
+
+assetToParams :: T.Text -> Asset -> [(T.Text, T.Text)]
+assetToParams prefix AssetNative = [(prefix `T.append` "_asset_type", "native")]
+assetToParams prefix (AssetAlphaNum4 assetcode issuer) =
+  [(prefix `T.append` "_asset_type", "credit_alphanum4"), (prefix `T.append` "_asset_code", assetcode), (prefix `T.append` "_asset_issuer", issuer)]
+assetToParams prefix (AssetAlphaNum12 assetcode issuer) =
+  [(prefix `T.append` "_asset_type", "credit_alphanum12"), (prefix `T.append` "_asset_code", assetcode), (prefix `T.append` "_asset_issuer", issuer)]
+
+getOrderBook :: Asset -> Asset -> HorizonQuery
+getOrderBook selling buying =
+    ( ["order_book"]
+    , assetToParams "selling" selling ++ assetToParams "buying" buying
+    )
+
+getPaymentPaths :: C.PublicKey -> C.PublicKey -> Asset -> Word64 -> HorizonQuery
+getPaymentPaths sourceAccount destAccount asset amount =
+    ( ["paths"]
+    , ("source_account", encodePublic $ C.unPublicKey sourceAccount)
+        : ("destination_account", encodePublic $ C.unPublicKey destAccount)
+        : ("destination_amount", T.pack $ show amount)
+        : assetToParams "destination" asset
+    )
+
+getTradeAggregations :: Asset -> Asset -> Word64 -> Word64 -> Word64 -> [(T.Text, T.Text)] -> HorizonQuery
+getTradeAggregations base counter start end resolution params =
+  (["trade_aggregations"],
+    assetToParams "base" base
+    ++ assetToParams "counter" counter
+    ++ ("start_time", T.pack $ show start)
+    : ("end_time", T.pack $ show end)
+    : ("resolution", T.pack $ show resolution)
+    : params)
+
+getTrades :: Maybe Asset -> Maybe Asset -> Maybe T.Text -> [(T.Text, T.Text)] -> HorizonQuery
+getTrades base counter offerId params =
+  (["trades"], concat [maybe [] (assetToParams "base") base, maybe [] (assetToParams "counter") counter, maybe [] (\x -> [("offer_id", x)]) offerId, params])

bundled/Network/Stellar/Signature.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Network.Stellar.Signature
+    ( signBlob
+    , verifyBlob
+    , verifyBlobWithKP
+    , signTx
+    , verifyTx
+    , transactionHash
+    )
+where
+
+import qualified Crypto.Sign.Ed25519 as C
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LB
+import           Data.Digest.Pure.SHA (bytestringDigest, sha256)
+import qualified Data.Vector as Vector
+
+import           Network.ONCRPC.XDR (xdrSerialize)
+import qualified Network.ONCRPC.XDR as XDR
+import           Network.ONCRPC.XDR.Array (boundLengthArray, lengthArray',
+                                           unLengthArray, unsafeLengthArray)
+import           Network.Stellar.Keypair
+import           Network.Stellar.Network
+import           Network.Stellar.TransactionXdr
+
+signBlob :: KeyPair -> ByteString -> ByteString
+signBlob KeyPair{kpPrivateKey} = C.unSignature . C.dsign kpPrivateKey
+
+verifyBlob
+    :: C.PublicKey
+    -> ByteString -- ^ message
+    -> ByteString -- ^ signature
+    -> Bool
+verifyBlob publicKey message = C.dverify publicKey message . C.Signature
+
+verifyBlobWithKP
+    :: KeyPair
+    -> ByteString -- ^ message
+    -> ByteString -- ^ signature
+    -> Bool
+verifyBlobWithKP KeyPair{kpPublicKey} message =
+    C.dverify kpPublicKey message . C.Signature
+
+data SignError = TooManySignatures
+    deriving Show
+
+takeEnd :: Int -> ByteString -> ByteString
+takeEnd n bs = B.drop (B.length bs - n) bs
+
+accountXdrFromEd :: C.PublicKey -> AccountID
+accountXdrFromEd (C.PublicKey key) =
+    PublicKey'PUBLIC_KEY_TYPE_ED25519 $ lengthArray' key
+
+keyToHint :: KeyPair -> SignatureHint
+keyToHint KeyPair{kpPublicKey} =
+    lengthArray' $ takeEnd 4 $ xdrSerialize $ accountXdrFromEd kpPublicKey
+
+signTx
+    :: Network
+    -> TransactionEnvelope
+    -> [KeyPair]
+    -> Either SignError TransactionEnvelope
+signTx nId envelope newKeys =
+    case envelope of
+        TransactionEnvelope'ENVELOPE_TYPE_TX_V0
+                (TransactionV0Envelope tx signatures) ->
+            TransactionEnvelope'ENVELOPE_TYPE_TX_V0 . TransactionV0Envelope tx
+            <$> appendSignatures signatures
+        TransactionEnvelope'ENVELOPE_TYPE_TX
+                (TransactionV1Envelope tx signatures) ->
+            TransactionEnvelope'ENVELOPE_TYPE_TX . TransactionV1Envelope tx
+            <$> appendSignatures signatures
+        TransactionEnvelope'ENVELOPE_TYPE_TX_FEE_BUMP
+                (FeeBumpTransactionEnvelope tx signatures) ->
+            TransactionEnvelope'ENVELOPE_TYPE_TX_FEE_BUMP
+                . FeeBumpTransactionEnvelope tx
+            <$> appendSignatures signatures
+  where
+    signature :: KeyPair -> Signature
+    signature KeyPair{kpPrivateKey} =
+        boundLengthArray $
+        C.unSignature $ C.dsign kpPrivateKey $ transactionHash nId envelope
+
+    appendSignatures
+        :: XDR.Array 20 DecoratedSignature
+        -> Either SignError (XDR.Array 20 DecoratedSignature)
+    appendSignatures oldSignatures
+        | Vector.length oldSignatures' + length newKeys <= 20 =
+            Right $
+            unsafeLengthArray $
+                oldSignatures'
+                <> Vector.fromList
+                    [ DecoratedSignature (keyToHint key) (signature key)
+                    | key <- newKeys
+                    ]
+        | otherwise = Left TooManySignatures
+      where
+        oldSignatures' = unLengthArray oldSignatures
+
+transactionHash :: Network -> TransactionEnvelope -> ByteString
+transactionHash nId = \case
+    TransactionEnvelope'ENVELOPE_TYPE_TX_V0 (TransactionV0Envelope tx _) ->
+        go  (   xdrSerialize ENVELOPE_TYPE_TX
+            <>  xdrSerialize PUBLIC_KEY_TYPE_ED25519
+            )
+            tx
+    TransactionEnvelope'ENVELOPE_TYPE_TX (TransactionV1Envelope tx _) ->
+        go (xdrSerialize ENVELOPE_TYPE_TX) tx
+    TransactionEnvelope'ENVELOPE_TYPE_TX_FEE_BUMP
+            (FeeBumpTransactionEnvelope tx _) ->
+        go (xdrSerialize ENVELOPE_TYPE_TX_FEE_BUMP) tx
+  where
+    go prefix tx =
+        LB.toStrict $
+        bytestringDigest $
+        sha256 $
+        LB.fromStrict $
+        B.concat [nId, prefix, xdrSerialize tx]
+
+verifyTx
+    :: Network
+    -> TransactionEnvelope
+    -> C.PublicKey
+    -> DecoratedSignature
+    -> Bool
+verifyTx nId envelope publicKey (DecoratedSignature _ signature) =
+    C.dverify
+        publicKey
+        (transactionHash nId envelope)
+        (C.Signature $ unLengthArray signature)