about summary refs log tree commit diff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/.ghci2
-rw-r--r--src/App.hs18
-rw-r--r--src/Auth.hs8
-rw-r--r--src/Email.hs2
-rw-r--r--src/Sessions.hs2
-rw-r--r--src/Types.hs50
-rw-r--r--src/Utils.hs1
7 files changed, 38 insertions, 45 deletions
diff --git a/src/.ghci b/src/.ghci
index f189fd0be2e6..efc88e630ccb 100644
--- a/src/.ghci
+++ b/src/.ghci
@@ -1,2 +1,2 @@
 :set prompt "> "
-:set -Wincomplete-patterns
+:set -Wall
diff --git a/src/App.hs b/src/App.hs
index e56e7c1875f5..6a7de73a822f 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -11,7 +11,6 @@ import Control.Monad.IO.Class (liftIO)
 import Data.String.Conversions (cs)
 import Data.Text (Text)
 import Servant
-import Servant.Server.Internal.ServerError
 import API
 import Utils
 import Web.Cookie
@@ -20,10 +19,7 @@ import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.Wai.Middleware.Cors as Cors
 import qualified System.Random as Random
 import qualified Email as Email
-import qualified Crypto.KDF.BCrypt as BC
-import qualified Data.Text.Encoding as TE
 import qualified Data.UUID as UUID
-import qualified Data.UUID.V4 as UUID
 import qualified Types as T
 import qualified Accounts as Accounts
 import qualified Auth as Auth
@@ -48,7 +44,7 @@ sendVerifyEmail :: T.Config
                 -> T.Email
                 -> T.RegistrationSecret
                 -> IO (Either Email.SendError Email.SendSuccess)
-sendVerifyEmail T.Config{..} (T.Username username) email@(T.Email to) (T.RegistrationSecret secretUUID) = do
+sendVerifyEmail T.Config{..} (T.Username username) email (T.RegistrationSecret secretUUID) = do
   Email.send mailgunAPIKey subject (cs body) email
   where
     subject = "Please confirm your account"
@@ -115,11 +111,13 @@ server config@T.Config{..} = createAccount
             createAccountRequestPassword
             createAccountRequestRole
             createAccountRequestEmail
-          liftIO $ sendVerifyEmail config
+          res <- liftIO $ sendVerifyEmail config
             createAccountRequestUsername
             createAccountRequestEmail
             secretUUID
-          pure NoContent
+          case res of
+            Left _ -> undefined
+            Right _ -> pure NoContent
 
     verifyAccount :: Text -> T.RegistrationSecret -> Handler NoContent
     verifyAccount username secretUUID = do
@@ -239,8 +237,10 @@ server config@T.Config{..} = createAccount
         secretUUID
         inviteUserRequestEmail
         inviteUserRequestRole
-      liftIO $ sendInviteEmail config inviteUserRequestEmail secretUUID
-      pure NoContent
+      res <- liftIO $ sendInviteEmail config inviteUserRequestEmail secretUUID
+      case res of
+        Left _ -> undefined
+        Right _ -> pure NoContent
 
     acceptInvitation :: T.AcceptInvitationRequest -> Handler NoContent
     acceptInvitation T.AcceptInvitationRequest{..} = do
diff --git a/src/Auth.hs b/src/Auth.hs
index 4962ce50abef..f1bff23257e0 100644
--- a/src/Auth.hs
+++ b/src/Auth.hs
@@ -4,19 +4,13 @@
 module Auth where
 --------------------------------------------------------------------------------
 import Control.Monad.IO.Class (liftIO)
-import Data.String.Conversions (cs)
-import Database.SQLite.Simple
-import Utils
 import Web.Cookie
 import Servant
-import Servant.Server.Internal.ServerError
 
 import qualified Data.UUID as UUID
-import qualified Web.Cookie as WC
 import qualified Sessions as Sessions
 import qualified Accounts as Accounts
 import qualified Types as T
