Insert logging for the duration of some DB queries (#189)

fix #188

flora.cabal

@@ -99,7 +99,6 @@ library
     Flora.Model.Package.Update
     Flora.Model.PersistentSession
     Flora.Model.Release
-    Flora.Model.Release.Orphans
     Flora.Model.Release.Query
     Flora.Model.Release.Types
     Flora.Model.Release.Update
@@ -323,6 +322,7 @@ test-suite flora-test
     , flora
     , hedgehog
     , http-client            ==0.7.10
+    , log-base
     , log-effectful
     , network-uri
     , optics-core
@@ -342,6 +342,7 @@ test-suite flora-test
     , tasty-hunit
     , text
     , time
+    , time-effectful
     , transformers
     , uuid
     , vector

src/Distribution/Orphans.hs

@@ -3,13 +3,35 @@
 module Distribution.Orphans where
 
 import Data.Aeson
+import Data.Aeson.Encoding qualified as Aeson
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 qualified as C8
+import Data.Text qualified as Text
+import Data.Text.Display
+import Data.Text.Lazy.Builder qualified as Builder
+import Database.PostgreSQL.Simple.FromField
+  ( Conversion
+  , Field
+  , FromField (..)
+  , ResultError (ConversionFailed, UnexpectedNull)
+  , returnError
+  )
+import Database.PostgreSQL.Simple.ToField (Action (..), ToField (..))
+import Database.PostgreSQL.Simple.Types (PGArray (..))
 import Distribution.Compiler (CompilerFlavor)
 import Distribution.PackageDescription (FlagName)
+import Distribution.Parsec
+import Distribution.Pretty qualified as Pretty
+import Distribution.SPDX.License qualified as SPDX
 import Distribution.System (Arch, OS)
 import Distribution.Types.Condition
 import Distribution.Types.ConfVar
+import Distribution.Types.UnqualComponentName (UnqualComponentName, unUnqualComponentName)
+import Distribution.Types.Version qualified as Cabal
+import Distribution.Utils.Generic (fromUTF8BS)
 import Distribution.Utils.ShortText
 import Distribution.Version (Version, VersionRange)
+import Servant (FromHttpApiData (..), ToHttpApiData (..))
 
 deriving anyclass instance ToJSON ConfVar
 deriving anyclass instance FromJSON ConfVar
@@ -23,8 +45,31 @@ deriving anyclass instance FromJSON OS
 deriving anyclass instance ToJSON Arch
 deriving anyclass instance FromJSON Arch
 
-deriving anyclass instance ToJSON Version
-deriving anyclass instance FromJSON Version
+instance ToJSON Version where
+  toEncoding = Aeson.string . Pretty.prettyShow
+
+instance FromJSON Version where
+  parseJSON = withText "Version" $ \s ->
+    maybe (fail "Invalid Version") pure (simpleParsec $ Text.unpack s)
+
+instance FromField Version where
+  fromField :: Field -> Maybe ByteString -> Conversion Version
+  fromField f mdata = Cabal.mkVersion . fromPGArray <$> fromField f mdata
+
+instance ToField Version where
+  toField = toField . PGArray . Cabal.versionNumbers
+
+instance Display Version where
+  displayBuilder = Builder.fromString . Pretty.prettyShow
+
+instance ToHttpApiData Version where
+  toUrlPiece = Text.pack . Pretty.prettyShow
+
+instance FromHttpApiData Version where
+  parseUrlPiece piece =
+    case simpleParsec $ Text.unpack piece of
+      Nothing -> Left $ "Could not parse version string: " <> piece
+      Just a -> Right a
 
 deriving anyclass instance ToJSON VersionRange
 deriving anyclass instance FromJSON VersionRange
@@ -40,3 +85,21 @@ instance ToJSON ShortText where
 
 instance FromJSON ShortText where
   parseJSON = fmap toShortText . parseJSON
+
+instance FromField SPDX.License where
+  fromField :: Field -> Maybe ByteString -> Conversion SPDX.License
+  fromField f mdata =
+    case mdata of
+      Nothing -> returnError UnexpectedNull f ""
+      Just bs ->
+        case simpleParsec (fromUTF8BS bs) of
+          Just (a :: SPDX.License) -> pure a
+          Nothing ->
+            returnError ConversionFailed f $
+              "Conversion error: Expected valid SPDX identifier for 'license', got: " <> fromUTF8BS bs
+
+instance ToField SPDX.License where
+  toField = Escape . C8.pack . Pretty.prettyShow
+
+instance Display UnqualComponentName where
+  displayBuilder = Builder.fromString . unUnqualComponentName