64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
RSEB2NFGUBTFESE5BJKDUVQL5Y5ZVGY5O4CJX2LNP63MS3NRHHZQC
AXKKXBWN4EMUOLV43WN52JSKJPBV7TLSGLNJW5EZXHSJNKCYUWOQC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC
EQXRXRZDYCM7BDAVBOXQYPG6C7IJT3OFGNIXCDAHJJBRKAXNGL7AC
NMWWP4ZNOKHZKSJ6F5KYEREWXXR5F4UD35WOKI3EH42AZWVCTCJAC
GKGVYBZGPJXO7N7GLHLRNYQPXFHBQSNQN53OKRFCXLQEYDTC5I4QC
N4NDAZYTLSI2W22KT3SYXL257DBMSH3UT2BXOYM7LH7FSZAY4RLAC
P6NR2CGXCWAW6GXXSIXCGOBIRAS2BM4LEM6D5ADPN4IL7TMW6UVAC
2OIPAQCBDIUJBXB4K2QVP3IEBIUOCQHSWSWFVMVSVZC7GHX2VK7AC
Y35QCWYW2OTZ27ZVTH2BA3XJTUCJ2WMLKU32ZCOCDY3AW7TIZXRAC
Name: ananke
Version: 0.1
Synopsis: The Ananke Collaboration Platform
Description: A service to enable groups of trusted contributors to be paid for their efforts in collaboratively developing commercial applications.
License: AllRightsReserved
Author: Kris Nuttycombe
Maintainer: kris@hylotech.com
Stability: Experimental
Category: Web
Build-type: Simple
library
default-language: Haskell2010
hs-source-dirs: src
Test-Suite spec
default-language: Haskell2010
type: exitcode-stdio-1.0
ghc-options: -Wall -Werror
hs-source-dirs: test
main-is: Spec.hs
Executable ananke-server
default-language: Haskell2010
ghc-options: -Wall -Werror
hs-source-dirs: server
main-is: Main.hs
build-depends: base
, text
, time
, mtl
, bytestring >= 0.9.1 && < 0.11
, scotty >=0.7 && <0.8
, sqlite == 0.5.2.2
, ananke
build-depends: base
, hspec >= 1.8.1
, ananke
, aeson
, bifunctors
, containers
, iso8601-time
, text
, time
exposed-modules: Ananke
Ananke.TimeLog
Ananke.Interval
build-depends: base >= 4.4 && < 5
, lens >= 3.7.6 && < 3.11
, bifunctors
, aeson >= 0.7.0.2
, text >= 0.11 && < 0.12
, time >= 1.1 && < 1.5
, iso8601-time == 0.1.1
, containers == 0.5.*
ghc-options: -Wall -Werror
Cabal-version: >= 1.20
Name: quixotic
Version: 0.1
Synopsis: The Quixotic Collaboration Platform
Description: A service to enable groups of trusted contributors to be paid for their efforts
in collaboratively developing commercial applications.
License: AllRightsReserved
Author: Kris Nuttycombe
Maintainer: kris@nutty.lang
Stability: Experimental
Category: Web
Build-type: Simple
Cabal-version: >= 1.20
library
default-language: Haskell2010
ghc-options: -Wall -Werror
hs-source-dirs: src
exposed-modules: Quixotic
Quixotic.Database
Quixotic.Database.SQLite
Quixotic.Interval
Quixotic.TimeLog
build-depends: base >= 4.7.0.1
, bifunctors
, aeson >= 0.8.0.2
, cassandra-cql >= 0.4.0.1
, containers >= 0.5.5.1
, either >= 4.3.1
, lens >= 4.4.0.2
, old-locale
, sqlite == 0.5.2.2
, text >= 1.2.0.0
, time >= 1.4.2 && < 1.5
Test-Suite spec
default-language: Haskell2010
type: exitcode-stdio-1.0
ghc-options: -Wall -Werror
hs-source-dirs: test
main-is: Spec.hs
build-depends: quixotic
, base
, aeson
, containers
, text
, time
, hspec >= 1.8.1
Executable quixotic-server
default-language: Haskell2010
ghc-options: -Wall -Werror
hs-source-dirs: server
main-is: Main.hs
build-depends: quixotic
, base
, aeson
, containers
, either
, mtl
, text
, time
, optparse-applicative >= 0.9.0 && < 0.10
, bytestring >= 0.9.1 && < 0.11
, scotty >= 0.9.0
import Data.Text.Lazy
import Control.Monad
import Control.Monad.Trans (liftIO)
import Control.Monad.Trans.Either
import qualified Data.Aeson as A
import Data.Map
import Data.Time.Clock
import Data.Time.Format
import Quixotic
import Quixotic.Database
import Quixotic.TimeLog
recordStart :: SQLiteHandle -> BtcAddr -> UTCTime -> IO ()
recordStart = undefined
handleLogRequest :: ADB a -> (UTCTime -> WorkEvent) -> ActionM ()
handleLogRequest db ev = do
BtcAddrParam addr <- param "btcAddr"
timestamp <- liftIO getCurrentTime
liftIO . recordEvent db $ LogEntry addr (ev timestamp)
eventTable :: SQLTable
eventTable = Table "workEvents" [ Column "btcAddr" (SQLVarChar 256) []
, Column "event" (SQLVarChar 64) []
, Column "eventTime" (SQLDateTime DATETIME) [] ] []
newtype BtcAddrParam = BtcAddrParam { btcAddr :: BtcAddr }
newtype BtcAddrParam = BtcAddrParam BtcAddr
parseParam t = maybe (Left "Invalid BTC address") (Right . BtcAddrParam) $ (parseBtcAddr . toStrict) t
parseParam t = maybe (Left "Invalid BTC address") (Right . BtcAddrParam) $ (parseBtcAddr . LT.toStrict) t
newtype PayoutsResponse = PayoutsResponse Payouts
instance A.ToJSON PayoutsResponse where
toJSON (PayoutsResponse p) = A.toJSON (mapKeys address p)
module Quixotic.Database.SQLite (sqliteADB) where
import Control.Monad
import Control.Monad.Trans.Either
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Format
import Database.SQLite
import Quixotic
import qualified Quixotic.Database as D
import Quixotic.TimeLog
import System.Locale
sqliteADB :: String -> IO (D.ADB IO SQLiteHandle)
sqliteADB dbName = do
db <- openConnection "quixotic.db"
return $ D.ADB recordEvent readWorkIndex
recordEvent :: SQLiteHandle -> LogEntry -> IO ()
recordEvent h (LogEntry ba ev) =
void $ insertRow h "workEvents" [ ("btcAddr", T.unpack (address ba))
, ("event", eventName ev)
, ("eventTime", formatSqlTime (logTime ev)) ]
readWorkIndex :: SQLiteHandle -> EitherT String IO WorkIndex
readWorkIndex db = do
rows <- EitherT $ execStatement db "SELECT btcAddr, event, eventTime from workEvents"
undefined
formatSqlTime :: UTCTime -> String
formatSqlTime t = formatTime defaultTimeLocale "%c" t
eventTable :: SQLTable
eventTable = Table "workEvents" [ Column "btcAddr" (SQLVarChar 256) []
, Column "event" (SQLVarChar 64) []
, Column "eventTime" (SQLDateTime DATETIME) [] ] []
module Quixotic.Database
( ADB(..)
) where
import Control.Monad.Trans.Either
import Quixotic.TimeLog
data ADB m a = ADB
{ recordEvent :: a -> LogEntry -> m ()
, readWorkIndex :: a -> EitherT String m WorkIndex
}