-import qualified Data.ByteString.Lazy as LBS
 --------------------------------------------------------------------------------
 
 -- | Return the UUID from a Session cookie.
@@ -28,7 +22,7 @@ uuidFromCookie (T.SessionCookie cookies) = do
 
 -- | Attempt to return the account associated with `cookie`.
 accountFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Account)
-accountFromCookie dbFile cookie = withConnection dbFile $ \conn -> do
+accountFromCookie dbFile cookie =
   case uuidFromCookie cookie of
     Nothing -> pure Nothing
     Just uuid -> do
diff --git a/src/Email.hs b/src/Email.hs
index 439b15d0ed4b..2dac0973ba6d 100644
--- a/src/Email.hs
+++ b/src/Email.hs
@@ -29,7 +29,7 @@ send apiKey subject body (T.Email to) = do
       res <- MG.sendEmail ctx x
       case res of
         Left e -> pure $ Left (ResponseError e)
-        Right x -> pure $ Right (SendSuccess x)
+        Right y -> pure $ Right (SendSuccess y)
   where
     ctx = MG.HailgunContext { MG.hailgunDomain = "sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
                             , MG.hailgunApiKey = cs apiKey
diff --git a/src/Sessions.hs b/src/Sessions.hs
index f5b2f6f41000..713059a38383 100644
--- a/src/Sessions.hs
+++ b/src/Sessions.hs
@@ -58,7 +58,7 @@ delete dbFile uuid = withConnection dbFile $ \conn ->
 -- | Find or create a session in the Sessions table. If a session exists,
 -- refresh the token's validity.
 findOrCreate :: FilePath -> T.Account -> IO T.SessionUUID
-findOrCreate dbFile account = withConnection dbFile $ \conn ->
+findOrCreate dbFile account =
   let username = T.accountUsername account in do
     mSession <- find dbFile username
     case mSession of
diff --git a/src/Types.hs b/src/Types.hs
index 235e8a6d06df..00fa09ccc140 100644
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -10,7 +10,6 @@ import Data.Aeson
 import Utils
 import Data.Text
 import Data.Typeable
-import Data.String.Conversions (cs)
 import Database.SQLite.Simple
 import Database.SQLite.Simple.Ok
 import Database.SQLite.Simple.FromField
@@ -22,7 +21,6 @@ import System.Envy (FromEnv, fromEnv, env)
 import Crypto.Random.Types (MonadRandom)
 
 import qualified Data.Time.Calendar as Calendar
-import qualified Data.Time.Format as TF
 import qualified Crypto.KDF.BCrypt as BC
 import qualified Data.Time.Clock as Clock
 import qualified Data.ByteString.Char8 as B
@@ -50,10 +48,10 @@ instance FromEnv Config where
 
 -- TODO(wpcarro): Properly handle NULL for columns like profilePicture.
 forNewtype :: (Typeable b) => (Text -> b) -> FieldParser b
-forNewtype wrapper field =
-  case fieldData field of
+forNewtype wrapper y =
+  case fieldData y of
     (SQLText x) -> Ok (wrapper x)
-    x -> returnError ConversionFailed field ("We expected SQLText, but we received: " ++ show x)
+    x -> returnError ConversionFailed y ("We expected SQLText, but we received: " ++ show x)
 
 newtype Username = Username Text
   deriving (Eq, Show, Generic)
@@ -74,10 +72,10 @@ instance ToField HashedPassword where
   toField (HashedPassword x) = SQLText (TE.decodeUtf8 x)
 
 instance FromField HashedPassword where
-  fromField field =
-    case fieldData field of
+  fromField y =
+    case fieldData y of
       (SQLText x) -> x |> TE.encodeUtf8 |> HashedPassword |> Ok
-      x -> returnError ConversionFailed field ("We expected SQLText, but we received: " ++ show x)
+      x -> returnError ConversionFailed y ("We expected SQLText, but we received: " ++ show x)
 
 newtype ClearTextPassword = ClearTextPassword Text
   deriving (Eq, Show, Generic)
@@ -125,12 +123,12 @@ instance ToField Role where
   toField Admin = SQLText "admin"
 
 instance FromField Role where
-  fromField field =
-    case fieldData field of
+  fromField y =
+    case fieldData y of
       (SQLText "user") -> Ok RegularUser
       (SQLText "manager") -> Ok Manager
       (SQLText "admin") -> Ok Admin
-      x -> returnError ConversionFailed field ("We expected user, manager, admin, but we received: " ++ show x)
+      x -> returnError ConversionFailed y ("We expected user, manager, admin, but we received: " ++ show x)
 
 -- TODO(wpcarro): Prefer Data.ByteString instead of Text
 newtype ProfilePicture = ProfilePicture Text
@@ -356,13 +354,13 @@ newtype SessionUUID = SessionUUID UUID.UUID
   deriving (Eq, Show, Generic)
 
 instance FromField SessionUUID where
-  fromField field =
-    case fieldData field of
+  fromField y =
+    case fieldData y of
       (SQLText x) ->
         case UUID.fromText x of
-          Nothing -> returnError ConversionFailed field ("Could not convert to UUID: " ++ show x)
-          Just x -> Ok $ SessionUUID x
-      _ -> returnError ConversionFailed field "Expected SQLText for SessionUUID, but we received"
+          Nothing -> returnError ConversionFailed y ("Could not convert to UUID: " ++ show x)
+          Just uuid -> Ok $ SessionUUID uuid
+      _ -> returnError ConversionFailed y "Expected SQLText for SessionUUID, but we received"
 
 instance ToField SessionUUID where
   toField (SessionUUID uuid) =
@@ -410,13 +408,13 @@ instance FromHttpApiData RegistrationSecret where
       Just uuid -> Right (RegistrationSecret uuid)
 
 instance FromField RegistrationSecret where
-  fromField field =
-    case fieldData field of
+  fromField y =
+    case fieldData y of
       (SQLText x) ->
         case UUID.fromText x of
-          Nothing -> returnError ConversionFailed field ("Could not convert text to UUID: " ++ show x)
-          Just x -> Ok $ RegistrationSecret x
-      _ -> returnError ConversionFailed field "Field data is not SQLText, which is what we expect"
+          Nothing -> returnError ConversionFailed y ("Could not convert text to UUID: " ++ show x)
+          Just uuid -> Ok $ RegistrationSecret uuid
+      _ -> returnError ConversionFailed y "Field data is not SQLText, which is what we expect"
 
 instance ToField RegistrationSecret where
   toField (RegistrationSecret secretUUID) =
@@ -498,13 +496,13 @@ instance ToField InvitationSecret where
     secretUUID |> UUID.toText |> SQLText
 
 instance FromField InvitationSecret where
-  fromField field =
-    case fieldData field of
+  fromField y =
+    case fieldData y of
       (SQLText x) ->
         case UUID.fromText x of
-          Nothing -> returnError ConversionFailed field ("Could not convert text to UUID: " ++ show x)
-          Just x -> Ok $ InvitationSecret x
-      _ -> returnError ConversionFailed field "Field data is not SQLText, which is what we expect"
+          Nothing -> returnError ConversionFailed y ("Could not convert text to UUID: " ++ show x)
+          Just z -> Ok $ InvitationSecret z
+      _ -> returnError ConversionFailed y "Field data is not SQLText, which is what we expect"
 
 data Invitation = Invitation
   { invitationEmail :: Email
diff --git a/src/Utils.hs b/src/Utils.hs
index 78ee93ec95de..48c33af0796d 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -5,4 +5,5 @@ import Data.Function ((&))
 --------------------------------------------------------------------------------
 
 -- | Prefer this operator to the ampersand for stylistic reasons.
+(|>) :: a -> (a -> b) -> b
 (|>) = (&)
generated by cgit-pink 1.4.1 (git 2.44.2) at 2024-09-14T06ยท07+0000