Skip to content

Commit 38cd1be

Browse files
authored
Merge pull request #68 from serokell/diogo/#28-code-style
[#28] Make code conform to Serokell style policies
2 parents 631db98 + ff55709 commit 38cd1be

File tree

13 files changed

+339
-258
lines changed

13 files changed

+339
-258
lines changed

lib/Backend.hs

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,11 @@
33
-- SPDX-License-Identifier: MPL-2.0
44

55
module Backend
6-
( BackendEffect (..), readSecret, writeSecret, listSecrets, deleteSecret
6+
( BackendEffect (..)
7+
, readSecret
8+
, writeSecret
9+
, listSecrets
10+
, deleteSecret
711
, Backend (..)
812
, SomeBackend (..)
913
, Effects
@@ -12,8 +16,8 @@ where
1216

1317
import BackendName (BackendName)
1418
import Coffer.Path (EntryPath, Path)
15-
import Data.Text qualified as T
16-
import Entry qualified as E
19+
import Data.Text (Text)
20+
import Entry (Entry)
1721
import Error (CofferError)
1822
import Polysemy
1923
import Polysemy.Error (Error)
@@ -24,9 +28,9 @@ type Effects r = (Member (Embed IO) r, Member (Error CofferError) r)
2428
class Show a => Backend a where
2529
_name :: a -> BackendName
2630
_codec :: Toml.TomlCodec a
27-
_writeSecret :: Effects r => a -> E.Entry -> Sem r ()
28-
_readSecret :: Effects r => a -> EntryPath -> Sem r (Maybe E.Entry)
29-
_listSecrets :: Effects r => a -> Path -> Sem r (Maybe [T.Text])
31+
_writeSecret :: Effects r => a -> Entry -> Sem r ()
32+
_readSecret :: Effects r => a -> EntryPath -> Sem r (Maybe Entry)
33+
_listSecrets :: Effects r => a -> Path -> Sem r (Maybe [Text])
3034
_deleteSecret :: Effects r => a -> EntryPath -> Sem r ()
3135

3236
data SomeBackend where
@@ -40,11 +44,11 @@ data BackendEffect m a where
4044
-- | Overwrites any entry that might already exist at that path.
4145
-- It does /not overwrite/ directories.
4246
-- If a directory with that path already exists, you'll end up with an entry /and/ a directory sharing the same path.
43-
WriteSecret :: SomeBackend -> E.Entry -> BackendEffect m ()
47+
WriteSecret :: SomeBackend -> Entry -> BackendEffect m ()
4448
-- | Returns path segments: if the segment is suffixed by @/@ then that indicates a directory;
4549
-- otherwise it's an entry
46-
ReadSecret :: SomeBackend -> EntryPath -> BackendEffect m (Maybe E.Entry)
47-
ListSecrets :: SomeBackend -> Path -> BackendEffect m (Maybe [T.Text])
50+
ReadSecret :: SomeBackend -> EntryPath -> BackendEffect m (Maybe Entry)
51+
ListSecrets :: SomeBackend -> Path -> BackendEffect m (Maybe [Text])
4852
-- | Once all entries are deleted from a directory, then the directory disappears
4953
-- (i.e. @ListSecrets@ will no longer list that directory)
5054
DeleteSecret :: SomeBackend -> EntryPath -> BackendEffect m ()

lib/Backend/Commands.hs

Lines changed: 56 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import Data.List.NonEmpty qualified as NE
2727
import Data.Maybe (fromMaybe)
2828
import Data.Set (Set)
2929
import Data.Set qualified as Set
30+
import Data.Text (Text)
3031
import Data.Text qualified as T
3132
import Data.Time (UTCTime, getCurrentTime, utctDay)
3233
import Data.Time.Calendar.Compat (pattern YearMonthDay)
@@ -43,7 +44,7 @@ import Polysemy.Error (Error, throw)
4344
import Validation (Validation(Failure, Success))
4445

4546
runCommand
46-
:: (Member BackendEffect r, Member (Embed IO) r, Member (Error CofferError) r)
47+
:: (Members '[BackendEffect, Embed IO, Error CofferError] r)
4748
=> Config -> Command res -> Sem r res
4849
runCommand config = \case
4950
CmdView opts -> catchAndReturn $ viewCmd config opts
@@ -57,7 +58,7 @@ runCommand config = \case
5758
CmdTag opts -> catchAndReturn $ tagCmd config opts
5859

5960
viewCmd
60-
:: (Member BackendEffect r, Member (Error CofferError) r, Member (Error ViewResult) r)
61+
:: (Members '[BackendEffect, Error CofferError, Error ViewResult] r)
6162
=> Config -> ViewOptions -> Sem r ViewResult
6263
viewCmd config (ViewOptions (QualifiedPath backendNameMb path) fieldNameMb) = do
6364
backend <- getBackend config backendNameMb
@@ -86,9 +87,12 @@ viewCmd config (ViewOptions (QualifiedPath backendNameMb path) fieldNameMb) = do
8687

8788
createCmd
8889
:: forall r
89-
. (Member BackendEffect r, Member (Error CofferError) r, Member (Embed IO) r, Member (Error CreateResult) r)
90+
. (Members '[BackendEffect, Embed IO, Error CofferError, Error CreateResult] r)
9091
=> Config -> CreateOptions -> Sem r CreateResult
91-
createCmd config (CreateOptions (QualifiedPath backendNameMb entryPath) _edit force tags fields privateFields) = do
92+
createCmd
93+
config
94+
(CreateOptions (QualifiedPath backendNameMb entryPath) _edit force tags fields privateFields)
95+
= do
9296
backend <- getBackend config backendNameMb
9397
nowUtc <- embed getCurrentTime
9498
let
@@ -109,9 +113,12 @@ createCmd config (CreateOptions (QualifiedPath backendNameMb entryPath) _edit fo
109113

110114
setFieldCmd
111115
:: forall r
112-
. (Member BackendEffect r, Member (Error CofferError) r, Member (Embed IO) r, Member (Error SetFieldResult) r)
116+
. (Members '[BackendEffect, Embed IO, Error CofferError, Error SetFieldResult] r)
113117
=> Config -> SetFieldOptions -> Sem r SetFieldResult
114-
setFieldCmd config (SetFieldOptions (QualifiedPath backendNameMb entryPath) fieldName fieldContentsMb visibilityMb) = do
118+
setFieldCmd
119+
config
120+
(SetFieldOptions (QualifiedPath backendNameMb entryPath) fieldName fieldContentsMb visibilityMb)
121+
= do
115122
backend <- getBackend config backendNameMb
116123
readSecret backend entryPath >>= \case
117124
Nothing -> pure $ SFREntryNotFound entryPath
@@ -145,7 +152,7 @@ setFieldCmd config (SetFieldOptions (QualifiedPath backendNameMb entryPath) fiel
145152
Nothing -> throw $ SFRMissingFieldContents entryPath
146153

147154
deleteFieldCmd
148-
:: (Member BackendEffect r, Member (Error CofferError) r, Member (Embed IO) r)
155+
:: (Members '[BackendEffect, Embed IO, Error CofferError] r)
149156
=> Config -> DeleteFieldOptions -> Sem r DeleteFieldResult
150157
deleteFieldCmd config (DeleteFieldOptions (QualifiedPath backendNameMb path) fieldName) = do
151158
backend <- getBackend config backendNameMb
@@ -162,7 +169,9 @@ deleteFieldCmd config (DeleteFieldOptions (QualifiedPath backendNameMb path) fie
162169
void $ writeSecret backend newEntry
163170
pure $ DFRSuccess newEntry
164171

165-
findCmd :: (Member BackendEffect r, Member (Error CofferError) r) => Config -> FindOptions -> Sem r (Maybe Directory)
172+
findCmd
173+
:: (Members '[BackendEffect, Error CofferError] r)
174+
=> Config -> FindOptions -> Sem r (Maybe Directory)
166175
findCmd config (FindOptions qPathMb textMb sortMb filters filterFields) = do
167176
let backendNameMb = qPathMb >>= qpBackendName
168177
backend <- getBackend config backendNameMb
@@ -254,14 +263,18 @@ findCmd config (FindOptions qPathMb textMb sortMb filters filterFields) = do
254263
OpEQ -> (==)
255264

256265
renameCmd
257-
:: forall r.
258-
( Member BackendEffect r
259-
, Member (Embed IO) r
260-
, Member (Error CofferError) r
261-
, Member (Error RenameResult) r
262-
)
266+
:: forall r
267+
. (Members '[BackendEffect, Embed IO, Error CofferError, Error RenameResult] r)
263268
=> Config -> RenameOptions -> Sem r RenameResult
264-
renameCmd config (RenameOptions dryRun (QualifiedPath oldBackendNameMb oldPath) (QualifiedPath newBackendNameMb newPath) force) = do
269+
renameCmd
270+
config
271+
(RenameOptions
272+
dryRun
273+
(QualifiedPath oldBackendNameMb oldPath)
274+
(QualifiedPath newBackendNameMb newPath)
275+
force
276+
)
277+
= do
265278
oldBackend <- getBackend config oldBackendNameMb
266279
newBackend <- getBackend config newBackendNameMb
267280
operations <- buildCopyOperations oldBackend newBackend oldPath newPath force
@@ -274,7 +287,8 @@ renameCmd config (RenameOptions dryRun (QualifiedPath oldBackendNameMb oldPath)
274287
flip filter operations \(CopyOperation old _) ->
275288
none (\(CopyOperation _ new) -> old ^. path == new ^. path) operations
276289

277-
-- If directory/entry was successfully copied, then we can delete old directory/entry without delete errors.
290+
-- If directory/entry was successfully copied,
291+
-- then we can delete old directory/entry without delete errors.
278292
unless dryRun do
279293
forM_ pathsToDelete \(CopyOperation old _) -> do
280294
let qPath = QualifiedPath oldBackendNameMb (Path.entryPathAsPath (old ^. path))
@@ -291,14 +305,10 @@ data CopyOperation = CopyOperation
291305
getOperationPaths :: CopyOperation -> (EntryPath, EntryPath)
292306
getOperationPaths (CopyOperation old new) = (old ^. E.path, new ^. E.path)
293307

294-
{-# ANN buildCopyOperations ("HLint: ignore Redundant <$>" :: T.Text) #-}
308+
{-# ANN buildCopyOperations ("HLint: ignore Redundant <$>" :: Text) #-}
295309
buildCopyOperations
296310
:: forall r
297-
. ( Member BackendEffect r
298-
, Member (Embed IO) r
299-
, Member (Error CofferError) r
300-
, Member (Error CopyResult) r
301-
)
311+
. (Members '[BackendEffect, Embed IO, Error CofferError, Error CopyResult] r)
302312
=> SomeBackend -> SomeBackend -> Path -> Path -> Bool -> Sem r [CopyOperation]
303313
buildCopyOperations oldBackend newBackend oldPath newPath force = do
304314
entryOrDir <- getEntryOrDirThrow oldBackend CPRPathNotFound oldPath
@@ -343,7 +353,10 @@ buildCopyOperations oldBackend newBackend oldPath newPath force = do
343353
CopyOperation old (new & dateModified .~ nowUtc)
344354

345355
-- | Performs a check on `CopyOperation` and returns @Failure@ if any of checks fail.
346-
validateCopyOperation :: SomeBackend -> CopyOperation -> Sem r (Validation [(EntryPath, CreateError)] Entry)
356+
validateCopyOperation
357+
:: SomeBackend
358+
-> CopyOperation
359+
-> Sem r (Validation [(EntryPath, CreateError)] Entry)
347360
validateCopyOperation backend (CopyOperation old new) =
348361
checkCreateEntry backend force new <&> first \err -> [(old ^. path, err)]
349362

@@ -353,13 +366,17 @@ runCopyOperations backend operations = do
353366
forM_ newEntries (writeSecret backend)
354367

355368
copyCmd
356-
:: ( Member BackendEffect r
357-
, Member (Embed IO) r
358-
, Member (Error CofferError) r
359-
, Member (Error CopyResult) r
360-
)
369+
:: (Members '[BackendEffect, Embed IO, Error CofferError, Error CopyResult] r)
361370
=> Config -> CopyOptions -> Sem r CopyResult
362-
copyCmd config (CopyOptions dryRun (QualifiedPath oldBackendNameMb oldPath) (QualifiedPath newBackendNameMb newPath) force) = do
371+
copyCmd
372+
config
373+
(CopyOptions
374+
dryRun
375+
(QualifiedPath oldBackendNameMb oldPath)
376+
(QualifiedPath newBackendNameMb newPath)
377+
force
378+
)
379+
= do
363380
oldBackend <- getBackend config oldBackendNameMb
364381
newBackend <- getBackend config newBackendNameMb
365382
operations <- buildCopyOperations oldBackend newBackend oldPath newPath force
@@ -370,7 +387,7 @@ copyCmd config (CopyOptions dryRun (QualifiedPath oldBackendNameMb oldPath) (Qua
370387
pure $ CPRSuccess $ getOperationPaths <$> operations
371388

372389
deleteCmd
373-
:: (Member BackendEffect r, Member (Error CofferError) r, Member (Error DeleteResult) r)
390+
:: (Members '[BackendEffect, Embed IO, Error CofferError, Error DeleteResult] r)
374391
=> Config -> DeleteOptions -> Sem r DeleteResult
375392
deleteCmd config (DeleteOptions dryRun (QualifiedPath backendNameMb path) recursive) = do
376393
backend <- getBackend config backendNameMb
@@ -389,7 +406,7 @@ deleteCmd config (DeleteOptions dryRun (QualifiedPath backendNameMb path) recurs
389406

390407
tagCmd
391408
:: forall r
392-
. (Member BackendEffect r, Member (Error CofferError) r, Member (Embed IO) r, Member (Error TagResult) r)
409+
. (Members '[BackendEffect, Embed IO, Error CofferError, Error TagResult] r)
393410
=> Config -> TagOptions -> Sem r TagResult
394411
tagCmd config (TagOptions (QualifiedPath backendNameMb entryPath) tag delete) = do
395412
backend <- getBackend config backendNameMb
@@ -440,7 +457,7 @@ pathIsEntry backend entryPath =
440457
-- | Returns the entry or directory that the path points to.
441458
-- If the path doesn't exist at all, throws an error.
442459
getEntryOrDirThrow
443-
:: (Member BackendEffect r, Member (Error CofferError) r, Member (Error e) r)
460+
:: (Members '[BackendEffect, Error CofferError, Error e] r)
444461
=> SomeBackend -> (Path -> e) -> Path -> Sem r (Either Entry Directory)
445462
getEntryOrDirThrow backend mkError path = do
446463
getEntryOrDir backend path >>= \case
@@ -451,7 +468,7 @@ getEntryOrDirThrow backend mkError path = do
451468
-- If the path doesn't exist at all, returns `Nothing`.
452469
getEntryOrDir
453470
:: forall r
454-
. (Member BackendEffect r, Member (Error CofferError) r)
471+
. (Members '[BackendEffect, Error CofferError] r)
455472
=> SomeBackend -> Path -> Sem r (Maybe (Either Entry Directory))
456473
getEntryOrDir backend path =
457474
tryGetEntry path >>= \case
@@ -507,7 +524,9 @@ getEntryOrDir backend path =
507524
--
508525
-- Note: the root path @/@ cannot possibly be occupied by an entry,
509526
-- therefore we skip the check for that path.
510-
getEntriesInEntryPath :: forall r. Member BackendEffect r => SomeBackend -> EntryPath -> Sem r [EntryPath]
527+
getEntriesInEntryPath
528+
:: forall r. Member BackendEffect r
529+
=> SomeBackend -> EntryPath -> Sem r [EntryPath]
511530
getEntriesInEntryPath backend entryPath = do
512531
let parentDirsExceptRoot = entryPath
513532
& Path.entryPathParentDirs
@@ -545,7 +564,9 @@ checkCreateEntry backend force entry = catchAndReturn act
545564

546565
pure $ Success entry
547566

548-
getBackend :: forall r. Member (Error CofferError) r => Config -> Maybe BackendName -> Sem r SomeBackend
567+
getBackend
568+
:: forall r. Member (Error CofferError) r
569+
=> Config -> Maybe BackendName -> Sem r SomeBackend
549570
getBackend config backendNameMb = do
550571
let backendName = fromMaybe (mainBackend config) backendNameMb
551572
let backendsHashMap = backends config

0 commit comments

Comments
 (0)