Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Util module, clean up warnings

  • Loading branch information...
commit ad80b7702762afb0e822ce6acf76416f5372afed 1 parent fd6444e
Stephen Paul Weber authored
Showing with 30 additions and 33 deletions.
  1. +5 −6 Application.hs
  2. +5 −15 Records.hs
  3. +4 −12 Sqlite3.hs
  4. +16 −0 Util.hs
11 Application.hs
View
@@ -7,16 +7,15 @@ import Data.Maybe (fromMaybe)
import Network.HTTP.Accept (selectAcceptType)
import Network.Wai.Parse (parseRequestBody, parseHttpAccept, getRequestBodyType, parseRequestBody, RequestBodyType(..), lbsBackEnd, fileContent)
import Network.Wai (Request(..), Response(..), Application)
-import Network.HTTP.Types (ok200, notFound404, seeOther303, badRequest400, notAcceptable406, Status, ResponseHeaders)
+import Network.HTTP.Types (ok200, seeOther303, badRequest400, notAcceptable406, Status, ResponseHeaders)
import Network.Wai.Util (string, stringHeaders, json, bodyBytestring, redirect')
import Web.PathPieces (PathPiece(..))
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Base58Address (RippleAddress)
import Control.Error (readMay, headMay)
import Control.Monad.Trans (liftIO)
-import Database.SQLite.Simple (query, field, FromRow(..), Connection, open, close, query_)
-import Database.SQLite.Simple.ToField (ToField(..))
-import Data.Binary (Binary, decodeOrFail)
+import Database.SQLite.Simple (Connection, query)
+import Data.Binary (decodeOrFail)
import Network.URI (URI(..))
import Network.URI.Partial (relativeTo)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
@@ -51,7 +50,7 @@ responseTextBuilder :: Status -> ResponseHeaders -> TL.Builder -> Response
responseTextBuilder s h = ResponseBuilder s h . Blaze.fromLazyText . TL.toLazyText
home :: URI -> Connection -> Application
-home root db req =
+home root _ _ =
return $ responseTextBuilder ok200 headers (viewHome htmlEscape $ HomeRec [Form $ forPath `relativeTo` root])
where
Just headers = stringHeaders [("Content-Type", "text/html; charset=utf8")]
@@ -65,7 +64,7 @@ for root _ req = case adr of
adrS = fmap (T.decodeUtf8 . fromMaybe BS.empty) $ lookup (fromString "address") (queryString req)
reportFor :: URI -> Connection -> RippleAddress -> Application
-reportFor root db adr req = case gen of
+reportFor _ db adr req = case gen of
Just x -> do
time <- liftIO (fmap floor getPOSIXTime :: IO Integer)
string ok200 disp (show time ++ ": " ++ show adr ++ " " ++ T.unpack x)
20 Records.hs
View
@@ -1,26 +1,27 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Records where
import Control.Applicative ((<$>), (<*>))
-import Control.Error (readMay, hush, tryHead, noteT, EitherT(..), MaybeT(..), hoistMaybe, throwT)
import Data.Base58Address (RippleAddress)
import qualified Data.Text.Buildable as TL
import qualified Data.Text.Format.Types as TL
-import Database.SQLite.Simple (query, field, FromRow(..), ToRow(..))
+import Database.SQLite.Simple (field, FromRow(..), ToRow(..))
import Database.SQLite.Simple.ToField (ToField(..))
import Data.Time.Clock (UTCTime)
-import Data.Binary (Binary, decodeOrFail, encode)
+import Data.Binary (encode)
import Data.Time.Format (formatTime)
import System.Locale (defaultTimeLocale)
import Network.URI (URI(..))
import qualified Data.ByteString.Lazy as LZ
import qualified Data.OpenPGP as OpenPGP
-import qualified Data.OpenPGP.CryptoAPI as OpenPGP
import qualified Data.Aeson as Aeson
import qualified Data.Text as T
import qualified Data.ByteString.Base64.Lazy as B64
import Assertion
+import Util
+-- Orphan instances, do not import this module
instance TL.Buildable RippleAddress where
build = TL.build . TL.Shown
@@ -111,14 +112,3 @@ instance ToRow AssertionRow where
toField . show . asserted,
toField . encode . assertion
]
-
-decodeM :: (Binary a, Monad m) => LZ.ByteString -> m a
-decodeM bytes = case decodeOrFail bytes of
- Left (_,_,e) -> fail e
- Right (_,_,x) -> return x
-
--- | Signal read errors in some Monad (for parsing)
-readM :: (Read r, Monad m) => String -> m r
-readM s = case readMay s of
- Just x -> return x
- Nothing -> fail $ s ++ " is invalid"
16 Sqlite3.hs
View
@@ -1,22 +1,14 @@
module Sqlite3 where
-import Control.Applicative
import Data.String (fromString)
import Control.Monad (when)
-import Data.List (find)
-import Control.Arrow (first)
-import Data.Maybe (listToMaybe, mapMaybe)
-import Data.String (fromString)
+import Data.Maybe (mapMaybe)
import Data.Time.Clock (getCurrentTime, diffUTCTime, addUTCTime)
-import Control.Error (readMay, hush, tryHead, noteT, EitherT(..), MaybeT(..), hoistMaybe, throwT, headMay)
-import Data.Base58Address (RippleAddress)
-import Database.SQLite.Simple (query, field, FromRow(..), Connection, execute)
-import Data.Binary (Binary, decodeOrFail)
-import Control.Exception (try)
+import Control.Error (noteT, EitherT(..), MaybeT(..), hoistMaybe, throwT, headMay)
+import Database.SQLite.Simple (Connection, query, execute)
import Control.Monad.Trans (liftIO)
import qualified Data.OpenPGP as OpenPGP
import qualified Data.OpenPGP.CryptoAPI as OpenPGP
-import qualified Data.ByteString.Lazy as LZ
import Keyserver
import Records
@@ -31,7 +23,7 @@ extractVerifiedAssertion :: OpenPGP.Message -> IO (Either String (OpenPGP.Packet
extractVerifiedAssertion msg = runEitherT $ do
time <- liftIO $ getCurrentTime
k <- noteT "Keyserver fetch failed." $ (MaybeT . fetchKey) =<< (hoistMaybe $ headMay (issuerKeyIds msg))
- (adr, obj@(assertion, target, at)) <- noteT "No valid signed object found." $ hoistMaybe $
+ (adr, obj@(_, _, at)) <- noteT "No valid signed object found." $ hoistMaybe $
verifyAssertion time k msg
when (at > time) (throwT "Signed object claims to be from the future.")
16 Util.hs
View
@@ -0,0 +1,16 @@
+module Util where
+
+import Control.Error (readMay)
+import Data.Binary (Binary, decodeOrFail)
+import qualified Data.ByteString.Lazy as LZ
+
+decodeM :: (Binary a, Monad m) => LZ.ByteString -> m a
+decodeM bytes = case decodeOrFail bytes of
+ Left (_,_,e) -> fail e
+ Right (_,_,x) -> return x
+
+-- | Signal read errors in some Monad (for parsing)
+readM :: (Read r, Monad m) => String -> m r
+readM s = case readMay s of
+ Just x -> return x
+ Nothing -> fail $ s ++ " is invalid"
Please sign in to comment.
Something went wrong with that request. Please try again.